【飞鸟集】面积求和及长度求和的lisp程序

highflybir · 发表于 2007-1-3 15:51:00

关于对于面积求和和长度求和，还是有很多用途，在这里写一个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))
(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
)

(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 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 
)

尘缘一生 · 发表于 2019-4-28 05:04:29

;;;;;程序源码 “飞鸟集”，修改：尘缘一生 2019-4-28
;;;关于对于面积求和和长度求和，还是有很多用途，在这里写一个lisp程序。加载运行am
;;;选择你要求和的物体，可以是line ,circle,arc ,ellipse ,spline, polyline,mline等，算出面积和长度。
;;; 【不用指定位置和高度，用你CAD整体比例系数控制】，用文字标注出来，并跟随鼠标定位
(defun C:am (/ s text1 text2 ss l i totalarea ename obj insertpt insertpt1)
(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 text1 (strcat "总面积为: " (rtos totalarea 2 4) "平方单位")
text2 (strcat "总长度为: " (rtos totlength 2 4) "单位")
)
(setq insertpt (nth 1(grread 5)))
(setq insertpt1 (polar insertpt (* 1.5 pi) (* (getvar "DIMSCALE") 7.0)))
(entmake (list '(0 . "TEXT") (cons 1 text1) (cons 8 "PUB_TEXT") (cons 10 insertpt) (cons 40 (* (getvar "DIMSCALE") 5.0))))
(setq s(ssadd))
(ssadd (entlast) s)
(entmake (list '(0 . "TEXT") (cons 1 text2) (cons 8 "PUB_TEXT") (cons 10 insertpt1) (cons 40 (* (getvar "DIMSCALE") 5.0))))
(ssadd (entlast) s)
(command "MOVE" s "" insertpt)
)
)
)
(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
)

vista228 · 发表于 2023-9-25 11:55:53

尘缘一生发表于 2019-4-28 05:04
;;;;;程序源码 “飞鸟集”，修改：尘缘一生 2019-4-28
;;;关于对于面积求和和长度求和，还是有很多用途， ...

谢大佬分享

注册 · 发表于 2019-7-4 14:25:06

lpl 发表于 2013-12-30 21:39
高飞兄是不是不玩lisp了，答应升级的，好久没见动静了，期待.......................

求分享此插件，感谢

yxp · 发表于 2007-1-7 12:51:00

(defun ml-length (ename / j d ptlist)
(foreach n(entget ename)(if(=(car n) 10)(setq ptlist(cons(cdr n) ptlist))))
(setq j 0 d 0)
(repeat (1-(length ptlist))
   (setq d(+ d(distance(nth j ptlist)(nth(1+ j) ptlist))) j (1+ j))
   )
   d
)

rongyifei · 发表于 2007-1-7 13:24:00

For the object that has not the property of area, it is ignored to calculate the area, is't it?

for instance the closed region surrounded by lines!

四叶草by · 发表于 2011-12-6 17:01:16

yxp 发表于 2007-1-7 12:51
  (defun ml-length (ename / j d ptlist)  (foreach n(entget ename)(if(=(car n) 10)(setq ptl ...

果然不同凡响

四叶草by · 发表于 2011-12-6 17:10:05

yxp 发表于 2007-1-7 12:51
  (defun ml-length (ename / j d ptlist)  (foreach n(entget ename)(if(=(car n) 10)(setq ptl ...

很实用，高手，很感激你的无私

lilugou · 发表于 2011-12-14 12:57:15

十分感谢，学习中

zqb05 · 发表于 2011-12-14 13:18:27

学习了，这个不错

lizhiqiang9801 · 发表于 2012-2-13 14:47:56

不知道能改为实际单位吗也就是总米数小数点向前进三位啊

陈亚娣 · 发表于 2013-6-20 13:31:11

frogll · 发表于 2013-7-5 19:33:18

很好很强大啊！但是貌似对于多段线围城的封闭多边形与直线围城的封闭多边形的混合选择集，面积之和计算不对

账号		自动登录	找回密码
密码			注册

[【高飞鸟】] 【飞鸟集】面积求和及长度求和的lisp程序

本帖被以下淘专辑推荐:

评分