谁能给我个 自动计算cad图中”一种线“总长的LISP
发布网友
发布时间：2023-04-23 12:47
共3个回答
热心网友
时间：2023-10-09 14:14
(defun c:tx (/ a b c d e m n n1) ;选择直线,统计总长度
(setq a (ssget)) ;得到选择集
(setq n 0) ;设置循环变量初值,同时也是遍历选择集的指针
(setq m 0) ;设置统计初值
(setq n1 (sslength a)) ;得到选择集长度
(while (< n n1) ;循环开始,以选择集对象数作为循环次数
(progn
(setq b (entget (ssname a n))) ;得到第n个对象的数据库
(setq c (cdr (assoc 10 b))) ;得到直线起点
(setq d (cdr (assoc 11 b))) ;得到直线终点
(setq e (distance c d)) ;得到两点距离,即直线长度
(setq m (+ m e)) ;累加直线长度
(setq n (+ n 1)) ;循环变量加一
)
)
(princ "共有") ;打印结果
(princ (itoa n1))
(princ "条直线，总长度为")
(princ (rtos m 2 4)) ;转换实数为字符串,小数形式,小数点后四位
(princ "。")
(princ)
)追问谢谢，你的只能算直线！
热心网友
时间：2023-10-09 14:14
(if (null vlax-mp-object)
(vl-load-com)
)
(princ "\n选择要进行线长统计的对象")
(if (setq #si 0 &ss (ssget))
(progn
(setq #lc 0 #ll 0 #lp 0 #lr 0 #nc 0 #nl 0 #np 0 #nr 0)
(repeat (sslength &ss)
(setq &cs (vlax-ename->vla-object (ssname &ss #si)) #si (1+ #si))
(cond
((= (vla-get-objectname &cs) "AcDbCircle")
(setq #lc (+ #lc (vla-get-circumference &cs)) #nc (1+ #nc))
)
((= (vla-get-objectname &cs) "AcDbArc")
(setq #lr (+ #lr (vla-get-arclength &cs)) #nr (1+ #nr))
)
((= (vla-get-objectname &cs) "AcDbPolyline")
(setq #lp (+ #lp (vla-get-length &cs)) #np (1+ #np))
)
((= (vla-get-objectname &cs) "AcDbLine")
(setq #ll (+ #ll (vla-get-length &cs)) #nl (1+ #nl))
)
)
)
(princ (strcat "\n选择的 " (itoa (sslength &ss)) " 个对象中:"))
(princ (strcat "\n圆形对象 = " (itoa #nc) " 个,线长 = " (rtos #lc 2 3) " ,"))
(princ (strcat "\n圆弧对象 = " (itoa #nr) " 个,线长 = " (rtos #lr 2 3) " ,"))
(princ (strcat "\n直线对象 = " (itoa #nl) " 个,线长 = " (rtos #ll 2 3) " ,"))
(princ (strcat "\n聚合对象 = " (itoa #np) " 个,线长 = " (rtos #lp 2 3) " ,"))
(princ (strcat "\n所有对象总线长 = " (rtos (+ #lc #lr #ll #lp) 2 3) " ."))
)
)
(princ)
)
命令DL使用,可计算直线，圆形，圆弧，聚合线的线长。追问能把椭圆和样条曲线也加进去吗？
追答(defun c:dl ( )
(if (null vlax-mp-object)
(vl-load-com)
)
(princ "\n选择要进行线长统计的对象")
(if (setq #si 0 &ss (ssget))
(progn
(setq #lc 0 #ll 0 #lp 0 #lr 0 #le 0 #ls 0 #nc 0 #nl 0 #np 0 #nr 0 #ne 0 #ns 0)
(repeat (sslength &ss)
(setq &cs (vlax-ename->vla-object (ssname &ss #si)) #si (1+ #si))
(cond
((= (vla-get-objectname &cs) "AcDbCircle")
(setq #lc (+ #lc (vla-get-circumference &cs)) #nc (1+ #nc))
)
((= (vla-get-objectname &cs) "AcDbArc")
(setq #lr (+ #lr (vla-get-arclength &cs)) #nr (1+ #nr))
)
((= (vla-get-objectname &cs) "AcDbPolyline")
(setq #lp (+ #lp (vla-get-length &cs)) #np (1+ #np))
)
((= (vla-get-objectname &cs) "AcDbLine")
(setq #ll (+ #ll (vla-get-length &cs)) #nl (1+ #nl))
)
((= (vla-get-objectname &cs) "AcDbEllipse")
(setq #le (+ #le (vlax-curve-getdistatparam &cs (vlax-curve-getendparam &cs))) #ne (1+ #ne))
)
((= (vla-get-objectname &cs) "AcDbSpline")
(setq #ls (+ #ls (vlax-curve-getdistatparam &cs (vlax-curve-getendparam &cs))) #ns (1+ #ns))
)
)
)
(princ (strcat "\n选择的 " (itoa (sslength &ss)) " 个对象中:"))
(princ (strcat "\n圆形对象 = " (itoa #nc) " 个,线长 = " (rtos #lc 2 3) " ,"))
(princ (strcat "\n圆弧对象 = " (itoa #nr) " 个,线长 = " (rtos #lr 2 3) " ,"))
(princ (strcat "\n直线对象 = " (itoa #nl) " 个,线长 = " (rtos #ll 2 3) " ,"))
(princ (strcat "\n聚合对象 = " (itoa #np) " 个,线长 = " (rtos #lp 2 3) " ,"))
(princ (strcat "\n椭圆对象 = " (itoa #ne) " 个,线长 = " (rtos #le 2 3) " ,"))
(princ (strcat "\n云形对象 = " (itoa #ns) " 个,线长 = " (rtos #ls 2 3) " ,"))
(princ (strcat "\n所有对象总线长 = " (rtos (+ #lc #lr #ll #lp #le #ls) 2 3) " ."))
)
)
(princ)
)
热心网友
时间：2023-10-09 14:14
兄弟，可以试着自己加呀。
