Mtext多行文字字体修改

newbuser

2. (defun UnFormat (Mtext KeepLF / Text Str)
   
3.   (vl-load-com)
   
4.   (cond
   
5.     ((= (type Mtext) 'VLA-Object))
   
6.     ((= (type Mtext) 'ENAME)
   
7.       (setq Mtext (vlax-ename->vla-object Mtext))
   
8.     )
   
9.     (1 (setq Mtext nil))
   
10.   )
    
11.   (and
    
12.     Mtext
    
13.     (= (vlax-get Mtext 'ObjectName) "AcDbMText")
    
14.     (setq Mtext (vlax-get Mtext 'TextString))
    
15.     (setq Text "")
    
16.     (while (/= Mtext "")
    
17.       (cond
    
18.         ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[\\{}`~]")
    
19.           (setq Mtext (substr Mtext 3)
    
20.                 Text   (strcat Text Str)
    
21.           )
    
22.         )
    
23.         ((wcmatch (substr Mtext 1 1) "[{}]")
    
24.           (setq Mtext (substr Mtext 2))
    
25.         )
    
26.         ((and KeepLF (wcmatch (strcase (substr Mtext 1 2)) "\\P"))
    
27.           (setq Mtext (substr Mtext 3)
    
28.                 Text  (strcat Text "\\P")
    
29.           )
    
30.         )
    
31.         ((wcmatch (strcase (substr Mtext 1 2)) "\\[LOP]")
    
32.           (setq Mtext (substr Mtext 3))
    
33.         )
    
34.         ((wcmatch (strcase (substr Mtext 1 2)) "\\[ACFHQTW]")
    
35.           (setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext))))
    
36.         )
    
37.         ((wcmatch (strcase (substr Mtext 1 2)) "\\S")
    
38.           (setq Str   (substr Mtext 3 (- (vl-string-search ";" Mtext) 2))
    
39.                 Text  (strcat Text (vl-string-translate "#^/" "   " Str))
    
40.                 Mtext (substr Mtext (+ 4 (strlen Str)))
    
41.           )
    
42.         )
    
43. ((> (ascii Mtext) 127)
    
44.   (setq Text (strcat Text (substr Mtext 1 2))
    
45.         Mtext (substr Mtext 3)
    
46.         )
    
47.   )
    
48.         (1
    
49.           (setq Text (strcat Text (substr Mtext 1 1))
    
50.                 Mtext (substr Mtext 2)
    
51.           )
    
52.         )
    
53.       )
    
54.     )
    
55.   )
    
56.   Text
    
57. )
    
58. ;;;以上自定义函数 unformat引自明经通道之咬文嚼字等一系列高人作品
    
59. (defun c:gzt( / n ss e el)
    
60.   (setq ss (ssget))
    
61.   (setq n 0)
    
62.   (repeat (sslength ss)
    
63.     (setq e (ssname ss n))
    
64.     (setq el (entget e))
    
65.     (if (= "MTEXT" (cdr (assoc 0 el)))
    
66.       (progn
    
67.   (setq el (subst (cons 1 (strcat "{\\fSTZhongsong|b0|i0|c134|p2;" (unformat e keepfl) "}")) (assoc 1 el) el))     ;;;此处例举改为华文中宋
    
68.   (entmod el)
    
69.   )
    
70.      )
    
71.     (setq n (+ n 1))
    
72.    )
    
73.   (princ)
    
74.   )
    
75. 
    
76. ;;;常用字体列表，其余可自己查询
    
77. ;;;fSTZhongsong|b0|i0|c134|p2               华文中宋
    
78. ;;;fSimHei|b0|i0|c134|p2                    黑体
    
79. ;;;fLiSu|b0|i0|c134|p49                     隶书
    
80. ;;;fFangSong_GB2312|b0|i0|c134|p49          仿宋2312
    
81. ;;;fKaiTi_GB2312|b0|i0|c134|p49             楷体2312
    
82. ;;;fNSimSun|b0|i0|c134|p49                  新宋体
    
83. ;;;fSimSun|b0|i0|c134|p2                    宋体

(defun UnFormat (Mtext KeepLF / Text Str) <br />   (vl-load-com) <br />   (cond <br />     ((= (type Mtext) 'VLA-Object)) <br />     ((= (type Mtext) 'ENAME) <br />       (setq Mtext (vlax-ename->vla-object Mtext)) <br />     ) <br />     (1 (setq Mtext nil)) <br />   ) <br />   (and <br />     Mtext <br />     (= (vlax-get Mtext 'ObjectName) "AcDbMText") <br />     (setq Mtext (vlax-get Mtext 'TextString)) <br />     (setq Text "") <br />     (while (/= Mtext "") <br />       (cond <br />         ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[\\{}`~]") <br />           (setq Mtext (substr Mtext 3) <br />                 Text   (strcat Text Str) <br />           ) <br />         ) <br />         ((wcmatch (substr Mtext 1 1) "[{}]") <br />           (setq Mtext (substr Mtext 2)) <br />         ) <br />         ((and KeepLF (wcmatch (strcase (substr Mtext 1 2)) "\\P")) <br />           (setq Mtext (substr Mtext 3) <br />                 Text  (strcat Text "\\P") <br />           ) <br />         ) <br />         ((wcmatch (strcase (substr Mtext 1 2)) "\\[LOP]") <br />           (setq Mtext (substr Mtext 3)) <br />         ) <br />         ((wcmatch (strcase (substr Mtext 1 2)) "\\[ACFHQTW]") <br />           (setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext)))) <br />         ) <br />         ((wcmatch (strcase (substr Mtext 1 2)) "\\S") <br />           (setq Str   (substr Mtext 3 (- (vl-string-search ";" Mtext) 2)) <br />                 Text  (strcat Text (vl-string-translate "#^/" "   " Str)) <br />                 Mtext (substr Mtext (+ 4 (strlen Str))) <br />           ) <br />         )<br /> ((> (ascii Mtext) 127)<br />   (setq Text (strcat Text (substr Mtext 1 2))<br />         Mtext (substr Mtext 3)<br />         )<br />   )<br />         (1 <br />           (setq Text (strcat Text (substr Mtext 1 1)) <br />                 Mtext (substr Mtext 2) <br />           ) <br />         )<br />       ) <br />     ) <br />   ) <br />   Text <br /> )<br /> ;;;以上自定义函数 unformat引自明经通道之咬文嚼字等一系列高人作品<br /> (defun c:gzt( / n ss e el)<br />   (setq ss (ssget))<br />   (setq n 0)<br />   (repeat (sslength ss)<br />     (setq e (ssname ss n))<br />     (setq el (entget e))<br />     (if (= "MTEXT" (cdr (assoc 0 el)))<br />       (progn<br />   (setq el (subst (cons 1 (strcat "{\\fSTZhongsong|b0|i0|c134|p2;" (unformat e keepfl) "}")) (assoc 1 el) el))     ;;;此处例举改为华文中宋<br />   (entmod el)<br />   )<br />      )<br />     (setq n (+ n 1))<br />    )<br />   (princ)<br />   )<br /> <br /> ;;;常用字体列表，其余可自己查询<br /> ;;;fSTZhongsong|b0|i0|c134|p2               华文中宋<br /> ;;;fSimHei|b0|i0|c134|p2                    黑体<br /> ;;;fLiSu|b0|i0|c134|p49                     隶书<br /> ;;;fFangSong_GB2312|b0|i0|c134|p49          仿宋2312<br /> ;;;fKaiTi_GB2312|b0|i0|c134|p49             楷体2312<br /> ;;;fNSimSun|b0|i0|c134|p49                  新宋体<br /> ;;;fSimSun|b0|i0|c134|p2                    宋体

为何这些字体必须原封不动的复制才能够替换成功，若照猫画虎逐字符输入则无任何反应呢？

梦里水香

非常有用，解决了困扰几天的问题。。
不过解答不了你提的问题，等待高人。。

newbuser

梦里水香 发表于 2013-8-13 23:51
非常有用，解决了困扰几天的问题。。
不过解答不了你提的问题，等待高人。。

能给您些许帮助，是在下的荣幸。
唉，高端问题还是等高端人士赐教吧，期待中。。。

梦里水香

这个程序不支持标注，不知道有没有高人能修改一下。

newbuser

梦里水香 发表于 2013-8-14 08:31
这个程序不支持标注，不知道有没有高人能修改一下。

什么标注？坐标的还可以研究下，要是尺寸的就没啥思路了。我也是低手，水平有限啊大哥。