;Modifyed by Igal Averbuh 2015
(DEFUN C:ATS (/)
;
(prompt "\n===> TXTAREA * V1.1 * 01/01/2006 * Felix J. de Melo * WWW.AMICROCAD.COM.BR <===")
(prompt "\n..............* Calculates areas and writes it as a text........")
;
(IF (NOT XESCALA) (SETQ XESCALA 50.0) )
(SETQ XUNIDADE 1000)
(setq TEXTO "\nPlotting Scale = 1:")
(setq ULTIMO XESCALA)
(setq XESCALA (getreal (strcat TEXTO "")))
(if (= XESCALA nil) (setq XESCALA ULTIMO))
;
(SETQ R-OSMODE (GETVAR "OSMODE"))
;
(SETVAR "CMDECHO" 0)
(SETVAR "DIMZIN" 0)
(SETVAR "OSMODE" 183)

(COMMAND "_LAYER" "_M" "00-AREAS" "_C" "6" "00-AREAS" "")
(COMMAND "_STYLE" "ISOCP" "ISOCP" "" "" "" "" "")

(SETQ AREAT 0)
(progn
(SETQ PINS (GETPOINT "\nPick a point for the Area Calculation Text "))
(SETQ PINZ (GETPOINT "\nPick a point for Name or Number of Digitizing Area "))

(while PINS (/= "" (setq room (getstring 1 "\nEnter Name or Number of Digitizing Area ")))
(princ "\nDigitize Area by picking corners...\n")
(command "._AREA")
(SETQ AREAC (GETVAR "AREA"))
(SETQ AREAT (+ AREAT AREAC))
; (setq fh (open "c:/AREA-CALCULATING.csv" "w")) ;Write it to DATA
;(write-line (STRCAT "AREA = " (RTOS AREAC 2 2) "m²")fh)
(while (not (zerop (getvar "CMDACTIVE"))) (command pause))
(setq outlist (cons (list room (rtos (getvar "AREA"))) outlist))

(SETQ ATXT (* 2.5 (/ XESCALA XUNIDADE)))
(SETQ AREAC (GETVAR "AREA"))
(SETQ AREAT (+ AREAT AREAC))
(SETQ TEXTO1 (STRCAT "AREA = " (RTOS AREAC 2 2) "m²"))

(SETQ TEXTO2 (STRCAT "AREA = " (RTOS AREAC 2 2) "m² *** TOTAL = " (RTOS AREAT 2 2) "m²"))

(COMMAND "_TEXT" "_M" PINZ ATXT "0" room)
(COMMAND "_TEXT" "_M" PINS ATXT "0" TEXTO1)
(PRINT TEXTO2)

(SETQ PINS (GETPOINT "\nPick a point for the Area Calculation Text "))
(SETQ PINZ (GETPOINT "\nPick a point for Name or Number of Digitizing Area "))
;(write-line (STRCAT "AREA = " (RTOS AREAC 2 2) "m²")fh)
)
)
;(write-line (STRCAT "TOTAL AREA = " (RTOS AREAT 2 2) "m²")fh)
;(alert "\n File has been written to c:AREA-CALCULATING.csv")
;(close fh)

(SETVAR "CLAYER" "0")
(SETVAR "OSMODE" R-OSMODE)
;
(PRINC)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(PRINC "Type \"ATS\" to invoke !")
(PRINC)
;(c:ats)

Advertisements