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

lpl

高飞兄是不是不玩lisp了，答应升级的，好久没见动静了，期待.......................

qiushizhda

这个功能比较实用，

davide888

谢了         

kx820506

11 楼的程序在哪啊

chenshulu

根据我们现在遇到的工程实际需要，希望高飞鸟大神，有一下几点优化
1、按图层计算面积，这样可以批量进行面积的分类统计
2、计算以后的数据可以导出到一个EXCEL表，每一行显示的是一个图层的面积。这样可以便于后续的数据处理（这样的处理对于房产测量的面积统计将会有改变行业格局的意义），因为房产面积的计算是一个多变的计算过程，阳台算半面积还是全面积还是不算面积都按实际的情况来。也就是说这个“YT”图层的面积乘以几，到后面是要用户自己指定的。
3、希望在框选的时候面积下面一行可以把长度也一起计算出来，因为房产面积计算是要扣除一个墙壁的占地面积的。有了长度就可以很简单的算出要扣除的面积了，比如，墙壁厚度为0.02m则扣除面积就是长度*0.02。用户修改后可以再把表用相关的软件导入到CAD就可以了。
4.其实最好是可以框选的时候自动提取闭合区域内的文字，作为这个面积的名称。比如，多边形内有文字“XXX”则，生成的表格的该行的第一个单元格内容就是“XXX面积”
刚刚开始学习写LISP。自己还只能写一些简单的东西，但是高飞鸟却有改变一个行业习惯的能力，相信你的程序会让我们叹为观止的！

xujinhua

慢慢学..谢谢楼主

chbddzx12

顶~~~~~~~~~~~~~~~~~~~~~~~~~

cba246

很实用，谢谢楼主！

尘缘一生

;;;;;程序源码 “飞鸟集”，修改：尘缘一生 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了，答应升级的，好久没见动静了，期待.......................

求分享此插件，感谢