(defun
rtoc ( n p / d i l x );; n = any number
p = precision
(setq l (vl-string->list (rtos n 2 p))
x (cond ((cdr (member 46 (reverse
l)))) ((reverse l)))
i 0
)
(vl-list->string
(append
(reverse
(apply 'append
(mapcar
'(lambda ( a b )
(if (and (zerop
(rem (setq i (1+ i)) 3)) b)
(list a 44)
(list a)
)
)
x (append (cdr x)
'(nil))
)
)
)
(member 46 l)
)
)
);end
(defun
c:GAR()
(setq
old_cmdecho (getvar
"cmdecho"))
(setvar
"cmdecho" 0)
(initget
"1 2")
(setq opt_ar (getkword "\nSelect
Options : \n [1 Rai-Ngan-Wah / 2 square metre.] <1> "))
(if (= opt_ar "")(setq opt_ar
"1"))
(initget
"1 2")
(setq opt (getkword "\nSelect
Options : \n [1 Pick in Area. / 2 Select Polyline Closed.] <1> "))
(if (= opt "")(setq opt
"1"))
(setq
txtH 10.0); Current height
(setq
txtS (getvar "textstyle")); Current Style
(setq
ins 1)
(setq
tot_area 0.0)
(if
(= opt "1")
(while
(setq ins (getpoint "\nPick in Area: "))
(command "_boundary" ins
"")
(command "_area" "o"
"l")
(command "_erase" "l"
"")
(setq tot_area (+ tot_area (getvar
"area")))
);while
);if
opt "1"
(if
(= opt "2")
(if (setq ss1 (ssget '((-4 .
"<OR")
(0 .
"POLYLINE")
(0 .
"LWPOLYLINE")
(0 . "CIRCLE")
(0 .
"ELLIPSE")
(0 .
"SPLINE")
(0 .
"REGION")
(-4 .
"OR>")
)
)
)
(progn
(setq nr 0)
(setq en (ssname ss1 nr))
(while en
(command
"._area" "_O" en)
(setq tot_area (+
tot_area (getvar "area")))
(setq nr (1+ nr))
(setq en (ssname ss1
nr))
);while
)
)
);if
opt "2"
(if
(= opt_ar "1")
(setq txt (areath tot_area))
(setq txt (strcat (rtoc tot_area 2)"
m\U+00B2")) ;add , comma
)
(setq pt (getpoint "\n Pick Area
Location: "))
(entmake
(list
'(0 . "MTEXT")
'(100 .
"AcDbEntity")
'(100 .
"AcDbMText")
(cons 10 pt)
(cons 7 txtS)
(cons 40 txtH)
(cons
41 0) ; 0 Width = no wrap
(cons 71 5) ; 1=Top
Left /2=Top Center /3= Top Right
;
4=Middle Left/5=Middle Center/6=Middle Right
;
7=Bottom Left/8=Bottom Center/9=Bottom Right
(cons 50 0.0) ; rotation
angle
(cons 1 txt)
)
)
(setvar
"cmdecho" old_cmdecho)
(princ)
)
(prompt
"\nEnter GAR to Start Get Area.")
(defun
areath (sqm / rl_r rl_ng rl_wa th_area)
(setq rl_r (fix(/ sqm 1600)))
(setq rl_ng (fix(/ (- sqm (* rl_r 1600))
400)))
(setq rl_wa (/ (- sqm (+ (* rl_r 1600) (*
rl_ng 400))) 4))
(setq th_area (strcat (rtos rl_r 2 0)
"-"(rtos rl_ng 2 0) "-" (rtos rl_wa 2 2)))
)
ไม่มีความคิดเห็น:
แสดงความคิดเห็น