干掉选择字体对话框，开图自动替换字体（2021.3.2增加c#版本）

hzyhzjjzh

感谢楼主分享

江湖摸客

跟acad.fmp作用一样吗？
如果没有能匹配这种字体形文件，也能正确显示吗？

Noangler

学习了，有用的。

天凉好个秋

afrgrgfdgdgt111 发表于 2021-3-2 08:57
好了  谢谢大佬

请问方便上传一份吗？我复制删除后还是不行。。麻烦了

popsun

感谢分享，标记学习！

afrgrgfdgdgt111

天凉好个秋 发表于 2023-3-30 15:59
请问方便上传一份吗？我复制删除后还是不行。。麻烦了

你不能点击复制代码  你得框选复制才能用

guankuiwu

学习了！多谢分享！

天凉好个秋

afrgrgfdgdgt111 发表于 2023-4-3 14:58
你不能点击复制代码  你得框选复制才能用

你好，我把浏览代码点开，复制。还是出现错误: 函数错误: "MOKACAD<a href="，如果方便的话，能不能发我一个，感谢。

afrgrgfdgdgt111

天凉好个秋 发表于 2023-4-7 08:35
你好，我把浏览代码点开，复制。还是出现错误: 函数错误: "MOKACAD

;手动替换字体，命令tzt
(defun c:tzt() (GL:changefont))

;替换字体
(defun GL:changefont ( / *error* a b c d date1 e err font_chn font_eng font_lst_chn font_lst_eng font_lst_tru font_tru textstyles x)
(setq font_eng "tssdeng.shx"  ;tssdeng.shx英文字体，自行修改
      font_chn "tssdchn.shx"  ;tssdchn.shx中文字体，自行修改
      font_tru "宋体"         ;windows系统字体，自行修改
      font_lst_eng '()
      font_lst_chn '()
      font_lst_tru '()
)

(defun *error* (msg) ;错误处理
  (setvar "regenmode" 1)
  (command "undo" "e")
  (setvar "cmdecho" 1)
  (princ msg)
)

(vl-load-com)
(setvar "cmdecho" 0)
(command "undo" "be")
(setvar "regenmode" 0)
(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")))
                                                             )
                                                         (progn
                                                          (vla-put-fontfile x font_eng)
                                                          (setq font_lst_eng (cons (vla-get-name x) font_lst_eng))
                                                         )
                                                         )
                                                         (if (and
                                                              (/= (vla-get-bigfontfile x) "")
                                                              (not (findfile (vla-get-bigfontfile x)))
                                                              (not (findfile (strcat (vla-get-bigfontfile x) ".shx")))
                                                             )
                                                         (progn
                                                          (vla-put-bigfontfile x font_chn)
                                                          (setq font_lst_chn (cons (vla-get-name x) font_lst_chn))
                                                         )
                                                         )
                                                        )
                                                        (progn
                                                         (setq err (vl-catch-all-apply 'vla-setfont (list x a b c d e)))
                                                         (if (vl-catch-all-error-p err)
                                                         (progn
                                                          (vla-setfont x font_tru b c d e)
                                                          (setq font_lst_tru (cons (vla-get-name x) font_lst_tru))
                                                         )
                                                         )
                                                        )
                                                       )
)
(setvar "regenmode" 1)
(command "regen")
(princ "\n")
(if (or font_lst_eng font_lst_chn font_lst_tru)
(progn
  (princ (strcat "字体替换完成，共耗时" (rtos (/ (- (getvar "millisecs") date1)1000.000) 2 3) "秒。  "))
  (if font_lst_eng (progn (princ "文字样式：")(princ font_lst_eng)(princ (strcat "的英文字体已替换为" font_eng "。  "))))
  (if font_lst_chn (progn (princ "文字样式：")(princ font_lst_chn)(princ (strcat "的中文字体已替换为" font_chn "。  "))))
  (if font_lst_tru (progn (princ "文字样式：")(princ font_lst_tru)(princ (strcat "的字体已替换为" font_tru "。  "))))
)
(princ "\n所有字体均存在，未替换")
)
(command "undo" "e")
(setvar "cmdecho" 1)
(princ)
)

;开图自动替换字体
(GL:changefont)

tanshun_ysjkd

JG_ASURA 发表于 2022-4-25 17:14
lsp加载提示：错误: 输入中含有多余的闭括号
win10专业版+CAD2020

utf8编码有这个错误，我刚试转为ANSI编码成功了