本帖最后由 gaics 于 2020-8-12 08:36 编辑
(defun c:tt (/ name D en zt3 zt4 a b c d e f g err)
(setvar "cmdecho" 0)
(while (setq D (tblnext "style" (null D)))
(setq name (cdr (assoc 2 D)))
;;;;(alert name)
(setq zt3 (cdr (assoc 3 D)))
(setq zt4 (cdr (assoc 4 D)))
(if (/= zt3 "")
(cond
((or (= (vl-filename-extension zt3) ".shx")
(= (vl-filename-extension zt3) ".SHX")
)
(if (not (findfile zt3))
(setq zt3 "hzasc.shx"
a t
)
)
)
((null (vl-filename-extension zt3))
(if
(findfile (strcat zt3 ".shx"))
(setq zt3 (strcat zt3 ".shx")
a t
)
(setq zt3 "hzasc.shx"
a t
)
)
)
((if
(not (findfile (strcat (getenv "windir") "\\fonts\\" zt3)))
(setq zt3 "simkai.ttf"
b t
)
)
)
)
(progn
(setq en (vlax-ename->vla-object (tblobjname "style" name)))
(vla-getfont en 'c 'd 'e 'f 'g)
(setq
err (vl-catch-all-apply 'vla-setfont (list en c d e f g))
)
(if (vl-catch-all-error-p err)
(vla-setfont en "楷体" d e f g)
)
)
)
(if (/= zt4 "")
(if (vl-filename-extension zt4)
(if (not (findfile zt4))
(setq zt4 "hztxt.shx"
a t
)
)
(if (findfile (strcat zt4 ".shx"))
(setq zt4 (strcat zt4 ".shx")
a t
)
(setq zt4 "hztxt.shx"
a t
)
)
)
)
(if a
(command "-style" name (strcat zt3 "," zt4) "" "" "" "" "" "")
)
(if b
(command "-style" name zt3 "" "" "" "" "")
)
(setq a nil b nil)
)
(princ)
)
重新写了一下，感觉这版问题少一些。但是对外部参照缺失的字体会出错。
sctw 发表于 2020-8-11 15:19
这跟用wcmatch有什么区别呢
没有后缀名的情况(vl-filename-extension zt3)返回“nil”，对于wcmatch是无效参数。
gaics 发表于 2020-8-11 17:27
重新写了一下，感觉这版问题少一些。但是对外部参照缺失的字体会出错。
这个版本不能运行成功，每个字体样式都会弹出提示框，命令行也对应提示：字体文件不存在
我另外想了一个思路，用style命令里能看到的中文字体名来判断是否为windows字体，否则为CAD字体。
(setvar "textstyle" name) ;把字体样式设置为当前样式
(setq acadObj (vlax-get-acad-object))
(setq doc (vla-get-ActiveDocument acadObj))
(vla-GetFont (vla-get-ActiveTextStyle doc) 'typeFace 'Bold 'Italic 'charSet 'PitchandFamily)
(if (= "" typeFace) ;中文字体为空，则属于CAD字体，这样更方便些。
对于有的样式名含有非法字符的，如：* ： ； \ / ? "等再用wcmatch来判断
(if (or (= "" name) ；如果字体样式名为空
(wcmatch name "*[*]*,*[\\]*,*[/]*,*[?]*,*[`]*,*[<]*,*[>]*,*[:]*,*[;]*,*[|]*,*[,]*,*[=]*,*[\"]*") ；或者字体样式名为非法字符
) ;判断字体样式名里含有非法字符
(princ(strcat "\n 发现文字样式名<" name ">中含有非法字符，不能处理该样式字体!!!"))
本帖最后由 gaics 于 2020-8-12 08:23 编辑
sctw 发表于 2020-8-11 23:59
我另外想了一个思路，用style命令里能看到的中文字体名来判断是否为windows字体，否则为CAD字体。
...
你可以按你的思路尝试写一下
前面那个提示框可以把(alert name)这句删除。字体不存在就把“楷体”换一个你的系统里有的字体。
本帖最后由 gaics 于 2020-8-12 19:20 编辑
(defun c:tt (/ a b c d e err)
(vl-load-com)
(setvar "cmdecho" 0)
(command "undo" "be")
(vlax-for x (vla-get-textstyles
(vla-get-activedocument (vlax-get-acad-object))
)
(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 "hzasc.shx")
)
(if
(and (/= (vla-get-bigfontfile x) "")
(not (findfile (vla-get-bigfontfile x)))
(not (findfile (strcat (vla-get-bigfontfile x) ".shx")))
)
(vla-put-bigfontfile x "hztxt.shx")
)
)
(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 "仿宋" b c d e)
)
)
)
)
(command "undo" "e")
(princ)
)
我现在测试比较完美了，外部参照也没有问题。判断非法字符感觉没有必要，外部参照的字体样式名称是包含“|”的，代码可以运行。
本帖最后由 magicheno 于 2020-8-12 17:44 编辑
gaics 发表于 2020-8-12 15:15
我现在测试比较完美了，外部参照也没有问题。判断非法字符感觉没有必要，外部参照的字体样式名称是包含“ ...
大爱，非常好用，一直想找这样的功能，非常喜欢，感谢大侠
gaics 发表于 2020-8-12 15:15
我现在测试比较完美了，外部参照也没有问题。判断非法字符感觉没有必要，外部参照的字体样式名称是包含“ ...
测试了，非常好，还有一个小疑问：
(vla-setfont x "仿宋" b c d e)；这一句中的“仿宋”我改成其它（比如楷体等）没有作用，都是用FangSong_GB2312.ttf来替换，不知为什么？
楷体可以啊，我最早就是用楷体测试的。什么系统？多少位？
sctw 发表于 2020-8-12 22:38
测试了，非常好，还有一个小疑问：
(vla-setfont x "仿宋" b c d e)；这一句中的“仿宋”我改成 ...
是我自已搞错了，是可以变化的:lol