LSP CAD 标注按颜色统计

情缘侠

[AppleScript] 纯文本查看 复制代码

?

01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49

(defun c:TJBZ2 (/ cmd ssa i n dxf bz color-data color-index entry color-sum color-map output)     (setq cmd (getvar "cmdecho"))     (setvar "cmdecho" 0)     (if (and (princ "\n请选取标注: ") (setq ssa (ssget '((0 . "DIMENSION")))))         (progn             (setq color-sum nil)  ; 初始化颜色统计列表             (setq i 0)             (setq n (sslength ssa))             (repeat n                 (setq dxf (entget (ssname ssa i)))                 ;; 提取标注值                 (if (= (cdr (assoc 1 dxf)) "")                     (setq bz (cdr (assoc 42 dxf)))  ; 使用实际测量值                     (setq bz (atof (cdr (assoc 1 dxf)))) ; 使用覆盖文本                 )                 ;; 提取颜色索引（若不存在则返回0）                 (setq color-index (cdr (assoc 62 dxf)))                 (if (null color-index) (setq color-index 0))                 ;; 更新颜色总长统计                 (if (setq entry (assoc color-index color-sum))                     (setq color-sum (subst (cons color-index (+ (cdr entry) bz)) entry color-sum))                     (setq color-sum (cons (cons color-index bz) color-sum))                 )                 (setq i (1+ i))             )             ;; 定义颜色名称映射表             (setq color-map '((0 . "随层") (1 . "红") (2 . "黄") (3 . "绿")                              (4 . "青") (5 . "蓝") (6 . "洋红") (7 . "白")))             ;; 构建输出字符串             (setq output "")             (foreach entry (vl-sort color-sum '(lambda (x y) (< (car x) (car y))))  ; 按颜色索引排序                 (setq color-index (car entry))                 (setq total (cdr entry))                 (setq color-name (cdr (assoc color-index color-map)))                 (if (null color-name)                     (setq color-name (strcat "索引" (itoa color-index)))                 )                 (setq output                     (strcat output "\n颜色：" (itoa color-index) " - " color-name                            " = " (rtos total 2 2) "m")                 )             )             ;; 清理并输出结果             (princ (strcat "\n统计结果：" output))         )     )     (setvar "cmdecho" cmd)     (princ) )

统计结果：
颜色：1 - 红 = 189m
颜色：2 - 黄 = 1560m
颜色：3 - 绿 = 295m
颜色：5 - 蓝 = 927m
颜色：6 - 洋红 = 2246m
颜色：7 - 白 = 24m
颜色：32 - 索引32 = 175m
颜色：64 - 索引64 = 40.5m

ttttyyyy

感谢提供分享！,,学习了..

Murcilago

不明觉厉哦

xiexiela

先存为脚本了，感谢

xiexiela

但是加载了一下，CAD提示有错误
错误: 输入的点对中含有多余的 cdrs

abca

同样提示错误: 输入的点对中含有多余的 cdrs

情缘侠

abca 发表于 2025-4-3 09:59
同样提示错误: 输入的点对中含有多余的 cdrs

[AppleScript] 纯文本查看 复制代码

?

01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53

(defun c:TJBZ3 (/ cmd ssa i n dxf bz color-data color-index entry color-sum color-map output)   (setq cmd (getvar "cmdecho"))   (setvar "cmdecho" 0)   (if (and (princ "\n请选取标注: ") (setq ssa (ssget '((0 . "DIMENSION")))))     (progn       (setq color-sum nil) ; 初始化颜色统计列表       (setq i 0)       (setq n (sslength ssa))       (repeat n         (setq dxf (entget (ssname ssa i)))         ;; 安全提取标注值（组码1或42）         (setq bz (cond                   ((= (cdr (assoc 1 dxf)) "") ; 检查组码1是否为空                    (if (assoc 42 dxf)                      (cdr (assoc 42 dxf))     ; 使用组码42的测量值                      0.0))                    ; 默认值                   (t                    (atof (vl-princ-to-string (cdr (assoc 1 dxf))))))) ; 强制转换为数字         ;; 安全提取颜色索引（组码62）         (setq color-index (if (assoc 62 dxf)                             (cdr (assoc 62 dxf))                             0)) ; 默认随层颜色         ;; 更新颜色总长统计         (if (setq entry (assoc color-index color-sum))           (setq color-sum (subst (cons color-index (+ (cdr entry) bz)) entry color-sum))           (setq color-sum (cons (cons color-index bz) color-sum))         )         (setq i (1+ i))       )       ;; 定义颜色名称映射表       (setq color-map '((0 . "随层") (1 . "红") (2 . "黄") (3 . "绿")                         (4 . "青") (5 . "蓝") (6 . "洋红") (7 . "白")))       ;; 构建输出字符串       (setq output "")       (foreach entry (vl-sort color-sum '(lambda (x y) (< (car x) (car y)))) ; 按颜色索引排序         (setq color-index (car entry))         (setq total (cdr entry))         (setq color-name (cdr (assoc color-index color-map)))         (if (null color-name)           (setq color-name (strcat "索引" (itoa color-index)))         )         (setq output           (strcat output "\n颜色：" (itoa color-index) " - " color-name                   " = " (rtos total 2 2) "m")         )       )       ;; 清理并输出结果       (princ (strcat "\n统计结果：" output))     )   )   (setvar "cmdecho" cmd)   (princ) )

jiaoquangb

可以统计块吗？