面积求和及长度求和 

2013-10-06 17:31 发布

370 0 0
关于对于面积求和和长度求和,还是有很多用途,在这里写一个lisp程序。
加载程序,在命令行运行am

选择你要求和的物体,可以是line ,circle,arc ,ellipse ,spline, polyline,mline等,算出面积和长度。

指定位置和高度,就可以用文字标注出来。
(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))
  ;;(vlax-dump-object obj T)
  (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 text1 (strcat "总面积为: " (rtos totalarea 2 4) "平方毫米")
   text2 (strcat "总长度为: " (rtos totlength 2 4) "毫米")
)
(if (setq insertpt (getpoint "\n请输入文字插入点: "))
  (if (setq height (getdist "\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
)
http://abbs.cn/pic/2007/01/03/1167811566.rar

.........................................................
☆  12ouiuqg   回复:



没看懂怎么回事?
B Color Smilies
快速回复 返回顶部 返回列表