autolisp批量统计系统图中的开关数量

报价或者核对图纸的时候经常要一个个数每台配电柜或配电箱上面的开关数量，即浪费时间，又容易算错，所以写了这个自动统计开关数量的命令，用了之后工作效率提高了不少。

;批量统计系统图上配电柜和配电箱的开关数量

(defun c:sbt()
    (setq str "")
    (setq i 1)
    (while (= i 1)    
        (setq str (strc str "\n请选择柜子或箱子编号：" ","))
        (setq str (strcat str "\n"))
        (setq j (getint "请输入命令：0 主路为单个开关或单个双电源、1 主路为双电源并含有两个进线开关\n"))
        (if (= j 0)
            (progn
                (setq str (strc str "\n请选择主路开关或双电源型号：" " "))
                (setq str (strcat str ": 1\n")) 
            )
            (progn
                (setq str (strc str "\n请选择常用或备用开关：" " "))
                (setq str (strcat str ": 2\n")) 
                (setq str (strc str "\n请选择双电源型号：" " "))
                (setq str (strcat str ": 1\n")) 
            )
        )
        (setq str (subtotal (getlist) str)) ;选择开关型号
        (setq str (strcat str "\n"))
        (setq i (getint "请输入命令：0 结束、1 继续\n"))
    )
    (ZML-CLIP-SETSTRING str)
)


;对表中的文本进行分类汇总
(defun subtotal(lt str)
    (setq e (car lt))
    (if (/= e nil)
        (progn
        (setq lt1(vl-remove e lt))
        (setq len1 (length lt))
        (setq len2 (length lt1))
        (setq str (strcat str e ": " (itoa (- len1 len2)) "\n"))
        (setq str (subtotal lt1 str))
        )
    )
    (setq str str)
)


;返回单行文本集合表
(defun getlist()
    (setq s nil)
    (while (= s nil)
        (princ "\n请选择开关型号：")
        (setq s (ssget (list (cons 0  "text"))));text为单行文本，mtext为多行文本
     )
    (setq sl
        (sslength s)
    )
    (setq st 0)
    (setq lt(list))
    (while (< st sl)
        (setq e(ssname s st))
        (setq st(1+ st))
        (setq txt
            (cdr (assoc 1 (entget e)))
        )
        (setq lt(cons txt lt))
        (setq lt (reverse lt)) ;反转列表
    )
)


;功能：连接选中字符串
;@str：输入字符串
;@msg: 提示信号
;@seg：分割符
(defun strc(str msg seg)
    (setq s nil)
    (while (= s nil)
        (princ msg)
        (setq s (ssget (list (cons 0  "text"))));text为单行文本，mtext为多行文本
     )
    (setq sl
        (sslength s)
    )
    (setq st 0)
    (setq str1 "")
    (while (< st sl)
        (setq e(ssname s st))
        (setq st(1+ st))
        (setq txt
            (cdr (assoc 1 (entget e)))
        )
        (setq str1 (strcat str1 seg txt))
    )
    (setq str1 (substr str1 2));去掉前面逗号
    (setq str (strcat str str1))
)

;;;功能：向系统剪贴板写入文字                                       *
(defun ZML-CLIP-SETSTRING (STR / HTML RESULT)
    (and (= (type STR) 'STR)
        (setq HTML (vlax-create-object "htmlfile"))
        (setq RESULT (vlax-invoke
            (vlax-get (vlax-get HTML 'PARENTWINDOW)
                'CLIPBOARDDATA
            )
            'SETDATA
            "Text"
            STR
            )
        )
        (vlax-release-object HTML)
    )
)