高飞兄是不是不玩lisp了，答应升级的，好久没见动静了，期待.......................
这个功能比较实用，
谢了
11 楼的程序在哪啊
根据我们现在遇到的工程实际需要，希望高飞鸟大神，有一下几点优化
1、按图层计算面积，这样可以批量进行面积的分类统计
2、计算以后的数据可以导出到一个EXCEL表，每一行显示的是一个图层的面积。这样可以便于后续的数据处理（这样的处理对于房产测量的面积统计将会有改变行业格局的意义），因为房产面积的计算是一个多变的计算过程，阳台算半面积还是全面积还是不算面积都按实际的情况来。也就是说这个“YT”图层的面积乘以几，到后面是要用户自己指定的。
3、希望在框选的时候面积下面一行可以把长度也一起计算出来，因为房产面积计算是要扣除一个墙壁的占地面积的。有了长度就可以很简单的算出要扣除的面积了，比如，墙壁厚度为0.02m则扣除面积就是长度*0.02。用户修改后可以再把表用相关的软件导入到CAD就可以了。
4.其实最好是可以框选的时候自动提取闭合区域内的文字，作为这个面积的名称。比如，多边形内有文字“XXX”则，生成的表格的该行的第一个单元格内容就是“XXX面积”
刚刚开始学习写LISP。自己还只能写一些简单的东西，但是高飞鸟却有改变一个行业习惯的能力，相信你的程序会让我们叹为观止的！
慢慢学..谢谢楼主
顶~~~~~~~~~~~~~~~~~~~~~~~~~
很实用，谢谢楼主！
;;;;;程序源码 “飞鸟集”，修改：尘缘一生 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
)
lpl 发表于 2013-12-30 21:39
高飞兄是不是不玩lisp了，答应升级的，好久没见动静了，期待.......................
求分享此插件，感谢