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

jinpanfeng

;; ZXTEXT.LSP 中西混排矢量文字输入及调整程序  CYN 2000.6.15

;=============================================================================
(defun c:zxtext(/ os hight pt style chinese xx ang_cyn ang str)
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
    (initget "Edit")
    (setq pt (getpoint "\nEdit <Start point:>"))
      (if (= pt "Edit")
        (zxedit)
        (progn         
          (setq style (getvar "TEXTSTYLE"))
          (setq chinese (cdr (assoc 4 (tblsearch "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 ang_cyn (getangle "\nRotation angle <0>:"))
               (if (= ang_cyn nil) (setq ang_cyn 0))
              (setq ang (/ (* ang_cyn 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 ang_cyn)
  (setq object "edit")
  (setq sset (ssget))
  (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 (tblsearch "style" style)
            chinese (cdr (assoc 4 selist))
        )
        (if (/= chinese "") (ssadd ename nsset))
      )
    )
  )

  (setq sslen (sslength nsset)
        sset nsset
  )
  (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 10 elist))
          hight (cdr (assoc 40 elist))
          width (cdr (assoc 41 elist))
            ang (cdr (assoc 50 elist))
          color (cdr (assoc 62 elist))
          ang_cyn (/ (* 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 2) "")
      (setq asc_a (ascii (substr str n 2))
            asc_b (ascii (substr str (1+ n) 2))
      )
      (if (= asc_c nil) (setq asc_c asc_a))
      (if (and (/= asc_b 0 )  ;非空
             (or
               (and (< asc_a 127) (< asc_b 127) (< asc_c 127)) ;两者均为西文
               (and (> asc_a 127) (> asc_b 127))               ;两者均为汉字
               (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 2)) 127)
             (progn
               (setq pt (polar pt (+ ang (* pi 0.5)) (* hight 0.1)))
               (setq pt2 "up")            
               (command "text" pt (* hight 0.8) ang_cyn new_str)
               (setq asc_c nil)
             )
             (progn
               (setq pt2 nil)
               (command "text" pt hight ang_cyn new_str)
               (setq asc_c nil)
             )
           )
           (next_pt)
           (setq len 1   a (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_elist (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 ======================================

chengzhang

其实没有必要，楼主完全可以采用合适的字体文件就可以非常好的解决此问题。

userzhl

有这个功能挺好的。