;如果不希望下次出现这个提示的话，使用lsp替换字体的方法，
;;自动替换并修改字体样式里面字体;;打开CAD，提示缺少字体，就使用这个命令，保存图纸，以后就不会提示
;;修改了一个bug，保证了字体的长度不变
(defun C:TT7 ( / &n1 &n2 &ss1 cd1 cd2 fontname txt txts txtstyle)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(if (null vlax-dump-object) (vl-load-com) )
(setq txts (vla-get-textstyles (vla-get-activedocument (vlax-get-acad-object))))
(setq &ss1 '())
(vlax-for txt txts
(setq &ss1 (cons (vla-get-name txt) &ss1))
);取得文字样式集合
(while (setq txt (car &ss1))
(setq &ss1 (cdr &ss1) TxtStyle (vla-Item txts txt))
(if (/= (setq fontname (vla-get-fontfile txtStyle)) "");1;得到字体名称
(progn;;1
(if (null (setq &n2 (findfile fontname)));2;先搜索CAD里面的字体
(setq &n2 (findfile (strcat "C:\\WINDOWS\\Fonts\\" fontname)));搜索不到的话，搜索系统里面的字体
);if;2;搜索字体
(if (= &n2 nil);21;如果都没有这个字体就修改字体样式
(progn
(setq &n1 (vla-get-width TxtStyle));取得宽度因子
(setq cd1 (caadr (textbox (list '(0 . "TEXT") (cons 1 "文字长度") '(40 . 200) (cons 41 &n1) (cons 7 txt) '(51 . 0)))));取得文字长度
(vla-put-fontfile TxtStyle "tssdeng.shx");字体修改为tssdeng.shx,这个字体要保证字体库里面有;或者修改为其它字体
(setq cd2 (caadr (textbox (list '(0 . "TEXT") (cons 1 "文字长度") '(40 . 200) (cons 41 &n1) (cons 7 txt) '(51 . 0)))));取得修改后的文字长度
(setq &n1 (* &n1 (/ cd1 cd2)))
(vla-put-width TxtStyle &n1);修改宽度因子,保持文字长度不变
);progn;21
);if;21
);progn;1
);if;1
(if (/= (setq fontname (vla-get-bigfontfile TxtStyle)) "");3;得到大字体的名称
(progn;;3
(if (null (setq &n2 (findfile fontname)));搜索大字体
(setq &n2 (findfile (strcat "C:\\WINDOWS\\Fonts\\" fontname)));如果没有就搜索系统里面的字体
);搜索字体
(if (= &n2 nil);31;如果没有找到这个字体
(progn
(setq &n1 (vla-get-width TxtStyle));取得宽度因子
(setq cd1 (caadr (textbox (list '(0 . "TEXT") (cons 1 "文字长度") '(40 . 200) (cons 41 &n1) (cons 7 txt) '(51 . 0)))));取得文字长度
(vla-put-bigfontfile TxtStyle "hztxt.shx");修改大字体为hztxt.shx,同时要保证CAD字体库里面有这个字体;或者修改为其它字体
(setq cd2 (caadr (textbox (list '(0 . "TEXT") (cons 1 "文字长度") '(40 . 200) (cons 41 &n1) (cons 7 txt) '(51 . 0)))));取得修改后的文字长度
(setq &n1 (* &n1 (/ cd1 cd2)))
(vla-put-width TxtStyle &n1);修改宽度因子,保持文字长度不变
);progn;31
);if;31
);progn;3
);if;3
);while
(if (/= &n1 nil) (command "REGEN"));刷新图元
(princ)
);必须有tssdeng.shx，hztxt.shx两个字体，如果没有会出现错误
;复制到记事本，以【.lsp】为后缀命名，autolisp加载，命令【TT7】，点击保存dwg文件就可以。下次打开就不会提示，因为修改了字体。
关闭CAD重新打开
内容全部来源于网络收集，如有侵权，请联系网站删除：QQ：24596024