想要识别天正，把 (0 . "text") 改成 (0 . "text,tch_text")
想要识别多行文本和天正，把 (0 . "text ...
楼主，你好，我用了你的文本统计很不错，有个问题很疑惑，就是生成的表格移动后文字就消失是什么原因？ 棉花糖_one 发表于 2024-12-13 16:58
楼主，你好，我用了你的文本统计很不错，有个问题很疑惑，就是生成的表格移动后文字就消失是什么原因？
不好说，可能是字体不匹配吧。再一个可能就是表格样式的字体高度太小，实际绘制的表格行距又太大。 用大佬思路让ai帮写 ， (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) ) 效果展示11111111 效果展示111111
页:
1
[2]