社区 › AutoLISP/Visual LISP 编程技术 › 求“不存在的字体”批量替换程序lsp

wudechao 发表于 2020-8-15 01:43:08

；根据上面的更新一下，可以选择字体和判断字体是否存在。
(defun c:tt (/ *error* font_eng font_chn font_tru font_tru_name tst a b c d e err textstyles date1)
(vl-load-com)
(setvar "cmdecho" 0)
(command "undo" "be")
(defun *error* (msg)
(setvar "REGENMODE" 1)
)
(setvar "REGENMODE" 0)
(setq font_eng (getstring "英文替换为<tssdeng>:")
       font_chn (getstring "中文替换为<hztxt>:")
       font_tru (getstring "TrueType字体替换为<宋体>:")
)
(if (= "" font_eng)
(setq font_eng "tssdeng.shx")
(setq font_eng (strcat font_eng ".shx"))
)
(while (not (findfile font_eng))
(princ (strcat "\n未找到" font_eng))
(setq font_eng (getstring "，重新输入，英文替换为:"))
(setq font_eng (strcat font_eng ".shx"))
)
(if (= "" font_chn)
(setq font_chn "hztxt.shx")
(setq font_chn (strcat font_chn ".shx"))
)
(while (not (findfile font_chn))
(princ (strcat "\n未找到" font_chn))
(setq font_chn (getstring "，重新输入，中文替换为:"))
(setq font_chn (strcat font_chn ".shx"))
)
(if (= "" font_tru)
(setq font_tru "宋体")
)
(setq tst t)
(while tst
(cond
   ((= font_tru "宋体")
    (setq font_tru_name "simsun.ttc")
   )
   ((= font_tru "新宋体")
    (setq font_tru_name "simsun.ttc")
   )
   ((= font_tru "仿宋")
    (setq font_tru_name "simfang.ttf")
   )
   ((= font_tru "黑体")
    (setq font_tru_name "simhei.ttf")
   )
   ((= font_tru "楷体")
    (setq font_tru_name "simkai.ttf")
   )
   ((= font_tru "隶书")
    (setq font_tru_name "simli.ttf")
   )
   ((= font_tru "幼圆")
    (setq font_tru_name "simyou.ttf")
   )
   ((= font_tru "华文宋体")
    (setq font_tru_name "stsong.ttf")
   )
   ((= font_tru "华文仿宋")
    (setq font_tru_name "stfangso.ttf")
   )
   ((= font_tru "华文中宋")
    (setq font_tru_name "stzhongs.ttf")
   )
   (t
    (setq font_tru_name (strcat font_tru ".ttf"))
   )
)
(if (findfile (strcat (getenv "Windir") "\\\fonts\\" font_tru_name))
   (setq tst nil)
   (progn
    (princ (strcat "\n未找到" font_tru))
    (setq font_tru (getstring "，重新输入，TrueType字体替换为:"))
   )
)
)
(setq date1 (getvar "millisecs"))
(setq textstyles (vla-get-textstyles (vla-get-activedocument (vlax-get-acad-object))))
(vlax-for x textstyles (vla-getfont x 'a 'b 'c 'd 'e) (if (= a "")
                                                        (progn
                                                       (if (and
                                                              (not (findfile (vla-get-fontfile x)))
                                                              (not (findfile (strcat (vla-get-fontfile x) ".shx")))
                                                             )
                                                          (vla-put-fontfile x font_eng)
                                                       )
                                                       (if (and
                                                              (/= (vla-get-bigfontfile x) "")
                                                              (not (findfile (vla-get-bigfontfile x)))
                                                              (not (findfile (strcat (vla-get-bigfontfile x) ".shx")))
                                                             )
                                                          (vla-put-bigfontfile x font_chn)
                                                       )
                                                        )
                                                        (progn
                                                       (setq err (vl-catch-all-apply 'vla-setfont (list x a b c d e)))
                                                       (if (vl-catch-all-error-p err)
                                                          (vla-setfont x font_tru b c d e)
                                                       )
                                                        )
                                                     )
)
(setvar "REGENMODE" 1)
(command "regen")
(prompt (strcat "\n字体分别替换为：《" font_eng "，" font_chn "，" font_tru "》，耗时\"" (rtos (/ (- (getvar "millisecs") date1)
                                                                                                   1000.000
                                                                                                ) 2 3
                                                                                          ) "\"秒。"
       )
)
(command "undo" "e")
(setvar "cmdecho" 1)
(princ)
)

sctw 发表于 2020-8-15 22:15:31

wudechao 发表于 2020-8-15 01:43
；根据上面的更新一下，可以选择字体和判断字体是否存在。
(defun c:tt (/ *error* font_eng font_chn fon ...

如果把新增的：
(setq font_eng (getstring "英文替换为<tssdeng>:")
       font_chn (getstring "中文替换为<hztxt>:")
       font_tru (getstring "TrueType字体替换为<宋体>:")
这个形式，做成dcl对话框，通过选择现有的其它样式名来进行替换就更好了。比如
当发现有不存在的字体时，就弹出一个简洁的对话框，通过下拉菜单选择一种预先定义好的某个样式：cad字体样式和中文字体样式来进行默认替换。
就更完美了！！

江南十笑 发表于 2020-9-25 18:24:54

好贴留名                  

tranney 发表于 2020-9-25 21:22:07

留个记号

得瑟的猫 发表于 2020-12-1 16:08:26

楼主，你那个跳出对话框指定字体的功能实现了吗？

tigcat 发表于 2020-12-1 22:01:05

wudechao 发表于 2020-8-15 01:43
；根据上面的更新一下，可以选择字体和判断字体是否存在。
(defun c:tt (/ *error* font_eng font_chn fon ...

大侠，如果只要是有问题的字体我都改成tssdeng+hztxt改怎么修改了？

忙出一个未来 发表于 2021-3-22 16:07:50

调用(*push-error-using-command*)前无法从 *error* 调用(command)。
建议将(command)调用转换为(command-s)。

ccc230 发表于 2021-7-20 10:53:16

这个好！！！！！！！！！！！！！！

酷酷提 发表于 2022-4-13 17:31:46

wudechao 发表于 2020-8-15 01:43
；根据上面的更新一下，可以选择字体和判断字体是否存在。
(defun c:tt (/ *error* font_eng font_chn fon ...

错误: 输入中的点位置不正确
你好，请问一下提示这个是什么原因呢

ZYX2129 发表于 2022-12-3 19:59:36

太牛了，高人

查看完整版本: 求“不存在的字体”批量替换程序lsp