请高手帮满修改一下，文字交换程序，使他支持天正

tranney

有朋友帮忙修改一下么？使得文字交换程序能够支持天正等文字吗？下面的文字刷是可以支持天正程序的，
我觉得是可以达到，但是我功力不行，有请高手捉刀！！

附：文字交换程序
(defun c:zh (/ ent1 ent2 ent1_date ent2_date old_wz_list new_wz_list
                                                                         old3_wz_list new3_wz_list
                                                                 )
        (princ "\n文字工具 交换两个文字的内容")
        (setq ent1 (entsel "\n 请选择要交换内容文字－1："))
        (setq ent1_date (entget (car ent1)))
        (setq old_wz_list (assoc 1 ent1_date))
        (princ old_wz_list)
        (setq ent2 (entsel "\n 请选择要交换内容文字－2："))
        (setq ent2_date (entget (car ent2)))
        (setq new_wz_list (assoc 1 ent2_date))
        (princ new_wz_list)
        (setq new3_wz_list new_wz_list)
        (setq old3_wz_list old_wz_list)
        (setq ent1_date (subst
                                                                                new3_wz_list
                                                                                old_wz_list
                                                                                ent1_date
                                                                        )
        )
        (setq ent2_date (subst
                                                                                old3_wz_list
                                                                                new_wz_list
                                                                                ent2_date
                                                                        )
        )
        (entmod ent1_date)
        (entmod ent2_date)
        (princ)
)


