如何修改AutoLISP代码实现按线型分组统计多段线数量

大家好！
实现目标：在CAD命令框中按线型分组，列出所有独立多段线的对应数量。现有AutoLISP代码原生功能为按线型累加统计多段线总长度，只需调整核心累加逻辑即可实现数量统计需求。

原有长度统计代码 #

(defun C:Csőhossz_számoló ( / SS aL i e itm ltp b ) 
 (if
   (setq SS
     (ssget "_:L-I" 
       '((0 . "*POLYLINE")
         (-4 . "<NOT")
         (-4 . "<AND")
         (0 . "POLYLINE")
         (-4 . "&")
         (70 . 80)
         (-4 . "AND>")
         (-4 . "NOT>")
       )
     )
   )
   (progn
     (setq aL '())
     (repeat (setq i (sslength SS))
       (setq e (ssname SS (setq i (1- i))))
       (setq itm
         (cons
           (setq ltp (cond ( (cdr (assoc 6 (entget e))) ) ( "ByLayer" ) ))
           (+ (vlax-curve-getDistAtParam e 
                    (vlax-curve-getEndParam e)) 
              (setq b (cond ( (cdr (assoc ltp aL)) ) (0.))))
         )
       )
       (if (zerop b)
         (setq aL (cons itm aL))
         (setq aL (subst itm (assoc (car itm) aL) aL))
       )
     )
     (princ "\n============\n")
     (foreach x (vl-sort aL ''((a b) (apply '< (mapcar 'car (list a b)))) )
       (princ (car x)) (princ " : ") (princ (rtos (cdr x) 2 4))
       (princ "\n")
     )
     (princ "============")
     (textscr)
   )
 )
 (princ)
)

修改说明 #

核心改动只有两处：

• 把原代码中累加单根多段线长度的逻辑，替换为每次计数+1：原代码累加项是vlax-curve-getDistAtParam获取的单根多段线长度，直接替换为整数1，每遍历到1根符合筛选条件的多段线，对应线型的计数值就加1
• 调整输出格式：原代码用rtos函数把长度值格式化为保留4位小数的字符串，统计数量时直接用itoa把整数计数值转为字符串输出即可，不需要小数位

修改后可直接运行的代码 #

(defun C:CountPlineByLinetype ( / SS aL i e itm ltp b ) 
 (if
   (setq SS
     (ssget "_:L-I" 
       '((0 . "*POLYLINE")
         (-4 . "<NOT")
         (-4 . "<AND")
         (0 . "POLYLINE")
         (-4 . "&")
         (70 . 80)
         (-4 . "AND>")
         (-4 . "NOT>")
       )
     )
   )
   (progn
     (setq aL '())
     (repeat (setq i (sslength SS))
       (setq e (ssname SS (setq i (1- i))))
       (setq itm
         (cons
           (setq ltp (cond ( (cdr (assoc 6 (entget e))) ) ( "ByLayer" ) ))
           (+ 1 
              (setq b (cond ( (cdr (assoc ltp aL)) ) (0))))
         )
       )
       (if (zerop b)
         (setq aL (cons itm aL))
         (setq aL (subst itm (assoc (car itm) aL) aL))
       )
     )
     (princ "\n============\n")
     (foreach x (vl-sort aL ''((a b) (apply '< (mapcar 'car (list a b)))) )
       (princ (car x)) (princ " : ") (princ (itoa (cdr x)))
       (princ "\n")
     )
     (princ "============")
     (textscr)
   )
 )
 (princ)
)

使用方法 #

• 将修改后的代码复制到AutoCAD命令行回车加载，或保存为.lsp文件通过APPLOAD命令加载
• 加载完成后在命令行输入CountPlineByLinetype回车，即可自动筛选当前空间内符合条件的多段线，按线型分组统计数量
• 统计结果会自动弹出CAD文本窗口展示，线型为随层（ByLayer）的多段线会单独归类统计

内容的提问来源于stack exchange，提问作者Ozsvart Donat