线长分类统计数量及长度和总数量及总长(源)
<p>需要统计图中各种线长有用， 如图</p><p> </p><p> </p> zgssd 发表于 2009-9-23 13:49本帖最后由 作者 于 2009-9-23 15:37:36 编辑用了5楼的源码，为何不能统计多段线长度？我做了如下修改， ...
怎样加上面域的线呢 论坛找了很多线长与面积的，但就没有面域的。 谢谢分享
程序不错 这个好用 学习下 <strong><font color="#000000"> 错误: no function definition: NBTF_DXF----请问版主什么原因？</font></strong> <p>楼主,请教如何在程序中过滤掉同心圆,只选取最大直径的圆呢?</p><p></p> (DEFUN nbtf_dxf (I EN)
(CDR (ASSOC I (ENTGET EN)))
)
学习1楼代码，修改后
(vl-load-com)(defun C:SUMLEN (/)
(setq LST '(("LINE" "直线")
("ARC" "圆弧")
("CIRCLE" "圆")
("LPOLYLINE" "多段线")
("ELLIPSE" "椭圆")
("SPLINE" "样条线")
)
)
(if (setq SS (ssget '((0 . "LINE,ARC,CIRCLE,LPOLYLINE,ELLIPSE,SPLINE"))
)
)
(progn
;;1.逐个统计
(setq I 0)
(repeat (sslength SS)
(setq EN(ssname SS I)
ENT (entget EN)
STR (cdr (assoc 0 ENT))
)
(if (setq TMP (assoc STR LST))
(setq LEN (vlax-curve-getdistatparam
EN
(vlax-curve-getendparam EN)
)
LST (subst (append TMP (list LEN)) TMP LST)
)
)
(setq I (1+ I))
)
;;2.显示
(setq PRTXT
"线条长度分类统计\n\n类型\t根数\t长度\n----------------------"
)
(foreach N LST
(if (> (length N) 2)
(setq LEN (apply '+ (cddr N))
PRTXT (strcat PRTXT
"\n"
(cadr N)
"\t"
(itoa (- (length N) 2))
"\t"
(rtos LEN 2 3)
)
)
)
)
(setq
PRTXT
(strcat
PRTXT
"\n\n总数:"
(itoa (- (length (apply 'append LST))
(* 2 (length LST))
)
)
"总长度:"
(rtos (apply '+
(apply 'append (mapcar 'cddr LST))
)
2
3
)
)
)
(princ PRTXT)
(alert PRTXT)
)
)
(princ)
)
本帖最后由 作者 于 2009-9-23 15:37:36 编辑 <br /><br /> <p><img alt="" src="http://www.mjtd.com/bbs/Skins/default/topicface/face2.gif"/>用了5楼的源码，为何不能统计多段线长度？我做了如下修改，不知对否</p><p>(vl-load-com)<br/>(defun C:SUMLEN (/)<br/> (setq LST '(("LINE" "直线")<br/> ("ARC" "圆弧")<br/> ("CIRCLE" "圆")<br/> ("LWPOLYLINE" "多段线")<br/> ("ELLIPSE" "椭圆")<br/> ("SPLINE" "样条线")<br/> )<br/> )<br/> (if (setq SS (ssget '((0 . "LINE,ARC,CIRCLE,LWPOLYLINE,ELLIPSE,SPLINE"))<br/> )<br/> )<br/> (progn<br/> ;;1.逐个统计<br/> (setq I 0)<br/> (repeat (sslength SS)<br/> (setq EN (ssname SS I)<br/> ENT (entget EN)<br/> STR (cdr (assoc 0 ENT))<br/> )<br/> (if (setq TMP (assoc STR LST))<br/> (setq LEN (vlax-curve-getdistatparam<br/> EN<br/> (vlax-curve-getendparam EN)<br/> )<br/> LST (subst (append TMP (list LEN)) TMP LST)<br/> )<br/> )<br/> (setq I (1+ I))<br/> )<br/> ;;2.显示<br/> (setq PRTXT<br/> "线条长度分类统计\n\n类型\t根数\t长度\n----------------------"<br/> )<br/> (foreach N LST<br/> (if (> (length N) 2)<br/> (setq LEN (apply '+ (cddr N))<br/> PRTXT (strcat PRTXT<br/> "\n"<br/> (cadr N)<br/> "\t"<br/> (itoa (- (length N) 2))<br/> "\t"<br/> (rtos LEN 2 3)<br/> )<br/> )<br/> )<br/> )<br/> (setq<br/> PRTXT<br/> (strcat<br/> PRTXT<br/> "\n\n总数:"<br/> (itoa (- (length (apply 'append LST))<br/> (* 2 (length LST))<br/> )<br/> )<br/> " 总长度:"<br/> (rtos (apply '+<br/> (apply 'append (mapcar 'cddr LST))<br/> )<br/> 2<br/> 3<br/> )<br/> )<br/> )<br/> (princ PRTXT)<br/> (alert PRTXT)<br/> )<br/> )<br/> (princ)<br/>)<br/></p> 好东东，下载了，谢谢分享！ 很受用啊，谢谢了 留名备用
程序不错