[求助]中西混排矢量文字字高调整程序
本帖最后由 作者 于 2007-11-3 12:38:48 编辑这是一个能够调整中西混排时中文和西文字高看起来不一样高的程序，是从一篇论文上整理下来的，整理完后不知道哪里有问题不能使用，请高手帮忙看一下，看看哪里有问题，修正一下这个lisp程序。（该论文详见附件）
作者的思路是当中西文混排又是采用矢量字体时让汉字和西文分开，要么放大汉字要么缩小西文。该程序考虑到了截断语句和改变字高带来的位置变化，除了破坏了语句的整体性外，表面上几乎是天衣无缝的 从原理上讲确实非常原始，但还算实用方便。
程序如下：;;;ZXTEXT.LSP中西混排矢量文字输入及调整程序
;;;--------------------------------------------
(defun c:zxtext (/hight pt style chinese xx angle ang str)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(initget "Edit")
(setq pt (getpoint "\nEdit "))
(if (=pt "Edit")
(zxedit)
(progn
(setq style (getvar "TEXTSTYLE"))
(setq chinese (cdr (assoc 4 (tb1search "style" style))))
(if (=chinese "")
(progn)
(prompt
(strcat "\n当前的字型"style"中没有定义矢量汉字字体")
)
(princ))
(progn
(setq hight (getvar "TEXTSIZE"))
(setq XX (getdist pt (strcat "\nHeight <" (rtos hight) ">:")))
if
XX
(setq hight XX)
)
(setq angle (getangle "\nRotation angle <0>:"))
(if (=angle nil)
(setq angle 0)
)
(setq ang (/ (* angle pi) 180))
(setq str (getstring 1 "\nText : "))
(zxtext _a)
)
)
)
)
(setvar "osmode" os)
)
;;;---------------------------------------------------------------------------------
(defun zxedit /object sset sslen nsset ename elist style layer selist chinese str hight width color pt ang angle)
(setq object "edit"
(setq sset (ai _ aselect))
(if (null sset)
(progn
(princ "\n错误：没有选到文字。")
(exit)
)
)
(setq sslen (sslength sset)
nsset (ssadd)
)
(if (>sslen 25)
(princ "\n确认所选的图元--请稍候。")
)
(while (>sslen 0)
(setq ename (ssname sset (setq sslen (1-sslen)))
elist (entget ename)
)
(if (= (cdr (assoc 0 elist)) "TEXT")
(progn
(setq style (cdr (assoc 7 elist))
selist(tb1search "style" style)
chinese (cdr (assoc 4 selist))
)
(if (/=chinese "")
(ssadd ename nsset)
)
)
)
)
(setq sslen (sslength nsset)
ssetnsset
)
(while (>sslen 0)
(setq ename (ssname sset (setq sslen (1-sslen)))
elist (entget ename)
str (cdr (assoc 1 elist))
style (cdr (assoc 7 elist))
layer (cdr (assoc 8 elist))
pt (cdr (assoc 1O elist))
hight (cdr (assoc 40 elist))
width (cdr (assoc 41 elist))
ang (cdr (assoc 5O elist))
color (cdr (assoc 62 elist))
angle (/ (* ang 180) pi)
)
(command "_erase" ename "")
(command "_style" style "" "0.0" "" "" "" "" "")
(zxtext _a)
)
)
;;;-------------------------------------------------------------------------------------
(defun zxtext _a (/n a len asc _a asc _b asc_c len new _str pt2
)
(setq n 1
a n
len 1
)
(while (/= (substr str n 1) "")
(setq asc _a (ascii ((substr str n 1))
asc _b (ascii (substr str (1+n) 1))
)
(if (=asc _c nil)(setq asc _c asc_a))
(if (and (/=asc _b 0);非空
(or
(and (asc _a 127) (>asc _b l27)) ;两者均为汉字
(and (>asc _a 127) (=asc _b 32)) ;汉字中空格
(and (=asc _a 32) (=asc _b 32)) ;空格
(and (=asc _a 32) (>asc _b 127) (>asc _c 127));汉字中空格
)
)
(setq len (1+ len))
(progn
(setq new str
(substr str a len)
)
(if (< (ascii (substr new _str 1 1)) 127)
(progn
(setq pt (polar pt (－ang (* pi 0.5)) (* hight 0.1)))
(setq pt 2 "up")
(command "text" pt (* hight 0.8) angle new _str)
(setq asc _c nil)
)
(progn
(setq pt2 nil)
(command "text" pt hight angle new _str)
(setq asc _c nil)
)
)
(next Pt)
(setq len 1a(1+n))
);end progn
);end if
(setq n (1+n))
)
(princ)
)
;;;-------------------------------------------------------------------------------
(defun next pt
(last _ename last _elist pt1 dis)
(if (=object "edit")
(progn
(setq last _ename (entlast)
last _elist (entget last _ename)
last _elist (subst (cons 8 layer)(assoc 8 last _elist) last _elist)
last _elist (subst (cons 41 width)(assoc 41 last _elist)last _elist)
)
(entmod last _elist)
)
)
(setq last _ename(entlast)
last_elist (entget last _ename)
last _elist (subst (cons 72 2) (assoc 72 last _elist) last _elist)
last_etist (subst (cons 11 pt) (assoc 11 last _elist) last_elist)
)
(entmod last _elist)
(setq last _ename (entlast)
last_elist (entget last _ename)
pt1 (cdr (assoc 10 last _elist))
dis (distance pt1 pt)
)
(setq last _elist (subst (cons 72 0) (assoc 72 last _elist) last _elist)
last_elist (subst (cons 10 pt) (assoc 10 last _elist) last _elist)
)
(entmod last _elist)
(setq pt (polar pt ang (+ dis (* hight 0.2))))
(if (= pt2 "up")
(setq pt (polar pt (-ang (* pi 0.5)) (*hight 0.1)))
)
)
;;;---------------------END--------------------------------------
请高手修正一下，使其能正常使用。
顶一顶，求解决问题
页:
[1]