cad面积累计lisp怎么用_晓东CAD家园-论坛-LISP/VLISP程序库-[LISP程序]：累计封闭Pline,Hatch(autocad2006+)等面积 - Powered by Disc...

;;累计封闭Pline、Spline，Region,Circle,Hatch(autocad2006+)面积

;;对Hatch计算时有错误提示

;;Form [url]www.xdcad.net[/url] eachy 2005.9.23

(defun c:CalArea (/ ss _area m)

;(xd-begin nil);_ Begin Mark

(if (setq ss (ssget (list '(-4 . "

'(0 . "region,circle,hatch") ;_Region circle hatch

'(-4 . "

'(0 . "ellipse")

'(41 . 0.)

(cons 42 (* pi 2))

'(-4 . "and>") ;_totle ellipse

'(-4 . "

'(0 . "*polyline,spline")

'(-4 . "&=")

'(70 . 1);_closed

'(-4 . "and>")

'(-4 . "or>")

)

)

)

(progn

(setq _area 0.

m 0

)

(xd-ssmap

'(lambda (e / area typ)

(setq area (vl-catch-all-apply 'vlax-curve-getarea (list e))

typ  (cdr (assoc 0 (entget e)))

)

(if (= typ "HATCH")

(setq area        (vl-catch-all-apply

'vla-get-area

(list (vlax-ename->vla-object e))

)

);_ 可能为 0 或 error in cad2006-

(setq

area (vl-catch-all-apply 'vlax-curve-getarea (list e))

);_ get area of curve

)

(if (or (vl-catch-all-error-p area);_ befor CAD2006

(zerop area);_ error

);_错误检测，不包括自相交的Pline Spline

(progn (redraw e 3)

(setq m (1+ m))

)

(setq _area (+ _area area));_可以根据单位自调

)

)

ss

)

(princ "\nTotle Area = ")

(princ _area)

(if (not (zerop m))

(princ (strcat "\nTotle " (itoa m) " Entity Can not Cal Area!"))

);_错误提示

)

)

;;(xd-end);_End Mark

(princ)

)

(princ "\nStart Command With CalArea. eachy [[url]www.xdcad.net[/url]]!")

(princ)