[LISP程序]：用程序修改鼠标指定的字符,支持多选

nuance

原本此帖发在
http://www.xdcad.net/forum/showt ... 1639959#post1639959
此次增加多选，另发了新贴，斑竹如果以为不妥，还移至原处。
1、支持UCS。
2、可修改TEXT和ATTRIB。
3、支持%%*。可能是%%?,%%??,%%???
4、支持上下标，但要固定，本例中％％151上标开始，％％152上标结束，
％％153下标开始，％％154下标结束，不同的字体修改相应源程序即可。
5、支持汉字及双字节字符。
6、不支持加圈字符。
7、不支持TEXTSTYLE中的upside down,backwards,vertical,oblique angles。
8、使用了vl-remove函数，R14不能用。
9、在eachy的帮助下，如果程序被强行中断，去处新生成的实体。
10、支持框选，框选的边界要压到两侧字符上
11、以亮显方式显示修改字符。对不同SHX的不同被选字符有时会错位，
    这是定义SHP时造成的，例如“1”，定义SHP时，
    是在左侧加一些空白区还是在右侧加一些空白区，或者不加，这将会造成错位，
    我的算法是从左向右算所选字符结束点，也试了XD的$xdlsp_text_position的算法，
    是总宽减去所选字符后面宽度，都存在问题。我觉得这个问题也可以解决，像
    它山之石朋友的做法，每次都使用entmod更新，定位会准，但耗时，如果TEXT很长
    可以看到从头到位的变颜色。
12、多选时支持空格。

2005.2.5
  11的定位不准的问题已解决，代码及附件已更新。

2. 
   
