adc 发表于 2011-5-13 14:24:56

将图中显示本机没有的字体替换

转贴
;;;将图中显示本机没有的字体替换为txt-m.shx,hztxt.shx
(defun c:hz( / lb_eng lb_chn lb_sech lb_tt1 lb_tt2 lb_a1 lb_a2 lb_hh)
(setvar "REGENMODE" 0)
(princ "\n")
(princ "\n将图中没有的字体替换")
(princ "\n")
(setq lb_eng (getstring "英文字体替换为<txt-m>:") lb_chn (getstring "中文字体替换为<hztxt>:"))
(if (= "" lb_eng)(setq lb_eng "txt-m"))
(if (= "" lb_chn)(setq lb_chn "hztxt"))
(setq lb_sech (tblnext "style" t))
(while lb_sech
    (setq lb_tt1 (cdr(assoc 3 lb_sech)) lb_tt2 (cdr(assoc 4 lb_sech)))
    (if (or (<= (strlen lb_tt1) 4)
            (/= "." (strcase(substr lb_tt1 (- (strlen lb_tt1) 3) 1)))      
      )
      (setq lb_tt1 (strcat lb_tt1 ".shx"))
    )
    (if (or (<= (strlen lb_tt2) 4)
            (/= "." (strcase(substr lb_tt2 (- (strlen lb_tt2) 3) 1)))
      )
      (if (/= "" lb_tt2)(setq lb_tt2 (strcat lb_tt2 ".shx")))
    )
    (if (/= ".TTF" (strcase(substr lb_tt1 (- (strlen lb_tt1) 3) 4)))
      (progn
      (if (null (findfile lb_tt1))(setq lb_a1 lb_eng)(setq lb_a1 lb_tt1))
      (if (= "" lb_tt2)
          (setq lb_a2 "")
          (if (null (findfile lb_tt2))(setq lb_a2 lb_chn)(setq lb_a2 lb_tt2))
      )
      (setq lb_hh (strcat lb_a1 "," lb_a2))
      (command "-style" (cdr(assoc 2 lb_sech)) lb_hh "" "" "" "" "" "")
      )
      (if (null (findfile lb_tt1))(command "-style" (cdr(assoc 2 lb_sech)) (strcat lb_eng "," lb_chn) "" "" "" "" "" ""))
    )
    (setq lb_sech (tblnext "style"))
)
(setvar "REGENMODE" 1)
(command "regen")
)

革天明 发表于 2012-11-30 18:02:33

顶一下楼主,回去仔细看看

howboo 发表于 2023-5-30 09:46:19

感谢达人分享,学习一下。
页: [1]
查看完整版本: 将图中显示本机没有的字体替换