干掉选择字体对话框，开图自动替换字体（2021.3.2增加c#版本）
本帖最后由 print1985 于 2022-5-17 10:24 编辑对不起各位，因最近发现本人发的个别插件、源码被人挂网上贩卖，虽然没啥技术含量，但是也是花了时间做的。为了不被后面的二手贩子继续利用，忍心下架所有成品插件，敬请理解，确实需要本插件的朋友可以给我留言。
请版主把本帖改为普通帖子，对不起了
开图不停的替换字体，囧 囧 囧受够了，干掉这个讨厌的对话框，自动替换未知字体
1、Lisp文件这里要修改为你想要的字体。
2、CAD菜单-工具-选项-系统-隐藏消息设置
3、勾选如下图
4、打开缺少字体的图纸，如图勾选“始终执行……”，后点击“忽略缺少的……”
搞定，以后开图不会出现选择字体对话框了，lisp程序会在开图后会自动替换未知字体。
主要源码来自http://bbs.mjtd.com/forum.php?mod=viewthread&tid=181963&extra=&highlight=%D7%D6%CC%E5%2B%CC%E6%BB%BB&page=1
我只作了简单修改，感谢gaics、sctw、wudechao等各位大侠
;手动替换字体，命令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)
----------------------------------c#版本-------------------------------------------
2021.3.2增加c#版本
源码来自 http://blog.sina.com.cn/s/blog_69e8fdf00100nc58.html版权归原作者所有，感谢！
本人修改了几处代码并重新编译以适应高版本CAD
使用方法：
1、将DLL文件设为自动加载（不会设的设置的可以参看我发的lisp+c#混合编程帖子的lisp代码）。
2、开图使用Hztxt.shx自动替换未知字体，所以你的CAD至少得有Hztxt.shx字体。
3、DLL可以单独使用，也可以和上面的lisp代码组合使用，当然如果要用DLL就不能干掉字体替换对话框了(干掉C#程序就没法自动选择字体了)，不干掉字体选择对话框lisp也是可以自动替换的。
原理：开图出现字体选择对话框时，自动选择Hztxt.shx字体替换未知字体（可以理解为模拟按键，代替手动选择）
学习了 谢谢分享！ 感谢楼主提供的程序！！！ 感谢楼主分享学习！！！ {:1_10:}{:1_10:} 6666666666,感谢分享 谢谢楼主分享 试试这个，只要电脑中安装了对应的ttf后缀格式字体 2021.3.2增加c#版本
不喜欢的lisp版本的可以试试C#版 谢谢分享{:1_1:}{:1_1:} 给yanchao316 win10测试用 2个版本 看下有能用的没得
print1985 发表于 2021-3-4 19:08
给yanchao316 win10测试用 2个版本 看下有能用的没得
多谢！测试了，ChangeFonts(CAD2012)已经能在win10下完美运行了。先前的2007～2012又试了，也能运行了。前两天不知道啥原因用不了。 调用(*push-error-using-command*)前无法从 *error* 调用(command)。
建议将(command)调用转换为(command-s) lijoicq1 发表于 2021-3-22 16:12
调用(*push-error-using-command*)前无法从 *error* 调用(command)。
建议将(command)调用转换为(command- ...
CAD高版本的问题，替换一下这段
(defun *error* (msg) ;错误处理
(setvar "regenmode" 1)
(command-s "undo" "e");高版本用command-s
(setvar "cmdecho" 1)
(princ msg)
)
页:
[1]
2