[分享]：中西混排矢量文字字高调整程序

kingpanfeng

这是一个能够调整中西混排时中文和西文字高看起来不一样高的程序，是从一篇论文上整理下来的，整理完后不知道哪里有问题不能使用，请高手帮忙看一下，看看哪里有问题，修正一下这个lisp程序。（该论文详见附件）

作者的思路是当中西文混排又是采用矢量字体时让汉字和西文分开，要么放大汉字要么缩小西文。该程序考虑到了截断语句和改变字高带来的位置变化，除了破坏了语句的整体性外，表面上几乎是天衣无缝的 从原理上讲确实非常原始，但还算实用方便。

程序如下：

2. 
   
3.   [FONT=courier new]
   
4. ;;;ZXTEXT.LSP中西混排矢量文字输入及调整程序
   
5. ;;;--------------------------------------------
   
6. (defun c:zxtext        (/hight pt style chinese xx angle ang str)
   
7.   (setq os (getvar "osmode"))
   
8.   (setvar "osmode" 0)
   
9.   (initget "Edit")
   
10.   (setq pt (getpoint "\nEdit <Start point:>"))
    
11.   (if (=pt "Edit")
    
12.     (zxedit)
    
13.     (progn
    
14.       (setq style (getvar "TEXTSTYLE"))
    
15.       (setq chinese (cdr (assoc 4 (tb1search "style" style))))
    
16.       (if (=chinese "")
    
17.         (progn)
    
18.         (prompt
    
19.           (strcat "\n当前的字型"style"中没有定义矢量汉字字体")
    
20.         )
    
21.         (princ))
    
22.       (progn
    
23.         (setq hight (getvar "TEXTSIZE"))
    
24.         (setq XX (getdist pt (strcat "\nHeight <" (rtos hight) ">:")))
    
25.         if
    
26.         XX
    
27.         (setq hight XX)
    
28.       )
    
29.       (setq angle (getangle "\nRotation angle <0>:"))
    
30.       (if (=angle nil)
    
31.         (setq angle 0)
    
32.       )
    
33.       (setq ang (/ (* angle pi) 180))
    
34.       (setq str (getstring 1 "\nText : "))
    
35.       (zxtext _a)
    
36.     )
    
37.   )
    
38. )
    
39. )
    
40. (setvar "osmode" os)
    
41. )
    
42. ;;;---------------------------------------------------------------------------------
    
43. (defun zxedit /object sset sslen nsset ename elist style layer selist chinese str hight width color pt ang angle)
    
44. (setq object "edit"
    
45.       (setq sset (ai _ aselect))
    
46.        (if (null sset)
    
47.          (progn
    
48.            (princ "\n错误：没有选到文字。")
    
49.            (exit)
    
50.          )
    
51.        )
    
52.       (setq sslen (sslength sset)
    
53.             nsset (ssadd)
    
54.       )
    
55.        (if (>sslen 25)
    
56.          (princ "\n确认所选的图元--请稍候。")
    
57.        )
    
58.       (while (>sslen 0)
    
59.         (setq ename (ssname sset (setq sslen (1-sslen)))
    
60.               elist (entget ename)
    
61.         )
    
62.         (if (= (cdr (assoc 0 elist)) "TEXT")
    
63.           (progn
    
64.             (setq style          (cdr (assoc 7 elist))
    
65.                   selist  (tb1search "style" style)
    
66.                   chinese (cdr (assoc 4 selist))
    
67.             )
    
68.             (if        (/=chinese "")
    
69.               (ssadd ename nsset)
    
70.             )
    
71.           )
    
72.         )
    
73.       )
    
74.        (setq sslen (sslength nsset)
    
75.              sset  nsset
    
76.        )
    
77.       (while (>sslen 0)
    
78.         (setq ename (ssname sset (setq sslen (1-sslen)))
    
79.               elist (entget ename)
    
80.               str   (cdr (assoc 1 elist))
    
81.               style (cdr (assoc 7 elist))
    
82.               layer (cdr (assoc 8 elist))
    
83.               pt    (cdr (assoc 1O elist))
    
84.               hight (cdr (assoc 40 elist))
    
85.               width (cdr (assoc 41 elist))
    
86.               ang   (cdr (assoc 5O elist))
    
87.               color (cdr (assoc 62 elist))
    
88.               angle (/ (* ang 180) pi)
    
89.         )
    
90.         (command "_erase" ename "")
    
91.         (command "_style" style "" "0.0" "" "" "" "" "")
    
92.         (zxtext _a)
    
93.       )
    
94. )
    
