●●●●●实用程序：查找替换程序 求再增强●●●●●

CTC

偶得一程序，求修改
说明：CAD自带查找替换，缺拾取文字功能。而这个程序刚好有这个功能，希望各位完美下。

1）增加一按钮“选择范围亮显查找文本数量” 。 如查找文字为“H”，选择范围后，CAD屏上会亮显某个范围内“H”的文字，并在命令行上提示：已找到并选择共 26 个包含“H”的对象，有2个文本重叠。（这个功能是CAD自带的）

2）替换最好支持属性文字。替换时命令行有这样的提示：已找替换了 26 个包含“L”的对象。

朗少的：
http://bbs.mjtd.com/forum.php?mo ... mp;page=1#pid501237

1. 
   
2. ;支持cad单行和多行文字、TZ单行和多行文字
   
3. (defun c:CZ(/ fn x dclid lin return# sstxt ssl ct0 ct edata etext txtln subln schct DCL_ID newtext en1 ob entype a)
   
4.   (setvar "cmdecho" 0)
   
5.   (command "_.undo" "_begin")
   
6. (defun xsdhk();显示对话框
   
7.   (setq fname (vl-filename-mktemp nil nil ".dcl"))
   
8.   (setq fn (open fname "w"))
   
9.       (foreach x '(
   
10.                    "  czth : dialog{"
    
11.                    "  label=\"查找替换V1.0--阿甘\";"
    
12.           "  spacer_1;"
    
13.          "  :row {"
    
14.                    "  :edit_box"
    
15.                    "  {"
    
16.                    "    label=\"查找\";"
    
17.                    "    key=\"oldword\";"
    
18.           "    width = 45 ;"
    
19.           "    height = 1.2 ;"
    
20.                    "    allow_accept=true;"
    
21.                    "  }"
    
22.          "  :button{key=\"1\";label=\"拾取\";width=6;}"
    
23.          "  }"
    
24.           "  spacer;"
    
25.          "  :row {"
    
26.                    "  :edit_box"
    
27.                    "  {"
    
28.                    "    label=\"替换\";"
    
29.                    "    key=\"newword\";"
    
30.           "    width = 45 ;"
    
31.           "    height = 1.2 ;"
    
32.                    "    allow_accept=true;"
    
33.                    "  }"
    
34.          "  :button{key=\"2\";label=\"拾取\";width=6;}"  
    
35.          "  }"
    
36.           "  spacer;"
    
37.          "  :row {"
    
38.          "  :button{key=\"3\";label=\"选择范围替换\";width=6;}"
    
39.                    "  cancel_button;"
    
40.                    "}"
    
41.          "}"
    
42.                   ) ; endlist
    
43.         (princ x fn)
    
44.         (write-line "" fn)
    
45.       ) ; end foreach
    
46. 
    
47.   (close fn)
    
48.   (setq fn (open fname "r"))
    
49.   (setq dclid (load_dialog fname))
    
50.   (while (or (eq (substr (setq lin (vl-string-right-trim "\" fn)" (vl-string-left-trim "(write-line \"" (read-line fn)))) 1 2) "//") (eq (substr lin 1 (vl-string-search " " lin)) "") (not (eq (substr lin (+ (vl-string-search " " lin) 1) 9) " : dialog"))))
    
51.   (new_dialog (substr lin 1 (vl-string-search " " lin)) dclid)
    
52.     (if oldch
    
53.       (set_tile "oldword" oldch)
    
54.       (set_tile "oldword" "")
    
55.     )
    
56.     (if newch
    
57.       (set_tile "newword" newch)
    
58.       (set_tile "newword" "")
    
59.     )
    
60.           (mode_tile "oldword" 2)
    
61.           (action_tile "oldword" "(setq oldch $value)")
    
62.           (action_tile "newword" "(setq newch $value)")
    
63.           (action_tile "1" "(done_dialog 1)")
    
64.           (action_tile "2" "(done_dialog 2)")
    
65.           (action_tile "3" "(done_dialog 3)")
    
66.           (action_tile "cancel" "(done_dialog 0)")
    
67.      
    
68.   (setq re (start_dialog))
    
69.      (cond
    
70.       ((= re 1) (shiqu1))
    
71.       ((= re 2) (shiqu2))
    
72.       ((= re 3) (tihuan))
    
73.   )
    
74.   
    
75.   (start_dialog)
    
76.   (unload_dialog dclid)
    
77.   (close fn)
    
78.   (vl-file-delete fname)
    
79. );end xsdhk
    
80. 
    
81. (defun tihuan ()
    
82.   (if (and (/= oldch "")(/= oldch newch)
    
83. (setq sstxt (ssget '((-4 . "<OR")(0 . "*TEXT")(0 . "TCH_DRAWINGNAME")(-4 . "OR>")))))
    
84.     (progn
    
85.       (setq ssl (sslength sstxt)
    
86.             ct0 0
    
87.             ct 0
    
88.             subln (strlen oldch)
    
89.       oldtxtln (strlen oldch)
    
90.       )
    
91.       (while (< ct0 ssl)
    
92.     (setq en1 (ssname sstxt ct0));图元名
    
93.         (setq edata (entget en1);组码
    
94.               etext (cdr (assoc 1 edata));文字内容
    
95.          entype (cdr (assoc 0 edata));文字类型
    
96.               txtln (strlen etext)
    
97.               schct 1
    
98.               newtext ""
    
99.         )
    
100.         (while (<= schct txtln)
     
101.               (if (= (setq readch (substr etext schct subln)) oldch)
     
102.        (setq schct (+ schct subln)
     
103.                       a newch)
     
104.                 (progn
     
105.         (if (> (ascii (substr readch 1 1)) 127);如果是汉字
     
106.          (progn
     
107.                     (setq readch (substr etext schct (1+ subln)));多读取一个字节
     
108.           (setq schct (+ schct 2));加2字节
     
109.           (setq a (substr readch 1 2));就取第1.2个字节为a
     
110.          )
     
111.          (progn
     
112.           (setq schct (1+ schct))
     
113.           (setq a (substr readch 1 1))
     
114.          )
     
115.         )
     
116.                 )
     
117.               )
     
118.     (setq newtext (strcat newtext a))
     
119.         )
     
120.         (if (/= etext newtext)
     
121.           (progn     
     
122.       (setq ob (vlax-ename->vla-object en1)) ;转换
     
123.       (if (= entype "TEXT") (vlax-put-property ob 'TextString newtext)) ;改变特性
     
124.       (if (= entype "TCH_MTEXT") (entmod (subst (cons 1 newtext) (assoc 1 edata) edata))) ;改变特性
     
125.       (if (= entype "MTEXT") (vlax-put-property ob 'TextString newtext)) ;改变特性
     
126.       (if (= entype "TCH_TEXT") (vlax-put-property ob 'Text newtext)) ;改变特性
     
127.       (if (= entype "TCH_DRAWINGNAME") (vlax-put-property ob 'NameText newtext)) ;改变特性
     
128.             (setq ct (1+ ct))
     
129.           )
     
130.         )
     
131.    (setq ct0 (1+ ct0))
     
132.       )
     
133.       (alert (strcat "  共替换了" (itoa ct) "个"))
     
134.    (princ (strcat ">>>>>>>>>共替换了" (itoa ct) "个"))
     
135.     )
     
136.   )
     
137. );end tihuan
     
138. (defun shiqu1 (/ ent1 ent2 entdata enttext)
     
139.   (if (setq ent1 (entsel ))
     
140.   (progn
     
141.     (setq ent2 (car ent1);图元名
     
142.             entdata (entget ent2);组码
     
143.             enttext (cdr (assoc 1 entdata));文字内容
     
144.         )
     
145.    (setq oldch enttext)
     
146.    (setq newch enttext)
     
147.    (xsdhk)
     
148. ))
     
149. );end shiqu1
     
150. (defun shiqu2 (/ ent1 ent2 entdata enttext)
     
151.   (if (setq ent1 (entsel ))
     
152.   (progn
     
153.     (setq ent2 (car ent1);图元名
     
154.             entdata (entget ent2);组码
     
155.             enttext (cdr (assoc 1 entdata));文字内容
     
156.         )
     
157.    (setq newch enttext)
     
158.    (xsdhk)
     
159. ))
     
160. );end shiqu2
     
161. 
     
162. (xsdhk)
     
163. (command "_.undo" "_end")
     
164. (setvar "cmdecho" 1)
     
165. (princ)
     
166. )
     

<br /> ;支持cad单行和多行文字、TZ单行和多行文字<br /> (defun c:CZ(/ fn x dclid lin return# sstxt ssl ct0 ct edata etext txtln subln schct DCL_ID newtext en1 ob entype a)<br />   (setvar "cmdecho" 0)<br />   (command "_.undo" "_begin")<br /> (defun xsdhk();显示对话框<br />   (setq fname (vl-filename-mktemp nil nil ".dcl"))<br />   (setq fn (open fname "w"))<br />       (foreach x '(<br />                    "  czth : dialog{"<br />                    "  label=\"查找替换V1.0--阿甘\";"<br />           "  spacer_1;"<br />          "  :row {"<br />                    "  :edit_box"<br />                    "  {"<br />                    "    label=\"查找\";"<br />                    "    key=\"oldword\";"<br />           "    width = 45 ;"<br />           "    height = 1.2 ;"<br />                    "    allow_accept=true;"<br />                    "  }"<br />          "  :button{key=\"1\";label=\"拾取\";width=6;}"<br />          "  }"<br />           "  spacer;"<br />          "  :row {"<br />                    "  :edit_box"<br />                    "  {"<br />                    "    label=\"替换\";"<br />                    "    key=\"newword\";"<br />           "    width = 45 ;"<br />           "    height = 1.2 ;"<br />                    "    allow_accept=true;"<br />                    "  }"<br />          "  :button{key=\"2\";label=\"拾取\";width=6;}"  <br />          "  }"<br />           "  spacer;"<br />          "  :row {"<br />          "  :button{key=\"3\";label=\"选择范围替换\";width=6;}"<br />                    "  cancel_button;"<br />                    "}"<br />          "}" <br />                   ) ; endlist<br />         (princ x fn)<br />         (write-line "" fn)<br />       ) ; end foreach <br /> <br />   (close fn)<br />   (setq fn (open fname "r"))<br />   (setq dclid (load_dialog fname))<br />   (while (or (eq (substr (setq lin (vl-string-right-trim "\" fn)" (vl-string-left-trim "(write-line \"" (read-line fn)))) 1 2) "//") (eq (substr lin 1 (vl-string-search " " lin)) "") (not (eq (substr lin (+ (vl-string-search " " lin) 1) 9) " : dialog"))))<br />   (new_dialog (substr lin 1 (vl-string-search " " lin)) dclid)<br />     (if oldch<br />       (set_tile "oldword" oldch)<br />       (set_tile "oldword" "")<br />     )<br />     (if newch<br />       (set_tile "newword" newch)<br />       (set_tile "newword" "")<br />     )<br />           (mode_tile "oldword" 2)<br />           (action_tile "oldword" "(setq oldch $value)")<br />           (action_tile "newword" "(setq newch $value)")<br />           (action_tile "1" "(done_dialog 1)")<br />           (action_tile "2" "(done_dialog 2)")<br />           (action_tile "3" "(done_dialog 3)")<br />           (action_tile "cancel" "(done_dialog 0)")<br />      <br />   (setq re (start_dialog))<br />      (cond<br />       ((= re 1) (shiqu1))<br />       ((= re 2) (shiqu2))<br />       ((= re 3) (tihuan))<br />   )<br />   <br />   (start_dialog)<br />   (unload_dialog dclid)<br />   (close fn)<br />   (vl-file-delete fname)<br /> );end xsdhk<br /> <br /> (defun tihuan ()<br />   (if (and (/= oldch "")(/= oldch newch)<br /> (setq sstxt (ssget '((-4 . "<OR")(0 . "*TEXT")(0 . "TCH_DRAWINGNAME")(-4 . "OR>")))))<br />     (progn<br />       (setq ssl (sslength sstxt)<br />             ct0 0<br />             ct 0<br />             subln (strlen oldch)<br />       oldtxtln (strlen oldch)<br />       )<br />       (while (< ct0 ssl)<br />     (setq en1 (ssname sstxt ct0));图元名<br />         (setq edata (entget en1);组码<br />               etext (cdr (assoc 1 edata));文字内容<br />          entype (cdr (assoc 0 edata));文字类型<br />               txtln (strlen etext)<br />               schct 1<br />               newtext ""<br />         )<br />         (while (<= schct txtln)<br />               (if (= (setq readch (substr etext schct subln)) oldch)<br />        (setq schct (+ schct subln)<br />                       a newch)<br />                 (progn<br />         (if (> (ascii (substr readch 1 1)) 127);如果是汉字<br />          (progn<br />                     (setq readch (substr etext schct (1+ subln)));多读取一个字节<br />           (setq schct (+ schct 2));加2字节<br />           (setq a (substr readch 1 2));就取第1.2个字节为a<br />          )<br />          (progn<br />           (setq schct (1+ schct))<br />           (setq a (substr readch 1 1))<br />          )<br />         )<br />                 )<br />               )<br />     (setq newtext (strcat newtext a))<br />         )<br />         (if (/= etext newtext)<br />           (progn     <br />       (setq ob (vlax-ename->vla-object en1)) ;转换<br />       (if (= entype "TEXT") (vlax-put-property ob 'TextString newtext)) ;改变特性<br />       (if (= entype "TCH_MTEXT") (entmod (subst (cons 1 newtext) (assoc 1 edata) edata))) ;改变特性<br />       (if (= entype "MTEXT") (vlax-put-property ob 'TextString newtext)) ;改变特性<br />       (if (= entype "TCH_TEXT") (vlax-put-property ob 'Text newtext)) ;改变特性<br />       (if (= entype "TCH_DRAWINGNAME") (vlax-put-property ob 'NameText newtext)) ;改变特性<br />             (setq ct (1+ ct))<br />           )<br />         )<br />    (setq ct0 (1+ ct0)) <br />       )<br />       (alert (strcat "  共替换了" (itoa ct) "个"))<br />    (princ (strcat ">>>>>>>>>共替换了" (itoa ct) "个"))<br />     )<br />   )<br /> );end tihuan<br /> (defun shiqu1 (/ ent1 ent2 entdata enttext)<br />   (if (setq ent1 (entsel ))<br />   (progn<br />     (setq ent2 (car ent1);图元名<br />             entdata (entget ent2);组码<br />             enttext (cdr (assoc 1 entdata));文字内容<br />         )<br />    (setq oldch enttext)<br />    (setq newch enttext)<br />    (xsdhk)<br /> ))<br /> );end shiqu1<br /> (defun shiqu2 (/ ent1 ent2 entdata enttext)<br />   (if (setq ent1 (entsel ))<br />   (progn<br />     (setq ent2 (car ent1);图元名<br />             entdata (entget ent2);组码<br />             enttext (cdr (assoc 1 entdata));文字内容<br />         )<br />    (setq newch enttext)<br />    (xsdhk)<br /> ))<br /> );end shiqu2<br /> <br /> (xsdhk)<br /> (command "_.undo" "_end")<br /> (setvar "cmdecho" 1)<br /> (princ)<br /> )<br />

该贴已经同步到 CTC的微博

CTC

print1985 发表于 2012-4-20 17:36
试试 小改了下 其它代码没动
其实这个查查替换是有问题的（针对某些单个汉字可能会出问题）

高手出招了....
不知什么问题,还请高手指点....
高手,请帮我看下可不可以加入CAD系统里面的查找替换里的
""全部选择"" 按钮,查找的文字会亮显,命令行里会提示""已找到并选择 3 个包含“L1”的对象""
因为我要知道选择了哪些,替换了哪些
这个按键功能用法同原来系统的用法一样就好了...(看下面的图片及动画)

迷失1786

试试源泉插件的TFF功能，我用过最好的查找替换功能，查字显亮，带线，带拾取字，

weijiewen

查找替换文字，非常实用

微~妙

支持  顶一下 希望高手出手相助

print1985

http://bbs.mjtd.com/forum.php?mo ... mp;page=1#pid501237
这里有个更好的

print1985

拾取功能很简单 自己把2个lsp组装下就行了

CTC

print1985

试试 小改了下 其它代码没动
其实这个查查替换是有问题的（针对某些单个汉字可能会出问题）

print1985

楼主的代码对有换行的多行文字也有问题 2个查找替换都有问题啊

qq229918602

貌似有点高深。。

smartstar

做个记号，以后学习。