求CAD 文本统计插件

棉花糖_one

vitalgg 发表于 2024-1-29 19:45
想要识别天正，把 (0 . "text") 改成 (0 . "text,tch_text")
想要识别多行文本和天正，把 (0 . "text ...

楼主，你好，我用了你的文本统计很不错，有个问题很疑惑，就是生成的表格移动后文字就消失是什么原因？

vitalgg

棉花糖_one 发表于 2024-12-13 16:58
楼主，你好，我用了你的文本统计很不错，有个问题很疑惑，就是生成的表格移动后文字就消失是什么原因？

不好说，可能是字体不匹配吧。再一个可能就是表格样式的字体高度太小，实际绘制的表格行距又太大。

jzjzjz

用大佬思路让ai帮写

jzjzjz

， (defun c:TT (/ *error* ss lst zg pt *table-zg line-color text-color)   ;; 错误处理函数   (defun *error* (msg)     (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))       (princ (strcat "\n错误: " msg))     )     (princ)   )      ;; 设置颜色参数（用户可修改这里调整颜色）   (setq line-color 5)   ; 表格线颜色：蓝色（AutoCAD索引色）   (setq text-color 2)   ; 文字颜色：黄色    ;; 表格生成函数（添加颜色控制）   (defun TableLst2Table (lis pt zg / emkLine emkText h len1 len2 i h1 w2 tab_h len j w1 w2 wlst p0 p1 txt)     (defun emkLine (p1 p2)       (entmake (list '(0 . "LINE")                      (cons 8 "统计表格")                      (cons 62 line-color)  ; 添加线条颜色                     (cons 10 p1)                      (cons 11 p2)))     )     (defun emkText (pt str h)       (entmake (list '(0 . "TEXT")                      (cons 1 str)                      (cons 8 "统计表格")                      (cons 62 text-color)  ; 添加文字颜色                     (cons 10 pt)                      (cons 40 h)                      (cons 11 pt)                      (cons 72 1)                      (cons 73 2)))     )     ;; 以下保持原有表格生成逻辑不变     (setq h (* zg 2)           len1 (length lis)           len2 (apply 'max (mapcar 'length lis))           p0 (list (car pt) (- (cadr pt) (* 0.5 h))))     (setq lis (mapcar '(lambda (y) (mapcar 'vl-princ-to-string y)) lis))     (setq i 0 w2 0 wlst '())     (repeat len2       (foreach e lis         (setq txt (nth i e))         (if (not txt) (setq txt ""))         (setq w1 (* (+ (strlen txt) 1) zg))         (if (> w1 w2) (setq w2 w1))       )       (setq wlst (cons w2 wlst) w2 0 i (1+ i))     )     (setq wlst (reverse wlst))     (setq i 0 j 0 w1 0 w2 0)     (foreach e lis       (setq h1 (- (cadr p0) (* i h)))       (foreach f e         (setq w1 (nth j wlst) w2 (+ w2 w1))         (setq p1 (list (- (+ (car p0) w2) (* w1 0.5)) h1))         (emkText p1 f zg)         (setq j (1+ j))       )       (setq i (1+ i) j 0 w1 0 w2 0)     )     (setq tab_h (* len1 h))     (emkLine pt (polar pt (* pi 1.5) tab_h))     (setq len 0)     (foreach x wlst       (setq len (+ x len) p1 (polar pt 0 len))       (emkLine p1 (polar p1 (* pi 1.5) tab_h))     )     (setq i 0 len (apply '+ wlst))     (repeat (1+ len1)       (setq p1 (polar pt (* pi 1.5) (* i h)) i (1+ i))       (emkLine p1 (polar p1 0 len))     )     (princ)   )    ;; 主程序（保持原有逻辑不变）   (if (setq ss (ssget '((0 . "TEXT"))))     (progn       (if *table-zg          (princ)         (setq *table-zg (* 3 (getvar "DIMSCALE")))       )       (vlax-for x (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))         (setq str (vla-get-TextString x))         (if (setq item (assoc str lst))           (setq lst (subst (list str (1+ (cadr item))) item lst))           (setq lst (cons (list str 1) lst))         )       )       (setq lst         (vl-sort lst           (function             (lambda (a b / split-pa split-pb prefixA prefixB numA numB)               (defun split-prefix-number (str / i c found prefix num)                 (setq i 0 found nil prefix "" num 0)                 (while (and (< i (strlen str)) (not found))                   (setq c (substr str (1+ i) 1))                   (if (< 47 (ascii c) 58)                     (progn                       (setq found t)                       (setq num (atoi (substr str (1+ i))))                     )                     (setq prefix (strcat prefix c))                   )                   (setq i (1+ i))                 )                 (list prefix num)               )               (setq split-pa (split-prefix-number (car a)))               (setq split-pb (split-prefix-number (car b)))               (setq prefixA (car split-pa))               (setq numA (cadr split-pa))               (setq prefixB (car split-pb))               (setq numB (cadr split-pb))               (cond                 ((< prefixA prefixB) t)                 ((> prefixA prefixB) nil)                 ((< numA numB) t)                 ((> numA numB) nil)                 (t (< (car a) (car b)))               )             )           )         )       )       (setq groups '())       (foreach item lst         (setq key (substr (car item) 1 1))         (if (setq entry (assoc key groups))           (setq groups (subst (list key (append (cadr entry) (list item))) entry groups))           (setq groups (cons (list key (list item)) groups))         )       )       (setq groups (vl-sort groups (function (lambda (a b) (< (car a) (car b))))))       (setq max-rows (apply 'max (mapcar '(lambda (g) (length (cadr g))) groups)))       (setq table-data (list (mapcar 'car groups)))       (setq row-index 0)       (repeat max-rows         (setq current-row '())         (foreach g groups           (setq items (cadr g))           (if (< row-index (length items))             (setq current-row (cons (strcat (car (nth row-index items)) "=" (itoa (cadr (nth row-index items)))) current-row))             (setq current-row (cons "" current-row))           )         )         (setq table-data (append table-data (list (reverse current-row))))         (setq row-index (1+ row-index))       )       (initget 0 "S")       (if (setq pt (getpoint (strcat "\n指定插入点[设置(S)文字高度]<当前:" (rtos *table-zg) ">: ")))         (progn           (if (= (type pt) 'STR)             (progn               (setq *table-zg (getreal (strcat "\n请输入新的文字高度<" (rtos *table-zg) ">: ")))               (initget 0 "S")               (setq pt (getpoint (strcat "\n指定插入点[设置(S)文字高度]<当前:" (rtos *table-zg) ">: ")))             )           )           (TableLst2Table table-data (trans pt 1 0) *table-zg)         )       )     )     (alert "未选择文字对象！")   )   (princ) )

jzjzjz

效果展示11111111

jzjzjz

效果展示111111