95. ;;;-------------------------------------------------------------------------------------
    
96. (defun zxtext _a (/n a len asc _a asc _b asc_c len new _str pt2
    
97. )
    
98. (setq n        1
    
99.       a        n
    
100.       len 1
     
101. )
     
102. (while (/= (substr str n 1) "")
     
103.   (setq        asc _a (ascii ((substr str n 1))
     
104.         asc _b (ascii (substr str (1+n) 1))
     
105.         )
     
106.          (if (=asc _c nil)(setq asc _c asc_a))
     
107.         (if (and (/=asc _b 0);非空
     
108.                  (or
     
109.                    (and (<asc _a 127) (<asc _b 127) (<asc _c 127));两者均为西文
     
110.                    (and (>asc _a 127) (>asc _b l27)) ;两者均为汉字
     
111.                    (and (>asc _a 127) (=asc _b 32)) ;汉字中空格
     
112.                    (and (=asc _a 32) (=asc _b 32)) ;空格
     
113.                    (and (=asc _a 32) (>asc _b 127) (>asc _c 127));汉字中空格
     
114.                  )
     
115.             )
     
116.           (setq len (1+ len))
     
117.           (progn
     
118.             (setq new str
     
119.                   (substr str a len)
     
120.             )
     
121.             (if        (< (ascii (substr new _str 1 1)) 127)
     
122.               (progn
     
123.                 (setq pt (polar pt (－ang (* pi 0.5)) (* hight 0.1)))
     
124.                 (setq pt 2 "up")
     
125.                 (command "text" pt (* hight 0.8) angle new _str)
     
126.                 (setq asc _c nil)
     
127.               )
     
128.               (progn
     
129.                 (setq pt2 nil)
     
130.                 (command "text" pt hight angle new _str)
     
131.                 (setq asc _c nil)
     
132.               )
     
133.             )
     
134.             (next Pt)
     
135.             (setq len 1  a(1+n))
     
136.           );end progn
     
137.         );end if
     
138.          (setq n (1+n))
     
139.   )
     
140.   (princ)
     
141. )
     
142. ;;;-------------------------------------------------------------------------------
     
143. (defun next pt
     
144.   (last _ename last _elist pt1 dis)
     
145.   (if (=object "edit")
     
146.     (progn
     
147.       (setq last _ename (entlast)
     
148.              last _elist (entget last _ename)
     
149.             last _elist (subst (cons 8 layer)(assoc 8 last _elist) last _elist)
     
150.              last _elist (subst (cons 41 width)(assoc 41 last _elist)last _elist)
     
151.       )
     
152.       (entmod last _elist)
     
153.     )
     
154.   )
     
155.   (setq        last _ename(entlast)
     
156.          last_elist (entget last _ename)
     
157.         last _elist (subst (cons 72 2) (assoc 72 last _elist) last _elist)
     
158.          last_etist (subst (cons 11 pt) (assoc 11 last _elist) last_elist)
     
159.   )
     
160.   (entmod last _elist)
     
161.   (setq        last _ename (entlast)
     
162.                   last_elist (entget last _ename)
     
163.                      pt1 (cdr (assoc 10 last _elist))
     
164.                      dis (distance pt1 pt)
     
165.   )
     
166.   (setq        last _elist (subst (cons 72 0) (assoc 72 last _elist) last _elist)
     
167.          last_elist (subst (cons 10 pt) (assoc 10 last _elist) last _elist)
     
168.   )
     
169.   (entmod last _elist)
     
170.   (setq pt (polar pt ang (+ dis (* hight 0.2))))
     
171.   (if (= pt2 "up")
     
172.     (setq pt (polar pt (-ang (* pi 0.5)) (*hight 0.1)))
     
173.   )
     
174. )
     
175. ;;;---------------------END--------------------------------------
     
176.   [/FONT]
     

<br />   [FONT=courier new]<br /> ;;;ZXTEXT.LSP中西混排矢量文字输入及调整程序<br /> ;;;--------------------------------------------<br /> (defun c:zxtext        (/hight pt style chinese xx angle ang str)<br />   (setq os (getvar "osmode"))<br />   (setvar "osmode" 0)<br />   (initget "Edit")<br />   (setq pt (getpoint "\nEdit <Start point:>"))<br />   (if (=pt "Edit")<br />     (zxedit)<br />     (progn<br />       (setq style (getvar "TEXTSTYLE"))<br />       (setq chinese (cdr (assoc 4 (tb1search "style" style))))<br />       (if (=chinese "")<br />         (progn)<br />         (prompt<br />           (strcat "\n当前的字型"style"中没有定义矢量汉字字体")<br />         )<br />         (princ))<br />       (progn<br />         (setq hight (getvar "TEXTSIZE"))<br />         (setq XX (getdist pt (strcat "\nHeight <" (rtos hight) ">:")))<br />         if<br />         XX<br />         (setq hight XX)<br />       )<br />       (setq angle (getangle "\nRotation angle <0>:"))<br />       (if (=angle nil)<br />         (setq angle 0)<br />       )<br />       (setq ang (/ (* angle pi) 180))<br />       (setq str (getstring 1 "\nText : "))<br />       (zxtext _a)<br />     )<br />   )<br /> )<br /> )<br /> (setvar "osmode" os)<br /> )<br /> ;;;---------------------------------------------------------------------------------<br /> (defun zxedit /object sset sslen nsset ename elist style layer selist chinese str hight width color pt ang angle)<br /> (setq object "edit"<br />       (setq sset (ai _ aselect))<br />        (if (null sset)<br />          (progn<br />            (princ "\n错误：没有选到文字。")<br />            (exit)<br />          )<br />        )<br />       (setq sslen (sslength sset)<br />             nsset (ssadd)<br />       )<br />        (if (>sslen 25)<br />          (princ "\n确认所选的图元--请稍候。")<br />        )<br />       (while (>sslen 0)<br />         (setq ename (ssname sset (setq sslen (1-sslen)))<br />               elist (entget ename)<br />         )<br />         (if (= (cdr (assoc 0 elist)) "TEXT")<br />           (progn<br />             (setq style          (cdr (assoc 7 elist))<br />                   selist  (tb1search "style" style)<br />                   chinese (cdr (assoc 4 selist))<br />             )<br />             (if        (/=chinese "")<br />               (ssadd ename nsset)<br />             )<br />           )<br />         )<br />       )<br />        (setq sslen (sslength nsset)<br />              sset  nsset<br />        )<br />       (while (>sslen 0)<br />         (setq ename (ssname sset (setq sslen (1-sslen)))<br />               elist (entget ename)<br />               str   (cdr (assoc 1 elist))<br />               style (cdr (assoc 7 elist))<br />               layer (cdr (assoc 8 elist))<br />               pt    (cdr (assoc 1O elist))<br />               hight (cdr (assoc 40 elist))<br />               width (cdr (assoc 41 elist))<br />               ang   (cdr (assoc 5O elist))<br />               color (cdr (assoc 62 elist))<br />               angle (/ (* ang 180) pi)<br />         )<br />         (command "_erase" ename "")<br />         (command "_style" style "" "0.0" "" "" "" "" "")<br />         (zxtext _a)<br />       )<br /> )<br /> ;;;-------------------------------------------------------------------------------------<br /> (defun zxtext _a (/n a len asc _a asc _b asc_c len new _str pt2<br /> )<br /> (setq n        1<br />       a        n<br />       len 1<br /> )<br /> (while (/= (substr str n 1) "")<br />   (setq        asc _a (ascii ((substr str n 1))<br />         asc _b (ascii (substr str (1+n) 1))<br />         )<br />          (if (=asc _c nil)(setq asc _c asc_a))<br />         (if (and (/=asc _b 0);非空<br />                  (or<br />                    (and (<asc _a 127) (<asc _b 127) (<asc _c 127));两者均为西文<br />                    (and (>asc _a 127) (>asc _b l27)) ;两者均为汉字<br />                    (and (>asc _a 127) (=asc _b 32)) ;汉字中空格<br />                    (and (=asc _a 32) (=asc _b 32)) ;空格<br />                    (and (=asc _a 32) (>asc _b 127) (>asc _c 127));汉字中空格<br />                  )<br />             )<br />           (setq len (1+ len))<br />           (progn<br />             (setq new str<br />                   (substr str a len)<br />             )<br />             (if        (< (ascii (substr new _str 1 1)) 127)<br />               (progn<br />                 (setq pt (polar pt (－ang (* pi 0.5)) (* hight 0.1)))<br />                 (setq pt 2 "up")<br />                 (command "text" pt (* hight 0.8) angle new _str)<br />                 (setq asc _c nil)<br />               )<br />               (progn<br />                 (setq pt2 nil)<br />                 (command "text" pt hight angle new _str)<br />                 (setq asc _c nil)<br />               )<br />             )<br />             (next Pt)<br />             (setq len 1  a(1+n))<br />           );end progn<br />         );end if<br />          (setq n (1+n))<br />   )<br />   (princ)<br /> )<br /> ;;;-------------------------------------------------------------------------------<br /> (defun next pt<br />   (last _ename last _elist pt1 dis)<br />   (if (=object "edit")<br />     (progn<br />       (setq last _ename (entlast)<br />              last _elist (entget last _ename)<br />             last _elist (subst (cons 8 layer)(assoc 8 last _elist) last _elist)<br />              last _elist (subst (cons 41 width)(assoc 41 last _elist)last _elist)<br />       )<br />       (entmod last _elist)<br />     )<br />   )<br />   (setq        last _ename(entlast)<br />          last_elist (entget last _ename)<br />         last _elist (subst (cons 72 2) (assoc 72 last _elist) last _elist)<br />          last_etist (subst (cons 11 pt) (assoc 11 last _elist) last_elist)<br />   )<br />   (entmod last _elist)<br />   (setq        last _ename (entlast)<br />                   last_elist (entget last _ename)<br />                      pt1 (cdr (assoc 10 last _elist))<br />                      dis (distance pt1 pt)<br />   )<br />   (setq        last _elist (subst (cons 72 0) (assoc 72 last _elist) last _elist)<br />          last_elist (subst (cons 10 pt) (assoc 10 last _elist) last _elist)<br />   )<br />   (entmod last _elist)<br />   (setq pt (polar pt ang (+ dis (* hight 0.2))))<br />   (if (= pt2 "up")<br />     (setq pt (polar pt (-ang (* pi 0.5)) (*hight 0.1)))<br />   )<br /> )<br /> ;;;---------------------END--------------------------------------<br />   [/FONT]<br />

请高手修正一下，使其能正常使用。

xtuiui

我最近在XdCad里下不了附件，能否传到我邮箱：xigeia@sohu.com

timnis

要把文字打断，要编辑就好麻烦了。

kingpanfeng

这个程序的功能其实类似晓东工具箱里的＂中西美化＂功能，希望高手把这个程序完善一下．

临时

呵呵，很受教育

zkj7421

我也常发现这一问题,同样字号的中文和字母,大小差很多.