寻求 批量查找特定文字 在其 文字上方加入 带序号前缀

jh3030912

例如  以下数据   FM甲1021  M2535   MM00   C5800   FC1058  CC00

通过查找M和C(不区分大小写） 并且排除  MM和CC

最终实现效果为    1#                2#                     3#          4#
                       FM甲1021      M2535    MM00   C5800      FC1058     CC00

有以下要求：
1、需要注意的是 查找的文字 可以是单行文字，多行文字，块内文字，天正文字等等
2、考虑到加入前缀后文字会变宽，接近文字可能会重叠，最好就是前缀和文字平行显示， 不要在一行显示  。
例如不要显示为 （有时候会重叠）    1# FM甲10212#M2535    MM00   3#C58004# FC1058     CC00
3、序号前缀可以设置字体 大小和颜色，便于区分

说明：其实CAD自带的查找 替换 可以简单实现，但是需要手工的一个个的加入 数字前缀，导致很繁琐。

vitalgg

如果无法播放，请点击此处在新窗口打开

1. (defun check-text (ent / str)
   
2.   (setq matchs '("*M*" "*C*"))
   
3.   (setq notmatchs '("*MM*" "*CC*"))
   
4.   (if (setq str (entity:getdxf ent 1))
   
5.       (and
   
6.        (apply 'or (mapcar '(lambda(x)(wcmatch (strcase str) x)) matchs))
   
7.        (apply 'and (mapcar '(lambda(x)(wcmatch (strcase str) (strcat "~" x))) notmatchs)))))
   
8.   
   
9. (defun findtext ()
   
10.   (setq txts (pickset:to-list (ssget '((0 . "*text,attrib,insert")))))
    
11.   (setq txts
    
12.   (vl-remove-if-not
    
13.    '(lambda(txt)
    
14.      (cond
    
15.        ((/= "INSERT" (entity:getdxf txt 0))
    
16.         (check-text txt))
    
17.        ((= "INSERT" (entity:getdxf txt 0))
    
18.         (setq entlst (block:ent-list (entity:getdxf txt 2)))
    
19.         (setq flag nil)
    
20.         (while (and (setq ent (car entlst))
    
21.         (null flag))
    
22.     (if (wcmatch (entity:getdxf ent 0) "*TEXT")
    
23.         (setq flag
    
24.         (check-text ent)))
    
25.     (setq entlst (cdr entlst))
    
26.     )
    
27.         flag)))
    
28.    txts)))
    
29. 
    
30. (defun mark-order (ents)
    
31.   (setq i 0)
    
32.   (foreach
    
33.    ent ents
    
34.    (cond
    
35.      ((/=  "INSERT" (entity:getdxf ent 0))
    
36.       ;; 取文字中点
    
37.       (setq pt-mid (apply 'point:mid (entity:getbox ent 0)))
    
38.       ;; 高度，角度
    
39.       (setq h (entity:getdxf ent 40))
    
40.       (setq ang (entity:getdxf ent 50))
    
41.       (entity:putdxf
    
42.        (entity:make-text
    
43.   (strcat (itoa (setq i (1+ i)))"#")
    
44.   (polar pt-mid (+ (* 0.5 pi) ang) h)
    
45.   (* 0.9 h)
    
46.   ang 0.8 0 "MM")
    
47.        62
    
48.        1
    
49.        ))
    
50.      ;; 块引用
    
51.      ((=  "INSERT" (entity:getdxf ent 0))
    
52.       (setq pt-ins (entity:getdxf ent 10))
    
53.       (setq ang-ins (entity:getdxf ent 50))
    
54.       (setq scale-ins (entity:getdxf ent 41))
    
55.       (setq subents (block:ent-list(setq blkname (entity:getdxf ent 2))))
    
56.       (setq pt-base (entity:getdxf (tblobjname "block" blkname) 10))
    
57.       (setq subents
    
58.       (vl-remove-if-not
    
59.        '(lambda(x)
    
60.          (and (wcmatch (entity:getdxf x 0) "*TEXT")
    
61.     (check-text x)))
    
62.        subents)
    
63.       )
    
64.       (foreach
    
65.        subent subents
    
66.        ;; 取文字中点 坐标变换
    
67.        ;;(print (entity:getbox subent 0))
    
68.        (setq pt-mid(apply 'point:mid (entity:getbox subent 0)))
    
69.        (setq pt-mid (block:bcs2wcs pt-mid pt-base pt-ins ang-ins scale-ins))
    
70.        ;; 高度，角度
    
71.        (setq h (entity:getdxf subent 40))
    
72.        (setq ang (+ (entity:getdxf subent 50)
    
73.         ang-ins
    
74.         ))
    
75.        (entity:putdxf
    
76.   (entity:make-text
    
77.    (strcat (itoa (setq i (1+ i)))"#")
    
78.    (polar pt-mid (+ (* 0.5 pi) ang) h)
    
79.    (* 0.9 h)
    
80.    ang 0.8 0 "MM")
    
81.   62
    
82.   1
    
83.   )))
    
84.      
    
85.       )))

(defun check-text (ent / str)<br />   (setq matchs '("*M*" "*C*"))<br />   (setq notmatchs '("*MM*" "*CC*"))<br />   (if (setq str (entity:getdxf ent 1))<br />       (and <br />        (apply 'or (mapcar '(lambda(x)(wcmatch (strcase str) x)) matchs))<br />        (apply 'and (mapcar '(lambda(x)(wcmatch (strcase str) (strcat "~" x))) notmatchs)))))<br />   <br /> (defun findtext ()<br />   (setq txts (pickset:to-list (ssget '((0 . "*text,attrib,insert")))))<br />   (setq txts<br />   (vl-remove-if-not<br />    '(lambda(txt)<br />      (cond<br />        ((/= "INSERT" (entity:getdxf txt 0))<br />         (check-text txt))<br />        ((= "INSERT" (entity:getdxf txt 0))<br />         (setq entlst (block:ent-list (entity:getdxf txt 2)))<br />         (setq flag nil)<br />         (while (and (setq ent (car entlst))<br />         (null flag))<br />     (if (wcmatch (entity:getdxf ent 0) "*TEXT")<br />         (setq flag<br />         (check-text ent)))<br />     (setq entlst (cdr entlst))<br />     )<br />         flag)))<br />    txts)))<br /> <br /> (defun mark-order (ents)<br />   (setq i 0)<br />   (foreach<br />    ent ents<br />    (cond<br />      ((/=  "INSERT" (entity:getdxf ent 0))<br />       ;; 取文字中点<br />       (setq pt-mid (apply 'point:mid (entity:getbox ent 0)))<br />       ;; 高度，角度<br />       (setq h (entity:getdxf ent 40))<br />       (setq ang (entity:getdxf ent 50))<br />       (entity:putdxf <br />        (entity:make-text<br />   (strcat (itoa (setq i (1+ i)))"#")<br />   (polar pt-mid (+ (* 0.5 pi) ang) h)<br />   (* 0.9 h)<br />   ang 0.8 0 "MM")<br />        62<br />        1<br />        ))<br />      ;; 块引用<br />      ((=  "INSERT" (entity:getdxf ent 0))<br />       (setq pt-ins (entity:getdxf ent 10))<br />       (setq ang-ins (entity:getdxf ent 50))<br />       (setq scale-ins (entity:getdxf ent 41))<br />       (setq subents (block:ent-list(setq blkname (entity:getdxf ent 2))))<br />       (setq pt-base (entity:getdxf (tblobjname "block" blkname) 10))<br />       (setq subents<br />       (vl-remove-if-not<br />        '(lambda(x)<br />          (and (wcmatch (entity:getdxf x 0) "*TEXT")<br />     (check-text x)))<br />        subents)<br />       )<br />       (foreach<br />        subent subents<br />        ;; 取文字中点 坐标变换<br />        ;;(print (entity:getbox subent 0))<br />        (setq pt-mid(apply 'point:mid (entity:getbox subent 0)))<br />        (setq pt-mid (block:bcs2wcs pt-mid pt-base pt-ins ang-ins scale-ins))<br />        ;; 高度，角度<br />        (setq h (entity:getdxf subent 40))<br />        (setq ang (+ (entity:getdxf subent 50)<br />         ang-ins<br />         ))<br />        (entity:putdxf <br />   (entity:make-text<br />    (strcat (itoa (setq i (1+ i)))"#")<br />    (polar pt-mid (+ (* 0.5 pi) ang) h)<br />    (* 0.9 h)<br />    ang 0.8 0 "MM")<br />   62<br />   1<br />   )))<br />      <br />       )))

liuhe

快内文字，这么麻烦的替换，是不是绘图不规范啊。

jh3030912

liuhe 发表于 2023-8-4 13:44
快内文字，这么麻烦的替换，是不是绘图不规范啊。

是的，图纸很不规范，乱七八糟的，扒图和统计起来经常有漏的和错误的

vitalgg

有没有这种情况
M33MM55
如果有，算哪种？

jh3030912

vitalgg 发表于 2023-8-4 15:27
有没有这种情况
M33MM55
如果有，算哪种？

基本上 不会存在这种情况的，都是单独的 ，要不M33，要不MM55

jh3030912

vitalgg 发表于 2023-8-4 18:59

老师，大概就是这种效果的，我是小白刚接触，不知道怎么使用这个代码，是复制下来做成LSP格式还是？启动命令是什么？我按照视频的命令 ERASE 是删除命令

jh3030912

vitalgg 发表于 2023-8-4 12:05

老哥你好。这个能不能再帮忙更新一下，1、编号 和 查找的文字 用一个斜线连接或者 圈起来  2、编号和查找的文字 整体可以提取到EXCEL表格，例如提取出来为   1# FM甲1021    2#M2535    3#C5800