[討論]LISP 面積小數點

由 **k48594859** 2014-02-18, 19:17

小弟要算面積和周長遇到一些問題，就是之前在網路找到一個計算面積的LISP，
只會計算出圖上的單位，我做了小小的修改直接算出平方公尺和公尺(下紅色部分)，
可是只有算出小數第一位，我要能算出第二位後面四捨五入請問哪位大大可以幫我

(defun C:am (/ ss l i totalarea ename obj entarea)
(if (setq ss (ssget))
(progn
(vl-load-com)
(setq modelspace (vla-get-Modelspace (vla-get-activeDocument (vlax-get-acad-

object))))
(setq l (sslength ss) i 0 totalarea 0 totlength 0)
(repeat l
(setq ename (ssname ss i))
(setq obj (vlax-ename->vla-object ename))
(if (vlax-property-available-p obj "area")
(setq totalarea (+ (vlax-get-property obj 'area) totalarea))
)
(if (= (cdr (assoc 0 (entget ename))) "MLINE")
(setq totlength (+ totlength (ml-length ename)))
(setq totlength (+ totlength (vlax-curve-getdistatparam ename (vlax-curve-getendparam

ename))))
)
(setq i (1+ i))
)

(setq totalarea (/ totalarea 100 100) ; "M2"
text1 (strcat "面積 : " (rtos totalarea 2 1) "M2")
totlength (/ totlength 100 ) ; "M"
text2 (strcat "周長 : " (rtos totlength 2 1) "M")
)

(if (setq insertpt (getpoint "\n請輸入文字插入點: "))
(if (setq height (GETREAL "\n請輸入文字高度:"))
(setq insertp1 (vlax-3d-point insertpt)
insertp2 (vlax-3d-point (polar insertpt (* 1.5 Pi) (* 1.5 height)))
textobj1 (vla-addtext modelspace text1 insertp1 height)
textobj2 (vla-addtext modelspace text2 insertp2 height)
)
)
)
)
)
)
(defun ml-length (ename / j d ptlist)
(foreach n (entget ename)
(if (= (car n) 11)
(setq ptlist (cons (cdr n) ptlist))
)
)
(reverse ptlist)
(setq j 0 d 0)
(repeat (1- (length ptlist))
(setq d (+ d (distance (nth j ptlist) (nth (1+ j) ptlist))))
(setq j (1+ j))
)
d
)
lisp附件下載: https://app.box.com/s/e0vst9piujkanxs871gd