;----------  文本内容格式刷(支持天正) 开始
;;; -------------------------------------------------------------------------
;;; 文本内容刷V3.0  命令zs     --by 阿甘 2016.04
;;; 支持块中文字（块中文字只能点选，其它文字可以框选）、单行文字、多行文字、天正文字、天正图名、天正标高、属性文字、块中属性文字
(vl-load-com)
(setq source_text nil) ; 设源文字为全局变量
(defun c:Zcai_zs (/ en en_data en1 en1_data ent entype entype_source i ob pt ss ss_data txtst *error* x)
  (defun *error* (x) ;出错函数
                (if en (redraw (car en) 4))
                (setvar "ErrNo" 0)
                (setvar "cmdecho" 1)
  )
  (setvar "cmdecho" 0)
  (setvar "ErrNo" 0)
  (princ"\n排水工具： 三大刷子之文字刷子")
  (if (= source_text nil)
    (if (setq en (nentsel "\n请选择源文字(右键退出):"))
                        (progn
                                (setq en_data (entget (car en)))
                                (setq entype_source (cdr (assoc 0 en_data)))
                                (if (or (setq txtst (cdr (assoc 7 en_data))) (= entype_source "TCH_DRAWINGNAME"))
                                        (progn
                                                (redraw (car en) 3)
                                                (if (= entype_source "ATTDEF") ;如果是属性字，则取“标记”为源文字
                                                        (setq source_text (cdr (assoc 2 en_data)))
                                                        (setq source_text (cdr (assoc 1 en_data)))
                                                )
                                        ))
                        )
    )
    (if (and (= (setq en (nentsel (strcat "\n请选择源文字: 默认:" source_text))) nil) (= (getvar "ErrNo") 52))
      (progn
                                (setvar "ErrNo" 0)
                                (setq txtst T)
      )
      (if en
                                (progn
                                        (setq en_data (entget (car en)))
                                        (setq entype_source (cdr (assoc 0 en_data)))
                                        (if (or (setq txtst (cdr (assoc 7 en_data))) (= entype_source "TCH_DRAWINGNAME"))
                                                (progn
                                                        (redraw (car en) 3)
                                                        (if (= entype_source "ATTDEF") ;如果是属性字，则取“标记”为源文字
                                                                (setq source_text (cdr (assoc 2 en_data)))
                                                                (setq source_text (cdr (assoc 1 en_data)))
                                                        )
                                                ))
                                )
                                (setvar "ErrNo" 52)
                        )
    )
  )
  (if (or txtst (= entype_source "TCH_DRAWINGNAME"))
                (progn
                        (prompt "\n请选择要修改内容的文字:")
                        (while (/= (getvar "ErrNo") 52)
                                (prompt (strcat "\n文字内容将被刷成:" source_text))
                                (if (and (setq ss (ssget ":S" '((0 . "*TEXT,TCH_DRAWINGNAME,TCH_ELEVATION,INSERT,ATTDEF,ATTRIB")))) source_text)
                                        (progn
                                                (if (= (caar (setq ss_data (ssnamex ss 0))) 1)
                                                        (progn                       ; 点选时
                                                                (setq ent (ssname ss 0)
                                                                        pt (trans (cadr (last (car ss_data))) 0 1)
                                                                        en1 (car (nentselp pt))
                                                                        en1_data (entget en1)
                                                                        entype (cdr (assoc 0 en1_data))
                                                                        ob (vlax-ename->vla-object en1)
                                                                )
                                                                (wenzishua entype entype_source ob source_text en1 ent)
                                                        )
                                                        (progn                       ; 框选时
                                                                (setq i 0)
                                                                (repeat (sslength ss)
                                                                        (setq en1 (ssname ss i)
                                                                                ent en1
                                                                                en1_data (entget en1)
                                                                                entype (cdr (assoc 0 en1_data))
                                                                                ob (vlax-ename->vla-object en1)
                                                                        )
                                                                        (wenzishua entype entype_source ob source_text en1 ent)
                                                                        (setq i (1+ i))
                                                                )                               ; end repeat
                                                        )
                                                )
                                        )
                                )
                        ); end while
                ))
  (if en (redraw (car en) 4))
  (setvar "ErrNo" 0)
  (setvar "cmdecho" 1)
  (princ)
)

;文字刷子程序
(defun wenzishua (entype entype_source ob source_text en1 ent)
  ; cad多行文字
  (if (= entype "MTEXT")
    (progn
      (vla-put-TextString ob source_text)
      (entupd en1)
      (entupd ent)
    )
  )
  ;去掉多行文字无用格式符号
  (if (= entype_source "MTEXT")
    (setq source_text (mtext2text source_text))
  )
  ; cad单行文字
  (if (= entype "TEXT")
    (progn
      (vla-put-TextString ob source_text)
      (entupd en1)
      (entupd ent)
    )
  )
  ; 天正文字的内容格式刷
  (if (or
                                (= entype "TCH_TEXT")
                                (= entype "TCH_ELEVATION")
      )
    (progn
      (vlax-put-property ob 'Text source_text)
      (entupd en1)
      (entupd ent)
    )
  )   
  ; 天正图名、标高的内容格式刷
  (if (= entype "TCH_DRAWINGNAME")
    (progn
      (vlax-put-property ob 'NameText source_text)
      (entupd en1)
      (entupd ent)
    )
  )
  ; 属性文字 只改"标记"
  (if (= entype "ATTDEF")
    (progn
      (vla-put-TagString ob source_text);改标记
      (entupd en1)
      (entupd ent)
    )
  )
  ; 块中属性文字 只改"默认"
  (if (= entype "ATTRIB")
    (progn
      (vla-put-TextString ob source_text);改默认
      (entupd en1)
      (entupd ent)
    )
  )
)

;提取多行文字,去除无用格式符号--来自明经
(defun mtext2text(MTextString / regex s)
  (setq regex(vlax-create-object "Vbscript.RegExp")) ;引用正则表达式控件
  (vlax-put-property regex "IgnoreCase" 0) ;不忽略大小写
  (vlax-put-property regex "Global" 1) ;匹配方式，全文字匹配
  (setq s MTextString)
        ;替换\\字符
  (vlax-put-property regex "Pattern" "\\\\\\\\")
  (setq s(vlax-invoke-method  regex "Replace" s (chr 1)))
        ;替换\{字符
  (vlax-put-property regex "Pattern" "\\\\{")
  (setq s(vlax-invoke-method  regex "Replace" s (chr 2)))
        ;替换\}字符
  (vlax-put-property regex "Pattern" "\\\\}")
  (setq s(vlax-invoke-method  regex "Replace" s (chr 3)))
        ;删除段落缩进格式
  (vlax-put-property regex "Pattern" "\\\\pi(.[^;]*);")
  (setq s(vlax-invoke-method  regex "Replace" s ""))
        ;删除制表符格式
  (vlax-put-property regex "Pattern" "\\\\pt(.[^;]*);")
  (setq s(vlax-invoke-method  regex "Replace" s ""))
        ;删除堆迭格式
  (vlax-put-property regex "Pattern" "\\\\S(.[^;]*)(\\^|#|\\\\)(.[^;]*);")
  (setq s(vlax-invoke-method  regex "Replace" s ""))
        ;删除字体、颜色、字高、字距、倾斜、字宽、对齐格式
  (vlax-put-property regex "Pattern" "(\\\\F|\\\\f|\\\\C|\\\\H|\\\\\T|\\\\Q|\\\\W|\\\\A)(.[^;]*);")
  (setq s(vlax-invoke-method  regex "Replace" s ""))
        ;删除下划线、删除线格式
  (vlax-put-property regex "Pattern" "(\\\\L|\\\\O|\\\\l|\\\\o)")
  (setq s(vlax-invoke-method  regex "Replace" s ""))
        ;删除不间断空格格式
  (vlax-put-property regex "Pattern" "\\\\~")
  (setq s(vlax-invoke-method  regex "Replace" s ""))
        ;删除换行符格式
  (vlax-put-property regex "Pattern" "\\\\P")
  (setq s(vlax-invoke-method  regex "Replace" s ""))
        ;删除换行符格式(针对Shift+Enter格式)
  (vlax-put-property regex "Pattern" "\n")
  (setq s(vlax-invoke-method  regex "Replace" s ""))
        ;删除{}
  (vlax-put-property regex "Pattern" "({|})")
  (setq s(vlax-invoke-method  regex "Replace" s ""))
        
        ;替换回\\,\{,\}字符
  (vlax-put-property regex "Pattern" "\\x01")
  (setq s(vlax-invoke-method  regex "Replace" s "\\"))
  (vlax-put-property regex "Pattern" "\\x02")
  (setq s(vlax-invoke-method  regex "Replace" s "{"))
  (vlax-put-property regex "Pattern" "\\x03")
  (setq s(vlax-invoke-method  regex "Replace" s "}"))
        
  (vlax-release-object regex)
  s
)

lxw320

这样多好看！

附：文字交换程序

2. [code=lisp](defun c:zh (/ ent1 ent2 ent1_date ent2_date old_wz_list new_wz_list
   
3.                                                                          old3_wz_list new3_wz_list
   
4.                                                                  )
   
5.         (princ "\n文字工具 交换两个文字的内容")
   
6.         (setq ent1 (entsel "\n 请选择要交换内容文字－1："))
   
7.         (setq ent1_date (entget (car ent1)))
   
8.         (setq old_wz_list (assoc 1 ent1_date))
   
9.         (princ old_wz_list)
   
10.         (setq ent2 (entsel "\n 请选择要交换内容文字－2："))
    
11.         (setq ent2_date (entget (car ent2)))
    
12.         (setq new_wz_list (assoc 1 ent2_date))
    
13.         (princ new_wz_list)
    
14.         (setq new3_wz_list new_wz_list)
    
15.         (setq old3_wz_list old_wz_list)
    
16.         (setq ent1_date (subst
    
17.                                                                                 new3_wz_list
    
18.                                                                                 old_wz_list
    
19.                                                                                 ent1_date
    
20.                                                                         )
    
21.         )
    
22.         (setq ent2_date (subst
    
23.                                                                                 old3_wz_list
    
24.                                                                                 new_wz_list
    
25.                                                                                 ent2_date
    
26.                                                                         )
    
27.         )
    
28.         (entmod ent1_date)
    
29.         (entmod ent2_date)
    
30.         (princ)
    
31. )
    
32. 
    
33. 
    
34. ;----------  文本内容格式刷(支持天正) 开始
    
35. ;;; -------------------------------------------------------------------------
    
36. ;;; 文本内容刷V3.0  命令zs     --by 阿甘 2016.04
    
37. ;;; 支持块中文字（块中文字只能点选，其它文字可以框选）、单行文字、多行文字、天正文字、天正图名、天正标高、属性文字、块中属性文字
    
38. (vl-load-com)
    
39. (setq source_text nil) ; 设源文字为全局变量
    
40. (defun c:Zcai_zs (/ en en_data en1 en1_data ent entype entype_source i ob pt ss ss_data txtst *error* x)
    
41.   (defun *error* (x) ;出错函数
    
42.                 (if en (redraw (car en) 4))
    
43.                 (setvar "ErrNo" 0)
    
44.                 (setvar "cmdecho" 1)
    
45.   )
    
46.   (setvar "cmdecho" 0)
    
47.   (setvar "ErrNo" 0)
    
48.   (princ"\n排水工具： 三大刷子之文字刷子")
    
49.   (if (= source_text nil)
    
50.     (if (setq en (nentsel "\n请选择源文字(右键退出):"))
    
51.                         (progn
    
52.                                 (setq en_data (entget (car en)))
    
53.                                 (setq entype_source (cdr (assoc 0 en_data)))
    
54.                                 (if (or (setq txtst (cdr (assoc 7 en_data))) (= entype_source "TCH_DRAWINGNAME"))
    
55.                                         (progn
    
56.                                                 (redraw (car en) 3)
    
57.                                                 (if (= entype_source "ATTDEF") ;如果是属性字，则取“标记”为源文字
    
58.                                                         (setq source_text (cdr (assoc 2 en_data)))
    
59.                                                         (setq source_text (cdr (assoc 1 en_data)))
    
60.                                                 )
    
61.                                         ))
    
62.                         )
    
63.     )
    
64.     (if (and (= (setq en (nentsel (strcat "\n请选择源文字: 默认:" source_text))) nil) (= (getvar "ErrNo") 52))
    
65.       (progn
    
66.                                 (setvar "ErrNo" 0)
    
67.                                 (setq txtst T)
    
68.       )
    
69.       (if en
    
70.                                 (progn
    
71.                                         (setq en_data (entget (car en)))
    
72.                                         (setq entype_source (cdr (assoc 0 en_data)))
    
73.                                         (if (or (setq txtst (cdr (assoc 7 en_data))) (= entype_source "TCH_DRAWINGNAME"))
    
74.                                                 (progn
    
75.                                                         (redraw (car en) 3)
    
76.                                                         (if (= entype_source "ATTDEF") ;如果是属性字，则取“标记”为源文字
    
77.                                                                 (setq source_text (cdr (assoc 2 en_data)))
    
78.                                                                 (setq source_text (cdr (assoc 1 en_data)))
    
79.                                                         )
    
80.                                                 ))
    
81.                                 )
    
82.                                 (setvar "ErrNo" 52)
    
83.                         )
    
84.     )
    
85.   )
    
86.   (if (or txtst (= entype_source "TCH_DRAWINGNAME"))
    
87.                 (progn
    
88.                         (prompt "\n请选择要修改内容的文字:")
    
89.                         (while (/= (getvar "ErrNo") 52)
    
90.                                 (prompt (strcat "\n文字内容将被刷成:" source_text))
    
91.                                 (if (and (setq ss (ssget ":S" '((0 . "*TEXT,TCH_DRAWINGNAME,TCH_ELEVATION,INSERT,ATTDEF,ATTRIB")))) source_text)
    
92.                                         (progn
    
93.                                                 (if (= (caar (setq ss_data (ssnamex ss 0))) 1)
    
94.                                                         (progn                       ; 点选时
    
95.                                                                 (setq ent (ssname ss 0)
    
96.                                                                         pt (trans (cadr (last (car ss_data))) 0 1)
    
97.                                                                         en1 (car (nentselp pt))
    
98.                                                                         en1_data (entget en1)
    
99.                                                                         entype (cdr (assoc 0 en1_data))
    
100.                                                                         ob (vlax-ename->vla-object en1)
     
101.                                                                 )
     
102.                                                                 (wenzishua entype entype_source ob source_text en1 ent)
     
103.                                                         )
     
104.                                                         (progn                       ; 框选时
     
105.                                                                 (setq i 0)
     
106.                                                                 (repeat (sslength ss)
     
107.                                                                         (setq en1 (ssname ss i)
     
108.                                                                                 ent en1
     
109.                                                                                 en1_data (entget en1)
     
110.                                                                                 entype (cdr (assoc 0 en1_data))
     
111.                                                                                 ob (vlax-ename->vla-object en1)
     
112.                                                                         )
     
113.                                                                         (wenzishua entype entype_source ob source_text en1 ent)
     
114.                                                                         (setq i (1+ i))
     
115.                                                                 )                               ; end repeat
     
116.                                                         )
     
117.                                                 )
     
118.                                         )
     
119.                                 )
     
120.                         ); end while
     
121.                 ))
     
122.   (if en (redraw (car en) 4))
     
123.   (setvar "ErrNo" 0)
     
124.   (setvar "cmdecho" 1)
     
125.   (princ)
     
126. )
     
127. 
     
128. ;文字刷子程序
     
129. (defun wenzishua (entype entype_source ob source_text en1 ent)
     
130.   ; cad多行文字
     
131.   (if (= entype "MTEXT")
     
132.     (progn
     
133.       (vla-put-TextString ob source_text)
     
134.       (entupd en1)
     
135.       (entupd ent)
     
136.     )
     
137.   )
     
138.   ;去掉多行文字无用格式符号
     
139.   (if (= entype_source "MTEXT")
     
140.     (setq source_text (mtext2text source_text))
     
141.   )
     
142.   ; cad单行文字
     
143.   (if (= entype "TEXT")
     
144.     (progn
     
145.       (vla-put-TextString ob source_text)
     
146.       (entupd en1)
     
147.       (entupd ent)
     
148.     )
     
149.   )
     
150.   ; 天正文字的内容格式刷
     
151.   (if (or
     
152.                                 (= entype "TCH_TEXT")
     
153.                                 (= entype "TCH_ELEVATION")
     
154.       )
     
155.     (progn
     
156.       (vlax-put-property ob 'Text source_text)
     
157.       (entupd en1)
     
158.       (entupd ent)
     
159.     )
     
160.   )   
     
161.   ; 天正图名、标高的内容格式刷
     
162.   (if (= entype "TCH_DRAWINGNAME")
     
163.     (progn
     
164.       (vlax-put-property ob 'NameText source_text)
     
165.       (entupd en1)
     
166.       (entupd ent)
     
167.     )
     
168.   )
     
169.   ; 属性文字 只改"标记"
     
170.   (if (= entype "ATTDEF")
     
171.     (progn
     
172.       (vla-put-TagString ob source_text);改标记
     
173.       (entupd en1)
     
174.       (entupd ent)
     
175.     )
     
176.   )
     
177.   ; 块中属性文字 只改"默认"
     
178.   (if (= entype "ATTRIB")
     
179.     (progn
     
180.       (vla-put-TextString ob source_text);改默认
     
181.       (entupd en1)
     
182.       (entupd ent)
     
183.     )
     
184.   )
     
185. )
     
186. 
     
187. ;提取多行文字,去除无用格式符号--来自明经
     
188. (defun mtext2text(MTextString / regex s)
     
189.   (setq regex(vlax-create-object "Vbscript.RegExp")) ;引用正则表达式控件
     
190.   (vlax-put-property regex "IgnoreCase" 0) ;不忽略大小写
     
191.   (vlax-put-property regex "Global" 1) ;匹配方式，全文字匹配
     
192.   (setq s MTextString)
     
193.         ;替换\\字符
     
194.   (vlax-put-property regex "Pattern" "\\\\\\\")
     
195.   (setq s(vlax-invoke-method  regex "Replace" s (chr 1)))
     
196.         ;替换\{字符
     
197.   (vlax-put-property regex "Pattern" "\\\\{")
     
198.   (setq s(vlax-invoke-method  regex "Replace" s (chr 2)))
     
199.         ;替换\}字符
     
200.   (vlax-put-property regex "Pattern" "\\\\}")
     
201.   (setq s(vlax-invoke-method  regex "Replace" s (chr 3)))
     
202.         ;删除段落缩进格式
     
203.   (vlax-put-property regex "Pattern" "\\\\pi(.[^;]*);")
     
204.   (setq s(vlax-invoke-method  regex "Replace" s ""))
     
205.         ;删除制表符格式
     
206.   (vlax-put-property regex "Pattern" "\\\\pt(.[^;]*);")
     
207.   (setq s(vlax-invoke-method  regex "Replace" s ""))
     
208.         ;删除堆迭格式
     
209.   (vlax-put-property regex "Pattern" "\\\\S(.[^;]*)(\\^|#|\\\\)(.[^;]*);")
     
210.   (setq s(vlax-invoke-method  regex "Replace" s ""))
     
211.         ;删除字体、颜色、字高、字距、倾斜、字宽、对齐格式
     
212.   (vlax-put-property regex "Pattern" "(\\\\F|\\\\f|\\\\C|\\\\H|\\\\\T|\\\\Q|\\\\W|\\\\A)(.[^;]*);")
     
213.   (setq s(vlax-invoke-method  regex "Replace" s ""))
     
214.         ;删除下划线、删除线格式
     
215.   (vlax-put-property regex "Pattern" "(\\\\L|\\\\O|\\\\l|\\\\o)")
     
216.   (setq s(vlax-invoke-method  regex "Replace" s ""))
     
217.         ;删除不间断空格格式
     
218.   (vlax-put-property regex "Pattern" "\\\\~")
     
219.   (setq s(vlax-invoke-method  regex "Replace" s ""))
     
220.         ;删除换行符格式
     
221.   (vlax-put-property regex "Pattern" "\\\\P")
     
222.   (setq s(vlax-invoke-method  regex "Replace" s ""))
     
223.         ;删除换行符格式(针对Shift+Enter格式)
     
224.   (vlax-put-property regex "Pattern" "\n")
     
225.   (setq s(vlax-invoke-method  regex "Replace" s ""))
     
226.         ;删除{}
     
227.   (vlax-put-property regex "Pattern" "({|})")
     
228.   (setq s(vlax-invoke-method  regex "Replace" s ""))
     
229.         
     
230.         ;替换回\\,\{,\}字符
     
231.   (vlax-put-property regex "Pattern" "\\x01")
     
232.   (setq s(vlax-invoke-method  regex "Replace" s "\"))
     
233.   (vlax-put-property regex "Pattern" "\\x02")
     
234.   (setq s(vlax-invoke-method  regex "Replace" s "{"))
     
235.   (vlax-put-property regex "Pattern" "\\x03")
     
236.   (setq s(vlax-invoke-method  regex "Replace" s "}"))
     
237.         
     
238.   (vlax-release-object regex)
     
239.   s
     
240. )

[code=lisp](defun c:zh (/ ent1 ent2 ent1_date ent2_date old_wz_list new_wz_list<br />                                                                          old3_wz_list new3_wz_list<br />                                                                  )<br />         (princ "\n文字工具 交换两个文字的内容")<br />         (setq ent1 (entsel "\n 请选择要交换内容文字－1："))<br />         (setq ent1_date (entget (car ent1)))<br />         (setq old_wz_list (assoc 1 ent1_date))<br />         (princ old_wz_list)<br />         (setq ent2 (entsel "\n 请选择要交换内容文字－2："))<br />         (setq ent2_date (entget (car ent2)))<br />         (setq new_wz_list (assoc 1 ent2_date))<br />         (princ new_wz_list)<br />         (setq new3_wz_list new_wz_list)<br />         (setq old3_wz_list old_wz_list)<br />         (setq ent1_date (subst<br />                                                                                 new3_wz_list<br />                                                                                 old_wz_list<br />                                                                                 ent1_date<br />                                                                         )<br />         )<br />         (setq ent2_date (subst<br />                                                                                 old3_wz_list<br />                                                                                 new_wz_list<br />                                                                                 ent2_date<br />                                                                         )<br />         )<br />         (entmod ent1_date)<br />         (entmod ent2_date)<br />         (princ)<br /> )<br /> <br /> <br /> ;----------  文本内容格式刷(支持天正) 开始<br /> ;;; -------------------------------------------------------------------------<br /> ;;; 文本内容刷V3.0  命令zs     --by 阿甘 2016.04<br /> ;;; 支持块中文字（块中文字只能点选，其它文字可以框选）、单行文字、多行文字、天正文字、天正图名、天正标高、属性文字、块中属性文字<br /> (vl-load-com)<br /> (setq source_text nil) ; 设源文字为全局变量<br /> (defun c:Zcai_zs (/ en en_data en1 en1_data ent entype entype_source i ob pt ss ss_data txtst *error* x)<br />   (defun *error* (x) ;出错函数<br />                 (if en (redraw (car en) 4))<br />                 (setvar "ErrNo" 0)<br />                 (setvar "cmdecho" 1)<br />   )<br />   (setvar "cmdecho" 0)<br />   (setvar "ErrNo" 0)<br />   (princ"\n排水工具： 三大刷子之文字刷子")<br />   (if (= source_text nil)<br />     (if (setq en (nentsel "\n请选择源文字(右键退出):"))<br />                         (progn<br />                                 (setq en_data (entget (car en)))<br />                                 (setq entype_source (cdr (assoc 0 en_data)))<br />                                 (if (or (setq txtst (cdr (assoc 7 en_data))) (= entype_source "TCH_DRAWINGNAME"))<br />                                         (progn<br />                                                 (redraw (car en) 3)<br />                                                 (if (= entype_source "ATTDEF") ;如果是属性字，则取“标记”为源文字<br />                                                         (setq source_text (cdr (assoc 2 en_data)))<br />                                                         (setq source_text (cdr (assoc 1 en_data)))<br />                                                 )<br />                                         ))<br />                         )<br />     )<br />     (if (and (= (setq en (nentsel (strcat "\n请选择源文字: 默认:" source_text))) nil) (= (getvar "ErrNo") 52))<br />       (progn<br />                                 (setvar "ErrNo" 0)<br />                                 (setq txtst T)<br />       )<br />       (if en<br />                                 (progn<br />                                         (setq en_data (entget (car en)))<br />                                         (setq entype_source (cdr (assoc 0 en_data)))<br />                                         (if (or (setq txtst (cdr (assoc 7 en_data))) (= entype_source "TCH_DRAWINGNAME"))<br />                                                 (progn<br />                                                         (redraw (car en) 3)<br />                                                         (if (= entype_source "ATTDEF") ;如果是属性字，则取“标记”为源文字<br />                                                                 (setq source_text (cdr (assoc 2 en_data)))<br />                                                                 (setq source_text (cdr (assoc 1 en_data)))<br />                                                         )<br />                                                 ))<br />                                 )<br />                                 (setvar "ErrNo" 52)<br />                         )<br />     )<br />   )<br />   (if (or txtst (= entype_source "TCH_DRAWINGNAME"))<br />                 (progn<br />                         (prompt "\n请选择要修改内容的文字:")<br />                         (while (/= (getvar "ErrNo") 52)<br />                                 (prompt (strcat "\n文字内容将被刷成:" source_text))<br />                                 (if (and (setq ss (ssget ":S" '((0 . "*TEXT,TCH_DRAWINGNAME,TCH_ELEVATION,INSERT,ATTDEF,ATTRIB")))) source_text)<br />                                         (progn<br />                                                 (if (= (caar (setq ss_data (ssnamex ss 0))) 1)<br />                                                         (progn                       ; 点选时<br />                                                                 (setq ent (ssname ss 0)<br />                                                                         pt (trans (cadr (last (car ss_data))) 0 1)<br />                                                                         en1 (car (nentselp pt))<br />                                                                         en1_data (entget en1)<br />                                                                         entype (cdr (assoc 0 en1_data))<br />                                                                         ob (vlax-ename->vla-object en1)<br />                                                                 )<br />                                                                 (wenzishua entype entype_source ob source_text en1 ent)<br />                                                         )<br />                                                         (progn                       ; 框选时<br />                                                                 (setq i 0)<br />                                                                 (repeat (sslength ss)<br />                                                                         (setq en1 (ssname ss i)<br />                                                                                 ent en1<br />                                                                                 en1_data (entget en1)<br />                                                                                 entype (cdr (assoc 0 en1_data))<br />                                                                                 ob (vlax-ename->vla-object en1)<br />                                                                         )<br />                                                                         (wenzishua entype entype_source ob source_text en1 ent)<br />                                                                         (setq i (1+ i))<br />                                                                 )                               ; end repeat<br />                                                         )<br />                                                 )<br />                                         )<br />                                 )<br />                         ); end while<br />                 ))<br />   (if en (redraw (car en) 4))<br />   (setvar "ErrNo" 0)<br />   (setvar "cmdecho" 1)<br />   (princ)<br /> )<br /> <br /> ;文字刷子程序<br /> (defun wenzishua (entype entype_source ob source_text en1 ent) <br />   ; cad多行文字<br />   (if (= entype "MTEXT")<br />     (progn<br />       (vla-put-TextString ob source_text)<br />       (entupd en1)<br />       (entupd ent)<br />     )<br />   )<br />   ;去掉多行文字无用格式符号<br />   (if (= entype_source "MTEXT")<br />     (setq source_text (mtext2text source_text))<br />   )<br />   ; cad单行文字<br />   (if (= entype "TEXT")<br />     (progn<br />       (vla-put-TextString ob source_text)<br />       (entupd en1)<br />       (entupd ent)<br />     )<br />   )<br />   ; 天正文字的内容格式刷<br />   (if (or<br />                                 (= entype "TCH_TEXT")<br />                                 (= entype "TCH_ELEVATION")<br />       )<br />     (progn<br />       (vlax-put-property ob 'Text source_text)<br />       (entupd en1)<br />       (entupd ent)<br />     )<br />   )   <br />   ; 天正图名、标高的内容格式刷<br />   (if (= entype "TCH_DRAWINGNAME")<br />     (progn<br />       (vlax-put-property ob 'NameText source_text)<br />       (entupd en1)<br />       (entupd ent)<br />     )<br />   )<br />   ; 属性文字 只改"标记"<br />   (if (= entype "ATTDEF")<br />     (progn<br />       (vla-put-TagString ob source_text);改标记<br />       (entupd en1)<br />       (entupd ent)<br />     )<br />   )<br />   ; 块中属性文字 只改"默认"<br />   (if (= entype "ATTRIB")<br />     (progn<br />       (vla-put-TextString ob source_text);改默认<br />       (entupd en1)<br />       (entupd ent)<br />     )<br />   )<br /> )<br /> <br /> ;提取多行文字,去除无用格式符号--来自明经<br /> (defun mtext2text(MTextString / regex s)<br />   (setq regex(vlax-create-object "Vbscript.RegExp")) ;引用正则表达式控件<br />   (vlax-put-property regex "IgnoreCase" 0) ;不忽略大小写<br />   (vlax-put-property regex "Global" 1) ;匹配方式，全文字匹配<br />   (setq s MTextString)<br />         ;替换\\字符<br />   (vlax-put-property regex "Pattern" "\\\\\\\")<br />   (setq s(vlax-invoke-method  regex "Replace" s (chr 1)))<br />         ;替换\{字符<br />   (vlax-put-property regex "Pattern" "\\\\{")<br />   (setq s(vlax-invoke-method  regex "Replace" s (chr 2)))<br />         ;替换\}字符<br />   (vlax-put-property regex "Pattern" "\\\\}")<br />   (setq s(vlax-invoke-method  regex "Replace" s (chr 3)))<br />         ;删除段落缩进格式<br />   (vlax-put-property regex "Pattern" "\\\\pi(.[^;]*);")<br />   (setq s(vlax-invoke-method  regex "Replace" s ""))<br />         ;删除制表符格式<br />   (vlax-put-property regex "Pattern" "\\\\pt(.[^;]*);")<br />   (setq s(vlax-invoke-method  regex "Replace" s ""))<br />         ;删除堆迭格式<br />   (vlax-put-property regex "Pattern" "\\\\S(.[^;]*)(\\^|#|\\\\)(.[^;]*);")<br />   (setq s(vlax-invoke-method  regex "Replace" s ""))<br />         ;删除字体、颜色、字高、字距、倾斜、字宽、对齐格式<br />   (vlax-put-property regex "Pattern" "(\\\\F|\\\\f|\\\\C|\\\\H|\\\\\T|\\\\Q|\\\\W|\\\\A)(.[^;]*);")<br />   (setq s(vlax-invoke-method  regex "Replace" s ""))<br />         ;删除下划线、删除线格式<br />   (vlax-put-property regex "Pattern" "(\\\\L|\\\\O|\\\\l|\\\\o)")<br />   (setq s(vlax-invoke-method  regex "Replace" s ""))<br />         ;删除不间断空格格式<br />   (vlax-put-property regex "Pattern" "\\\\~")<br />   (setq s(vlax-invoke-method  regex "Replace" s ""))<br />         ;删除换行符格式<br />   (vlax-put-property regex "Pattern" "\\\\P")<br />   (setq s(vlax-invoke-method  regex "Replace" s ""))<br />         ;删除换行符格式(针对Shift+Enter格式)<br />   (vlax-put-property regex "Pattern" "\n")<br />   (setq s(vlax-invoke-method  regex "Replace" s ""))<br />         ;删除{}<br />   (vlax-put-property regex "Pattern" "({|})")<br />   (setq s(vlax-invoke-method  regex "Replace" s ""))<br />         <br />         ;替换回\\,\{,\}字符<br />   (vlax-put-property regex "Pattern" "\\x01")<br />   (setq s(vlax-invoke-method  regex "Replace" s "\"))<br />   (vlax-put-property regex "Pattern" "\\x02")<br />   (setq s(vlax-invoke-method  regex "Replace" s "{"))<br />   (vlax-put-property regex "Pattern" "\\x03")<br />   (setq s(vlax-invoke-method  regex "Replace" s "}"))<br />         <br />   (vlax-release-object regex)<br />   s<br /> )

[/code]

小万LISP

是的是的.我也想对某正下手. 想了很久了.

wudechao

lxw320 发表于 2019-10-5 13:23
这样多好看！

附：文字交换程序[/code]

最后一个函数，代码少了两根\。(vlax-put-property regex "Pattern" "\\\\\\\\") (setq s (vlax-invoke-method regex "Replace" s "\\"))