[LISP程序]：超级文本格式刷，欢迎大家使用及测试！

Dallas_whu

2. (Defun C:Mt (/ Oldblp Oldech Key I Ent1        En Ss Nel Val_List J List_Len
   
3.              Val El N)
   
4.    (Initget "N G Q T Y X C A")
   
5.   (Setq
   
6.     Key
   
7.      (Getkword
   
8.        "\N/内容(N)/高度(G)/图层(C)/样式(Y)/倾斜角(Q)/旋转角(X)/高宽比(W)/全部(A)/(默认A): "
   
9.      )
   
10.   )
    
11.   (Cond
    
12.     ((= Key "N") (Setq I 1))
    
13.     ((= Key "G") (Setq I 40))
    
14.     ((= Key "C") (Setq I 8))
    
15.     ((= Key "Y") (Setq I 7))
    
16.     ((= Key "Q") (Setq I 51))
    
17.     ((= Key "X") (Setq I 50))
    
18.     ((= Key "W") (Setq I 41))
    
19.     ((= Key "A") (Setq I 0))
    
20.     (T (Setq I 0))
    
21.   )
    
22.   (Setq Ent1 (Car (Entsel "\N先点选源文本:")))
    
23.   (While (= Ent1 Nil)
    
24.     (Princ "\N没有选中文本对象！")
    
25.     (Setq Ent1 (Car (Entsel "\先点选源文本:")))
    
26.     )
    
27.   (Setq En (Entget Ent1))
    
28.   (While (/= "Text" (Cdr (Assoc 0 En)))
    
29.     (Progn
    
30.       (Princ "对象不是文本，重新选择！")
    
31.       (Setq Ent1 (Car (Entsel "\N先点选源文本:")))
    
32.       (Setq En (Entget Ent1))
    
33.     )
    
34.   )
    
35.   (Princ "\N再选择目标文本：")
    
36.   (If (Setq Ss (Ssget '((0 . "Text"))))
    
37.     (Progn
    
38.       (Setq N 0)
    
39.       (While (< N (Sslength Ss))
    
40.         (Setq El (Entget (Ssname Ss N)))
    
41.         (If (= I 0)
    
42.           (Progn
    
43.             (Setq J 0)
    
44.             (Setq Val_List (List 1 40 8 7 50 51 41))
    
45.             (Setq List_Len (Length Val_List))
    
46.             (While (< J List_Len)
    
47.               (Setq Val (Nth J Val_List))
    
48.               (Setq El
    
49.                      (Entmod (Subst
    
50.                                (Cons Val (Cdr (Assoc Val En)))
    
51.                                (Assoc Val El)
    
52.                                El
    
53.                              )
    
54.                      )
    
55.               )
    
56.               (Setq J (1+ J))
    
57.             )
    
58.           )
    
59.           (Progn
    
60.             (Setq Val I)
    
61.             (Setq El
    
62.                    (Entmod (Subst
    
63.                              (Cons Val (Cdr (Assoc Val En)))
    
64.                              (Assoc Val El)
    
65.                              El
    
66.                            )
    
67.                    )
    
68.             )
    
69.           )
    
70.         )
    
71.         (Setq N (1+ N))
    
72.       )
    
73.     )
    
74.   )
    
75.     (Princ)
    
76. )

(Defun C:Mt (/ Oldblp Oldech Key I Ent1        En Ss Nel Val_List J List_Len<br />              Val El N)<br />    (Initget "N G Q T Y X C A")<br />   (Setq<br />     Key<br />      (Getkword<br />        "\N/内容(N)/高度(G)/图层(C)/样式(Y)/倾斜角(Q)/旋转角(X)/高宽比(W)/全部(A)/(默认A): "<br />      )<br />   )<br />   (Cond<br />     ((= Key "N") (Setq I 1))<br />     ((= Key "G") (Setq I 40))<br />     ((= Key "C") (Setq I 8))<br />     ((= Key "Y") (Setq I 7))<br />     ((= Key "Q") (Setq I 51))<br />     ((= Key "X") (Setq I 50))<br />     ((= Key "W") (Setq I 41))<br />     ((= Key "A") (Setq I 0))<br />     (T (Setq I 0))<br />   )<br />   (Setq Ent1 (Car (Entsel "\N先点选源文本:")))<br />   (While (= Ent1 Nil)<br />     (Princ "\N没有选中文本对象！")<br />     (Setq Ent1 (Car (Entsel "\先点选源文本:")))<br />     )<br />   (Setq En (Entget Ent1))<br />   (While (/= "Text" (Cdr (Assoc 0 En)))<br />     (Progn<br />       (Princ "对象不是文本，重新选择！")<br />       (Setq Ent1 (Car (Entsel "\N先点选源文本:")))<br />       (Setq En (Entget Ent1))<br />     )<br />   )<br />   (Princ "\N再选择目标文本：")<br />   (If (Setq Ss (Ssget '((0 . "Text"))))<br />     (Progn<br />       (Setq N 0)<br />       (While (< N (Sslength Ss))<br />         (Setq El (Entget (Ssname Ss N)))<br />         (If (= I 0)<br />           (Progn<br />             (Setq J 0)<br />             (Setq Val_List (List 1 40 8 7 50 51 41))<br />             (Setq List_Len (Length Val_List))<br />             (While (< J List_Len)<br />               (Setq Val (Nth J Val_List))<br />               (Setq El<br />                      (Entmod (Subst<br />                                (Cons Val (Cdr (Assoc Val En)))<br />                                (Assoc Val El)<br />                                El<br />                              )<br />                      )<br />               )<br />               (Setq J (1+ J))<br />             )<br />           )<br />           (Progn<br />             (Setq Val I)<br />             (Setq El<br />                    (Entmod (Subst<br />                              (Cons Val (Cdr (Assoc Val En)))<br />                              (Assoc Val El)<br />                              El<br />                            )<br />                    )<br />             )<br />           )<br />         )<br />         (Setq N (1+ N))<br />       )<br />     )<br />   )<br />     (Princ)<br /> )

曹杰

看来只能刷单行文字，楼主能否增加刷尺寸文字和属性文字的功能或者块中文字的功能

tan3640460

晕。看不懂。。

marcoyuwen

有几条意见供参考：
1。1楼楼主的程序不能刷FIT对齐方式的文本宽度和ALIGN对齐方式的文本高度
2。是否增加对齐方式。
3。“点选源文本”的程序从结构上说写的不太好，有点儿罗嗦，一个问题写两遍。
4。“点选源文本”的程序选中的源文本不能亮显，建议增加此功能。
5。从总体结构上说，当点选源文本失败或主观上退出时，程序仍要求选取目标文本。
6。程序创意不错，也能使用。上述意见供参考，不妥之处请指正。

libo_dy

我在cad2004里怎么不能使用呢？

提示：N先点选源文本:对象不是文本，重新选择！N先点选源文本:对象不是文本，重新选择！

zfconnor

谢谢
但是似乎看不明白啊