(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 (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"
(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.")
ไม่มีความคิดเห็น:
แสดงความคิดเห็น