按线型统计长度并输出总长度

刘大叔

之前在“源码共享”版块看到的一个帖子，原帖如下：按线型统计长度，求助 - 源码共享 - AutoCAD论坛 - 明经CAD社区 - Powered by Discuz! (mjtd.com)
原帖的问题说是已解决，由“飞雪神光”修改的lsp代码如下：

2. <blockquote>(defun c:mm4(/ bf-curve-length jg lm-entmake-text n num1 num2 pt ss ss2 ty xx zc)

<blockquote>(defun c:mm4(/ bf-curve-length jg lm-entmake-text n num1 num2 pt ss ss2 ty xx zc)

我只是修改了输出的字体高度和行距，修改后的代码如下：

2. (defun c:mm4(/ bf-curve-length jg lm-entmake-text n num1 num2 pt ss ss2 ty xx zc)
   
3.   (defun BF-curve-Length (curve)
   
4.                 (vlax-curve-getDistAtParam
   
5.                         curve
   
6.                         (vlax-curve-getEndParam curve)
   
7.                 )
   
8.         )
   
9.         (defun lm-entmake-text(tdata / pt wz gd co tc)
   
10.                 (mapcar'set '(pt wz gd co tc) tdata)
    
11.                 (or co (setq co 256))
    
12.                 (or tc (setq tc (getvar "clayer")))
    
13.                 (entmake(list '(0 . "text")(cons 8 tc)(cons 62 co)'(50 . 0.0) (cons 10 pt)(cons 11 pt)(cons 1 wz)'(7 . "Standard")(cons 40 gd)'(6 . "Continuous")'(41 . 0.8)'(72 . 1)'(210 0.0 0.0 1.0)'(100 . "AcDbText")'(73 . 2)))
    
14.                 (entlast)
    
15.         )
    
16.         (setq ss (ssget '((0 . "*LINE,CIRCLE,ARC") (-4 . "<NOT") (6 . "bylayer") (-4 . "NOT>") (-4 . "<NOT") ( 6 . "byblock") (-4 . "NOT>"))))
    
17.   (setq pt (getpoint "指定统计结果写入位置："))
    
18.   (setq num1 (sslength ss) num2 0)
    
19.   (while (/= num1 num2)
    
20.     (setq
    
21.                         ty (ssname ss 0)
    
22.                         xx (cdr (assoc 6 (entget ty)))
    
23.                         ss2 (ssget "p" (list (cons 6 xx)))
    
24.                         zc 0
    
25.                         n 0
    
26.                 )
    
27.                 (repeat (sslength ss2)
    
28.                         (setq ty (ssname ss2 n))
    
29.                         (setq zc (+ zc (BF-curve-Length ty)))
    
30.                         (setq n (+ n 1))
    
31.                 )
    
32.                 (setq jg (strcat xx "=" (rtos (/ zc 1000) 2 2) "米"))
    
33.                 (lm-entmake-text (list pt jg 350))  ；字体高度
    
34.                 (setq pt (polar pt (* pi 1.5) 500)) ；行距
    
35.                 (setq num2 (+ num2 (sslength ss2)))
    
36.                 (command "Select" ss "R" ss2 "")
    
37.                 (setq ss (ssget "_P"))
    
38.         )
    
39. )

(defun c:mm4(/ bf-curve-length jg lm-entmake-text n num1 num2 pt ss ss2 ty xx zc)<br />   (defun BF-curve-Length (curve)<br />                 (vlax-curve-getDistAtParam<br />                         curve<br />                         (vlax-curve-getEndParam curve)<br />                 )<br />         )<br />         (defun lm-entmake-text(tdata / pt wz gd co tc)<br />                 (mapcar'set '(pt wz gd co tc) tdata)<br />                 (or co (setq co 256))<br />                 (or tc (setq tc (getvar "clayer")))<br />                 (entmake(list '(0 . "text")(cons 8 tc)(cons 62 co)'(50 . 0.0) (cons 10 pt)(cons 11 pt)(cons 1 wz)'(7 . "Standard")(cons 40 gd)'(6 . "Continuous")'(41 . 0.8)'(72 . 1)'(210 0.0 0.0 1.0)'(100 . "AcDbText")'(73 . 2)))<br />                 (entlast)<br />         )<br />         (setq ss (ssget '((0 . "*LINE,CIRCLE,ARC") (-4 . "<NOT") (6 . "bylayer") (-4 . "NOT>") (-4 . "<NOT") ( 6 . "byblock") (-4 . "NOT>"))))<br />   (setq pt (getpoint "指定统计结果写入位置："))<br />   (setq num1 (sslength ss) num2 0)<br />   (while (/= num1 num2)<br />     (setq <br />                         ty (ssname ss 0)<br />                         xx (cdr (assoc 6 (entget ty)))<br />                         ss2 (ssget "p" (list (cons 6 xx)))<br />                         zc 0<br />                         n 0<br />                 )<br />                 (repeat (sslength ss2)<br />                         (setq ty (ssname ss2 n))<br />                         (setq zc (+ zc (BF-curve-Length ty)))<br />                         (setq n (+ n 1))<br />                 )<br />                 (setq jg (strcat xx "=" (rtos (/ zc 1000) 2 2) "米"))<br />                 (lm-entmake-text (list pt jg 350))  ；字体高度<br />                 (setq pt (polar pt (* pi 1.5) 500)) ；行距<br />                 (setq num2 (+ num2 (sslength ss2)))<br />                 (command "Select" ss "R" ss2 "")<br />                 (setq ss (ssget "_P"))<br />         )<br /> )

在cad2023中运行，显示“错误，参数太多”。请大神帮助修改代码，谢谢！
如能达成以下要求最好：
输出的时候能否以表格形式呈现，譬如：


希望能有大神解决问题，第一次发悬赏贴，悬赏的明经币不够的话留言哈。
附件如下：

xj6019

玩玩看，是这个意思不

刘大叔

xj6019 发表于 2023-12-10 14:24
玩玩看，是这个意思不

就是这个！大神果然厉害！已设置最佳答案，感谢！

龙山居士

xj6019 发表于 2023-12-10 13:29
玩玩看，是这个意思不

可以改个按颜色的吗