3. (defun c:aaa (/ obj obj-name pt-select dxfdata text-value-old dxfdata-2 obj-2 dxfdata-3
   
4.               list-whichchar-charlen-supersubscript which-char-main char-len-main
   
5.               super-sub-script-main newstr text-value-new
   
6.               layer iflock dxflayer dxflayer2 get-whichchar-charlen-supersubscript k
   
7.               pt-select-1 pt-select-2 pt-temp dxfdata-4
   
8.               which-char-main-1 char-len-main-1  super-sub-script-main-1 which-char-main-2
   
9.               *error* msg list-error olderror
   
10.               text-angle-main pt-left-1 pt-left-2 pt-right-textbox text-modify)
    
11. (defun *error*  (msg / n)
    
12. (setq n 0)
    
13. (if (= msg  "Function cancelled")
    
14.    (if (/=  list-error nil)
    
15.       (repeat (length list-error)
    
16.          (entdel (nth n list-error))
    
17.          (setq n (1+ n))
    
18.       )
    
19.    )
    
20. )
    
21. (setq *error* olderror)
    
22. )            
    
23. 
    
24. (defun get-whichchar-charlen-supersubscript (pt-select-sub dxfdata-sub
    
25.    / pt-left text-angle text-value loop which-char char-len box-1 box-2 str-wid
    
26.      pt-dummy-1 pt-dummy-2 pt-dummy dist box super-sub-script)
    
27. (setq pt-left (cdr (assoc 10 dxfdata-sub)))
    
28. (setq text-angle (cdr (assoc 50 dxfdata-sub)))
    
29. (setq text-value (cdr (assoc 1 dxfdata-sub)))
    
30. (setq which-char 0)
    
31. (setq loop t)
    
32. (setq super-sub-script "")
    
33. 
    
34. (setq pt-dummy-1 (polar pt-left text-angle 100.0))
    
35. (setq pt-dummy-2 (polar pt-select-sub (+ (/ pi 2.0) text-angle) 100.0))
    
36. (setq pt-dummy (inters pt-left pt-dummy-1 pt-select-sub pt-dummy-2 nil))
    
37. (setq dist (distance pt-left pt-dummy))
    
38. 
    
39. (while loop
    
40.    (setq char-len 1)
    
41. 
    
42.    (if (wcmatch (substr text-value (+ 1 which-char) 5) "%%*");if1
    
43.    (if (wcmatch (substr text-value (+ 1 which-char) 5) "%%[0-9][0-9][0-9]")
    
44.       (setq char-len 5)
    
45.       (if (wcmatch (substr text-value (+ 1 which-char) 5) "%%[0-9][0-9][~0-9]")
    
46.          (setq char-len 4)
    
47.          (if (and (wcmatch (substr text-value (+ 1 which-char) 5) "%%[0-9][0-9]")
    
48.                   (= 4 (strlen (substr text-value (+ 1 which-char) 5))))
    
49.             (setq char-len 4)
    
50.             (setq char-len 3)
    
51.          )
    
52.       )
    
53.    )
    
54.    );if1
    
55. 
    
56.    ;%%151--start of superscript
    
57.    ;%%152--end of superscript
    
58.    ;%%153--start of subscript
    
59.    ;%%154--end of subscript
    
60.    ;%%155--start of subscript
    
61.    ;%%156--end of subscript
    
62.    (if (wcmatch (substr text-value (+ 1 which-char) 5) "%%151,%%152,%%153,%%154,%%155,%%156")
    
63.        (setq super-sub-script (strcat super-sub-script (substr text-value (+ 1 which-char) 5))))
    
64. 
    
65.    (if (> (ascii (substr text-value (+ 1 which-char) 1)) 159);if2
    
66.       (setq char-len 2)
    
67.    );if2
    
68. 
    
69.    (setq which-char (+ which-char char-len))
    
70.    
    
71.    (setq box-1 (textbox (subst (cons 1 (strcat "A" (substr text-value 1 which-char) "A"))
    
72.                                (assoc 1 dxfdata-sub) dxfdata-sub)))
    
73.    (setq box-2 (textbox (subst (cons 1 (strcat "A" super-sub-script "A")) (assoc 1 dxfdata-sub) dxfdata-sub)))
    
74.    (setq str-wid (abs (- (- (car (car box-1)) (car (cadr box-1)))(- (car (car box-2)) (car (cadr box-2))))))
    
75.       
    
76.    (if (> str-wid dist)(setq loop nil))
    
77.    
    
78. );while
    
79.    
    
80. (list which-char char-len super-sub-script)
    
81. );defun-sub
    
82. 
    
83. 
    
84. (setq olderror *error*)
    
85. (setq list-error '())
    
86. (command "undo" "be")
    
87. (setq k t)
    
88. (if (setq obj (nentsel "\npick a char to modify / <exit>:")) ;if0
    
89.    (progn;0
    
90.       (setq obj-name (car obj) pt-select (cadr obj))
    
91.       (setq pt-select (trans pt-select 1 0))
    
92.       (setq dxfdata (entget obj-name))
    
93.       (setq text-value-old (cdr (assoc 1 dxfdata)))
    
94.       (if (wcmatch (cdr (assoc 0 dxfdata)) "TEXT,ATTRIB");if1
    
95.          (progn;1
    
96.             (setq dxfdata-2 dxfdata)
    
97.             (if (= "TEXT" (cdr (assoc 0 dxfdata-2)))
    
98.                (progn
    
99.                   (if (= 4 (cdr (assoc 70 (tblsearch "layer" (cdr (assoc 8 dxfdata))))))
    
100.                      (progn  (alert "object is on a locked layer !")(exit)))
     
101.                   
     
102.                   (entmake dxfdata-2)
     
103.                );progn
     
104.             );if
     
105.             (if (= "ATTRIB" (cdr (assoc 0 dxfdata-2)))
     
106.                (progn
     
107.                   (if (= 4 (cdr (assoc 70 (tblsearch "layer" (cdr (assoc 8 (entget (cdr (assoc 330 dxfdata)))))))))
     
108.                      (progn  (alert "object is on a locked layer !")(exit)))
     
109.                   
     
110.                   (setq dxfdata-2 (subst (cons 0 "TEXT") (assoc 0 dxfdata-2) dxfdata-2))
     
111.                   (setq dxfdata-2 (vl-remove (assoc 2  dxfdata-2) dxfdata-2))
     
112.                   (setq dxfdata-2 (vl-remove (assoc 70 dxfdata-2) dxfdata-2))
     
113.                   (setq dxfdata-2 (vl-remove (assoc 74 dxfdata-2) dxfdata-2))
     
114.                   (entmake dxfdata-2)
     
115.                )
     
116.             );if
     
117.             (setq text-angle-main (cdr (assoc 50 dxfdata-2)))
     
118.             (setq pt-left-1 (cdr (assoc 10 dxfdata-2)))
     
119.             (setq obj-2 (entlast))
     
120.             (setq list-error (cons obj-2 list-error))
     
121.             (setq dxfdata-3 (entget obj-2))
     
122.             (setq dxfdata-4 dxfdata-3)
     
123.             (setq dxfdata-3 (subst (cons 72 0) (assoc 72 dxfdata-3) dxfdata-3))
     
124.             (setq dxfdata-3 (subst (cons 73 0) (assoc 73 dxfdata-3) dxfdata-3))
     
125.             (setq dxfdata-4 (subst (cons 72 0) (assoc 72 dxfdata-4) dxfdata-4))
     
126.             (setq dxfdata-4 (subst (cons 73 0) (assoc 73 dxfdata-4) dxfdata-4))
     
127.             
     
128.             (setq list-whichchar-charlen-supersubscript
     
129.                  (get-whichchar-charlen-supersubscript pt-select dxfdata-3))
     
130.             (setq which-char-main       (car    list-whichchar-charlen-supersubscript))
     
131.             (setq char-len-main         (cadr   list-whichchar-charlen-supersubscript))
     
132.             (setq super-sub-script-main (caddr  list-whichchar-charlen-supersubscript))
     
133.                         
     
134.             (setq pt-right-textbox (polar pt-left-1 text-angle-main (caadr (textbox
     
135.                        (subst (cons 1 (substr text-value-old 1  which-char-main))
     
136.                                        (assoc 1 dxfdata-3) dxfdata-3)))))
     
137.             (setq text-modify (substr text-value-old (+ 1 (- which-char-main char-len-main)) char-len-main))
     
138.             (setq pt-left-2 (polar pt-right-textbox (+ pi text-angle-main) (caadr (textbox
     
139.                 (subst (cons 1 (strcat super-sub-script-main text-modify))(assoc 1 dxfdata-3) dxfdata-3)))))
     
140.             (setq dxfdata-3 (subst (cons 1 (strcat super-sub-script-main text-modify))(assoc 1 dxfdata-3) dxfdata-3))
     
141.             (setq dxfdata-3 (subst (cons 10 pt-left-2) (assoc 10 dxfdata-3) dxfdata-3))
     
142.             (entmod dxfdata-3)
     
143.             (redraw (cdr (assoc -1 dxfdata-3)) 3)            
     
144.             
     
145.             (setq newstr (getstring (strcat "\nenter to multiple or remove / [" text-modify "]:")))
     
146.    
     
147.             (if (/= "" newstr)
     
148.                (setq text-value-new (strcat (substr text-value-old 1 (- which-char-main char-len-main))
     
149.                                                      newstr
     
150.                                             (substr text-value-old (+ 1 which-char-main))
     
151.                                             ));setq text-value
     
152.             );if
     
153. 
     
154.             (if (= "" newstr);if2
     
155.                (progn
     
156.                   (redraw (cdr (assoc -1 dxfdata-3)) 4)
     
157.                   (initget "Remove")
     
158.                   (setq k (getpoint "\nRemove / <multiple first corner>:"))
     
159. 
     
160.                   (if (= k "Remove")
     
161.                      (setq text-value-new (strcat (substr text-value-old 1 (- which-char-main char-len-main))
     
162.                                                    (substr text-value-old (+ 1 which-char-main))
     
163.                                          ));setq text-value
     
164.                   );if
     
165.                   
     
166.                   (if (= 'list (type k));if5
     
167.                      (progn;5
     
168.                         (setq pt-select-1 k)
     
169.                         (initget 32)
     
170.                         (setq k (getcorner pt-select-1 "\nmultiple second corner:"))
     
171.                
     
172.                         (if (= 'list (type k));if8
     
173.                            (progn;8
     
174.                               (setq pt-select-2 k)
     
175.                               (setq pt-select-1 (trans pt-select-1 1 0))
     
176.                               (setq pt-select-2 (trans pt-select-2 1 0))
     
177.                               (if (> (car pt-select-1)(car pt-select-2))
     
178.                                  (progn
     
179.                                     (setq pt-temp pt-select-1)
     
180.                                     (setq pt-select-1 pt-select-2)
     
181.                                     (setq pt-select-2 pt-temp)
     
182.                                  )
     
183.                               )
     
184. 
     
185.                               (setq list-whichchar-charlen-supersubscript
     
186.                                    (get-whichchar-charlen-supersubscript pt-select-1 dxfdata-4))
     
187.                               (setq which-char-main-1       (car    list-whichchar-charlen-supersubscript))
     
188.                               (setq char-len-main-1         (cadr   list-whichchar-charlen-supersubscript))
     
189.                               (setq super-sub-script-main-1 (caddr  list-whichchar-charlen-supersubscript))
     
190.                               (setq list-whichchar-charlen-supersubscript
     
191.                                    (get-whichchar-charlen-supersubscript pt-select-2 dxfdata-4))
     
192.                               (setq which-char-main-2       (car    list-whichchar-charlen-supersubscript))
     
193.                                                          
     
194.                               (setq pt-right-textbox (polar pt-left-1 text-angle-main (caadr (textbox
     
195.                                           (subst (cons 1 (substr text-value-old 1  which-char-main-2))
     
196.                                        (assoc 1 dxfdata-4) dxfdata-4)))))
     
197.                               (setq text-modify (substr text-value-old (+ 1 (- which-char-main-1 char-len-main-1))
     
198.                                                (abs (- which-char-main-2 (- which-char-main-1 char-len-main-1)))
     
199.                                            ))
     
200.                               (setq pt-left-2 (polar pt-right-textbox (+ pi text-angle-main) (caadr (textbox
     
201.                                  (subst (cons 1 (strcat super-sub-script-main-1 text-modify))
     
202.                                         (assoc 1 dxfdata-4) dxfdata-4)))))
     
203.                               (setq dxfdata-3 (subst (cons 1 (strcat super-sub-script-main-1 text-modify))
     
204.                                               (assoc 1 dxfdata-4) dxfdata-4))
     
205.                               (setq dxfdata-3 (subst (cons 10 pt-left-2) (assoc 10 dxfdata-3) dxfdata-3))
     
206.                               (entmod dxfdata-3)
     
207.                               (redraw (cdr (assoc -1 dxfdata-3)) 3)            
     
208.                        
     
209.                               (setq newstr (getstring (strcat "\nenter to modify to remove / [" text-modify "]:")))
     
210.                              
     
211.                               (if (/= "" newstr)
     
212.                                  (setq text-value-new (strcat (substr text-value-old 1 (- which-char-main-1 char-len-main-1))
     
213.                                                          newstr
     
214.                                                (substr text-value-old (+ 1 which-char-main-2))
     
215.                                                ));setq text-value
     
216.                                  )
     
217.                               (if (= "" newstr)
     
218.                                  (progn
     
219.                                     (initget "Remove")
     
220.                                     (setq k (getkword "\nRemove?"));k/=k
     
221.                                     (if (= k "Remove")
     
222.                                     (setq text-value-new (strcat (substr text-value-old 1 (- which-char-main-1 char-len-main-1))
     
223.                                                                         (substr text-value-old (+ 1 which-char-main-2))
     
224.                                                            ));setq text-value
     
225.                                     )
     
226.                                  )
     
227.                               );if
     
228.                            );progn8
     
229.                         );if8
     
230.                      );progn5
     
231.                   );if5
     
232.                );progn
     
233.             );if2
     
234.             ;-------------------------------------------------
     
235.                (if (/= k nil);if9
     
236.                (progn;9
     
237.                   (setq dxfdata (subst (cons 1 text-value-new) (assoc 1 dxfdata) dxfdata))
     
238.                   (if (= "TEXT" (cdr (assoc 0 dxfdata)))
     
239.                      (entmake dxfdata)
     
240.                   );if
     
241.                   (if (= "ATTRIB" (cdr (assoc 0 dxfdata)))
     
242.                      (progn
     
243.                         (setq layer (cdr (assoc 8 dxfdata)))
     
244.                         (setq iflock 0)
     
245.                         (if (= 4 (cdr (assoc 70 (tblsearch "layer" layer))))
     
246.                            (progn
     
247.                               (setq iflock 1)
     
248.                               (setq dxflayer (entget (tblobjname "layer" layer)))
     
249.                               (setq dxflayer2 dxflayer)
     
250.                               (setq dxflayer (subst (cons 70 0) (assoc 70 dxflayer) dxflayer))
     
251.                               (entmod dxflayer)
     
252.                            )
     
253.                         )
     
254.                   
     
255.                         (entmod dxfdata)
     
256.                         (entupd (cdr (assoc 330 dxfdata)))
     
257.                                     
     
258.                      );progn
     
259.                   );if
     
260.                   (entdel (cdr (assoc -1 dxfdata-2)))
     
261.                );progn9
     
262.             );if9
     
263.             (entdel (cdr (assoc -1 dxfdata-3)))
     
264.             (if (= 1 iflock)(entmod dxflayer2))         
     
265.          );progn1
     
266.          (alert "\nselected object is not a TEXT or a ATTRIB !")
     
267.       );if1
     
268.    );progn0
     
269.    (princ "\nno object is selected !")
     
270. );if0
     
271. (command "undo" "end")
     
272. (setq *error* olderror)
     
273. (princ)
     
274. );defun
     

<br /> (defun c:aaa (/ obj obj-name pt-select dxfdata text-value-old dxfdata-2 obj-2 dxfdata-3<br />               list-whichchar-charlen-supersubscript which-char-main char-len-main<br />               super-sub-script-main newstr text-value-new<br />               layer iflock dxflayer dxflayer2 get-whichchar-charlen-supersubscript k<br />               pt-select-1 pt-select-2 pt-temp dxfdata-4<br />               which-char-main-1 char-len-main-1  super-sub-script-main-1 which-char-main-2<br />               *error* msg list-error olderror<br />               text-angle-main pt-left-1 pt-left-2 pt-right-textbox text-modify)<br /> (defun *error*  (msg / n)<br /> (setq n 0)<br /> (if (= msg  "Function cancelled")<br />    (if (/=  list-error nil)<br />       (repeat (length list-error)<br />          (entdel (nth n list-error))<br />          (setq n (1+ n))<br />       )<br />    )<br /> )<br /> (setq *error* olderror)<br /> )            <br /> <br /> (defun get-whichchar-charlen-supersubscript (pt-select-sub dxfdata-sub<br />    / pt-left text-angle text-value loop which-char char-len box-1 box-2 str-wid <br />      pt-dummy-1 pt-dummy-2 pt-dummy dist box super-sub-script)<br /> (setq pt-left (cdr (assoc 10 dxfdata-sub)))<br /> (setq text-angle (cdr (assoc 50 dxfdata-sub)))<br /> (setq text-value (cdr (assoc 1 dxfdata-sub)))<br /> (setq which-char 0)<br /> (setq loop t)<br /> (setq super-sub-script "")<br /> <br /> (setq pt-dummy-1 (polar pt-left text-angle 100.0))<br /> (setq pt-dummy-2 (polar pt-select-sub (+ (/ pi 2.0) text-angle) 100.0))<br /> (setq pt-dummy (inters pt-left pt-dummy-1 pt-select-sub pt-dummy-2 nil))<br /> (setq dist (distance pt-left pt-dummy))<br /> <br /> (while loop<br />    (setq char-len 1)<br /> <br />    (if (wcmatch (substr text-value (+ 1 which-char) 5) "%%*");if1<br />    (if (wcmatch (substr text-value (+ 1 which-char) 5) "%%[0-9][0-9][0-9]")<br />       (setq char-len 5)<br />       (if (wcmatch (substr text-value (+ 1 which-char) 5) "%%[0-9][0-9][~0-9]")<br />          (setq char-len 4)<br />          (if (and (wcmatch (substr text-value (+ 1 which-char) 5) "%%[0-9][0-9]")<br />                   (= 4 (strlen (substr text-value (+ 1 which-char) 5))))<br />             (setq char-len 4)<br />             (setq char-len 3)<br />          )<br />       )<br />    )<br />    );if1<br /> <br />    ;%%151--start of superscript<br />    ;%%152--end of superscript<br />    ;%%153--start of subscript<br />    ;%%154--end of subscript<br />    ;%%155--start of subscript<br />    ;%%156--end of subscript<br />    (if (wcmatch (substr text-value (+ 1 which-char) 5) "%%151,%%152,%%153,%%154,%%155,%%156")<br />        (setq super-sub-script (strcat super-sub-script (substr text-value (+ 1 which-char) 5))))<br /> <br />    (if (> (ascii (substr text-value (+ 1 which-char) 1)) 159);if2<br />       (setq char-len 2)<br />    );if2<br /> <br />    (setq which-char (+ which-char char-len))<br />    <br />    (setq box-1 (textbox (subst (cons 1 (strcat "A" (substr text-value 1 which-char) "A"))<br />                                (assoc 1 dxfdata-sub) dxfdata-sub)))<br />    (setq box-2 (textbox (subst (cons 1 (strcat "A" super-sub-script "A")) (assoc 1 dxfdata-sub) dxfdata-sub)))<br />    (setq str-wid (abs (- (- (car (car box-1)) (car (cadr box-1)))(- (car (car box-2)) (car (cadr box-2))))))<br />       <br />    (if (> str-wid dist)(setq loop nil))<br />    <br /> );while<br />    <br /> (list which-char char-len super-sub-script)<br /> );defun-sub<br /> <br /> <br /> (setq olderror *error*)<br /> (setq list-error '())<br /> (command "undo" "be")<br /> (setq k t)<br /> (if (setq obj (nentsel "\npick a char to modify / <exit>:")) ;if0<br />    (progn;0<br />       (setq obj-name (car obj) pt-select (cadr obj))<br />       (setq pt-select (trans pt-select 1 0))<br />       (setq dxfdata (entget obj-name))<br />       (setq text-value-old (cdr (assoc 1 dxfdata)))<br />       (if (wcmatch (cdr (assoc 0 dxfdata)) "TEXT,ATTRIB");if1<br />          (progn;1<br />             (setq dxfdata-2 dxfdata)<br />             (if (= "TEXT" (cdr (assoc 0 dxfdata-2)))<br />                (progn<br />                   (if (= 4 (cdr (assoc 70 (tblsearch "layer" (cdr (assoc 8 dxfdata))))))<br />                      (progn  (alert "object is on a locked layer !")(exit)))<br />                   <br />                   (entmake dxfdata-2)<br />                );progn<br />             );if<br />             (if (= "ATTRIB" (cdr (assoc 0 dxfdata-2)))<br />                (progn<br />                   (if (= 4 (cdr (assoc 70 (tblsearch "layer" (cdr (assoc 8 (entget (cdr (assoc 330 dxfdata)))))))))<br />                      (progn  (alert "object is on a locked layer !")(exit)))<br />                   <br />                   (setq dxfdata-2 (subst (cons 0 "TEXT") (assoc 0 dxfdata-2) dxfdata-2))<br />                   (setq dxfdata-2 (vl-remove (assoc 2  dxfdata-2) dxfdata-2))<br />                   (setq dxfdata-2 (vl-remove (assoc 70 dxfdata-2) dxfdata-2))<br />                   (setq dxfdata-2 (vl-remove (assoc 74 dxfdata-2) dxfdata-2))<br />                   (entmake dxfdata-2)<br />                )<br />             );if<br />             (setq text-angle-main (cdr (assoc 50 dxfdata-2)))<br />             (setq pt-left-1 (cdr (assoc 10 dxfdata-2)))<br />             (setq obj-2 (entlast))<br />             (setq list-error (cons obj-2 list-error))<br />             (setq dxfdata-3 (entget obj-2))<br />             (setq dxfdata-4 dxfdata-3)<br />             (setq dxfdata-3 (subst (cons 72 0) (assoc 72 dxfdata-3) dxfdata-3))<br />             (setq dxfdata-3 (subst (cons 73 0) (assoc 73 dxfdata-3) dxfdata-3))<br />             (setq dxfdata-4 (subst (cons 72 0) (assoc 72 dxfdata-4) dxfdata-4))<br />             (setq dxfdata-4 (subst (cons 73 0) (assoc 73 dxfdata-4) dxfdata-4))<br />             <br />             (setq list-whichchar-charlen-supersubscript<br />                  (get-whichchar-charlen-supersubscript pt-select dxfdata-3))<br />             (setq which-char-main       (car    list-whichchar-charlen-supersubscript))<br />             (setq char-len-main         (cadr   list-whichchar-charlen-supersubscript))<br />             (setq super-sub-script-main (caddr  list-whichchar-charlen-supersubscript))<br />                         <br />             (setq pt-right-textbox (polar pt-left-1 text-angle-main (caadr (textbox<br />                        (subst (cons 1 (substr text-value-old 1  which-char-main))<br />                                        (assoc 1 dxfdata-3) dxfdata-3)))))<br />             (setq text-modify (substr text-value-old (+ 1 (- which-char-main char-len-main)) char-len-main))<br />             (setq pt-left-2 (polar pt-right-textbox (+ pi text-angle-main) (caadr (textbox<br />                 (subst (cons 1 (strcat super-sub-script-main text-modify))(assoc 1 dxfdata-3) dxfdata-3)))))<br />             (setq dxfdata-3 (subst (cons 1 (strcat super-sub-script-main text-modify))(assoc 1 dxfdata-3) dxfdata-3))<br />             (setq dxfdata-3 (subst (cons 10 pt-left-2) (assoc 10 dxfdata-3) dxfdata-3))<br />             (entmod dxfdata-3)<br />             (redraw (cdr (assoc -1 dxfdata-3)) 3)            <br />             <br />             (setq newstr (getstring (strcat "\nenter to multiple or remove / [" text-modify "]:")))<br />     <br />             (if (/= "" newstr)<br />                (setq text-value-new (strcat (substr text-value-old 1 (- which-char-main char-len-main))<br />                                                      newstr<br />                                             (substr text-value-old (+ 1 which-char-main))<br />                                             ));setq text-value<br />             );if<br /> <br />             (if (= "" newstr);if2<br />                (progn<br />                   (redraw (cdr (assoc -1 dxfdata-3)) 4)<br />                   (initget "Remove")<br />                   (setq k (getpoint "\nRemove / <multiple first corner>:"))<br /> <br />                   (if (= k "Remove")<br />                      (setq text-value-new (strcat (substr text-value-old 1 (- which-char-main char-len-main))<br />                                                    (substr text-value-old (+ 1 which-char-main))<br />                                          ));setq text-value<br />                   );if<br />                   <br />                   (if (= 'list (type k));if5<br />                      (progn;5<br />                         (setq pt-select-1 k)<br />                         (initget 32)<br />                         (setq k (getcorner pt-select-1 "\nmultiple second corner:"))<br />                 <br />                         (if (= 'list (type k));if8<br />                            (progn;8<br />                               (setq pt-select-2 k)<br />                               (setq pt-select-1 (trans pt-select-1 1 0))<br />                               (setq pt-select-2 (trans pt-select-2 1 0))<br />                               (if (> (car pt-select-1)(car pt-select-2))<br />                                  (progn<br />                                     (setq pt-temp pt-select-1)<br />                                     (setq pt-select-1 pt-select-2)<br />                                     (setq pt-select-2 pt-temp)<br />                                  )<br />                               )<br /> <br />                               (setq list-whichchar-charlen-supersubscript<br />                                    (get-whichchar-charlen-supersubscript pt-select-1 dxfdata-4))<br />                               (setq which-char-main-1       (car    list-whichchar-charlen-supersubscript))<br />                               (setq char-len-main-1         (cadr   list-whichchar-charlen-supersubscript))<br />                               (setq super-sub-script-main-1 (caddr  list-whichchar-charlen-supersubscript))<br />                               (setq list-whichchar-charlen-supersubscript<br />                                    (get-whichchar-charlen-supersubscript pt-select-2 dxfdata-4))<br />                               (setq which-char-main-2       (car    list-whichchar-charlen-supersubscript))<br />                                                          <br />                               (setq pt-right-textbox (polar pt-left-1 text-angle-main (caadr (textbox<br />                                           (subst (cons 1 (substr text-value-old 1  which-char-main-2))<br />                                        (assoc 1 dxfdata-4) dxfdata-4)))))<br />                               (setq text-modify (substr text-value-old (+ 1 (- which-char-main-1 char-len-main-1))<br />                                                (abs (- which-char-main-2 (- which-char-main-1 char-len-main-1)))<br />                                            ))<br />                               (setq pt-left-2 (polar pt-right-textbox (+ pi text-angle-main) (caadr (textbox<br />                                  (subst (cons 1 (strcat super-sub-script-main-1 text-modify))<br />                                         (assoc 1 dxfdata-4) dxfdata-4)))))<br />                               (setq dxfdata-3 (subst (cons 1 (strcat super-sub-script-main-1 text-modify))<br />                                               (assoc 1 dxfdata-4) dxfdata-4))<br />                               (setq dxfdata-3 (subst (cons 10 pt-left-2) (assoc 10 dxfdata-3) dxfdata-3))<br />                               (entmod dxfdata-3)<br />                               (redraw (cdr (assoc -1 dxfdata-3)) 3)            <br />                         <br />                               (setq newstr (getstring (strcat "\nenter to modify to remove / [" text-modify "]:")))<br />                               <br />                               (if (/= "" newstr)<br />                                  (setq text-value-new (strcat (substr text-value-old 1 (- which-char-main-1 char-len-main-1))<br />                                                          newstr<br />                                                (substr text-value-old (+ 1 which-char-main-2))<br />                                                ));setq text-value<br />                                  )<br />                               (if (= "" newstr)<br />                                  (progn<br />                                     (initget "Remove")<br />                                     (setq k (getkword "\nRemove?"));k/=k<br />                                     (if (= k "Remove")<br />                                     (setq text-value-new (strcat (substr text-value-old 1 (- which-char-main-1 char-len-main-1))<br />                                                                         (substr text-value-old (+ 1 which-char-main-2))<br />                                                            ));setq text-value<br />                                     )<br />                                  )<br />                               );if<br />                            );progn8<br />                         );if8<br />                      );progn5<br />                   );if5<br />                );progn<br />             );if2<br />             ;-------------------------------------------------<br />                (if (/= k nil);if9<br />                (progn;9<br />                   (setq dxfdata (subst (cons 1 text-value-new) (assoc 1 dxfdata) dxfdata))<br />                   (if (= "TEXT" (cdr (assoc 0 dxfdata)))<br />                      (entmake dxfdata)<br />                   );if<br />                   (if (= "ATTRIB" (cdr (assoc 0 dxfdata)))<br />                      (progn<br />                         (setq layer (cdr (assoc 8 dxfdata)))<br />                         (setq iflock 0)<br />                         (if (= 4 (cdr (assoc 70 (tblsearch "layer" layer))))<br />                            (progn<br />                               (setq iflock 1)<br />                               (setq dxflayer (entget (tblobjname "layer" layer)))<br />                               (setq dxflayer2 dxflayer)<br />                               (setq dxflayer (subst (cons 70 0) (assoc 70 dxflayer) dxflayer))<br />                               (entmod dxflayer)<br />                            )<br />                         )<br />                   <br />                         (entmod dxfdata)<br />                         (entupd (cdr (assoc 330 dxfdata)))<br />                                     <br />                      );progn<br />                   );if<br />                   (entdel (cdr (assoc -1 dxfdata-2)))<br />                );progn9<br />             );if9<br />             (entdel (cdr (assoc -1 dxfdata-3)))<br />             (if (= 1 iflock)(entmod dxflayer2))         <br />          );progn1<br />          (alert "\nselected object is not a TEXT or a ATTRIB !") <br />       );if1<br />    );progn0<br />    (princ "\nno object is selected !")<br /> );if0<br /> (command "undo" "end")<br /> (setq *error* olderror)<br /> (princ)<br /> );defun<br />

它山之石

俺们的那个程序已经好久没有更新了。试试你的这个先。共同做出更好的程序。

xjlmlxbq

要是支持标注字符就更好了

nuance

个人很反对改标注中的字符，稍有错位时我宁可改标注的定义点，这样打印是看不出，又可以使用stretch命令。如果楼上很需要，倒是可以加上。

sdwy19691229

用了一下，感觉满不错的。
可我在ACAD里边用字符很少，一般用FIND 指令。

smile313

我试用了，提几个建议：1.象它山之石的程序改钢筋符号时直接输入1,2,3等改钢筋等级。2.
程序被强行中断，新生成的实体还在。3.多选和删除效率不高，可改成未选中字即默认为多选窗和选中字符后回车直接删除。