求修正字体统一程序
;;; ------------------------------------------------------------------;;;字体统一批处理工具
;;;
;;;原创 by 超越极至 || 修改 by wxh5330 QQ:102963688 10/07/21
;;;
;;; ------------------------------------------------------------------
;(alert
"本程序自动将图中所有文字样式的组合改为：
【Tssdeng.shx + Hztxt.shx】
采用以下字体的样式除外：
Simplex.shx、Complex.shx、宋体
黑体、楷体、新宋体、仿宋体
启动命令：tszt"
;)
(defun c:tszt ()
(vl-load-com)
(vl-load-all "Register")
(UseLimit)
(vlax-for for-item (vla-get-textstyles
(vla-get-activedocument
(vlax-get-acad-object)
)
)
(if (and
(not (wcmatch (vla-get-fontfile for-item) ;simplex.shx
"SIMPLEX.shx*"
)
)
(not (wcmatch (vla-get-fontfile for-item) ;complex.shx
"COMPLEX.shx*"
)
)
(not (wcmatch (vla-get-fontfile for-item) ;宋体
"SONGTI.shx*"
)
)
(not (wcmatch (vla-get-fontfile for-item) ;黑体
"SIMHEI.shx*"
)
)
(not (wcmatch (vla-get-fontfile for-item) ;楷体
"Arial.shx*"
)
)
(not (wcmatch (vla-get-fontfile for-item) ;新宋体
"NSimSun.shx*"
)
)
(not (wcmatch (vla-get-fontfile for-item) ;仿宋体
"SIMFANG.shx*"
)
)
)
(progn
(vla-put-fontfile for-item "tssdeng.shx")
(vla-put-bigfontfile for-item "hztxt.shx")
)
)
)
(vla-regen (vla-get-activedocument (vlax-get-acad-object))
1
)
(prin1)
(prompt
"\n*** 文字样式已统一修改为【Tssdeng.shx + Hztxt.shx】***\n"
)
(repeat 10 (command "PURGE" "a" "" "n"))
)
;;;超越极至 写于2009.10.19.10.21
此程序的问题是，运行后，所有字体都变成了探索者字体，而不能排除黑体，宋体那些，不知道该如果调整程序？请各位高手帮忙，谢谢
有可能是大小写的问题，判断之前先转换成大写试试，注意后面的字体名称也要全大写
比如
(wcmatch (strcase (vla-get-fontfile for-item)) "SIMPLEX.SHX*") lostbalance 发表于 2017-11-14 11:28
有可能是大小写的问题，判断之前先转换成大写试试，注意后面的字体名称也要全大写
比如
(wcmatch (strcas ...
不是这个的问题 按你的描述的，程序能运行修改，只不过不能排除，应该是if的判断逻辑出错了。我这边试了下，vla-get-fontfile返回的是全小写的字符串，你用带大写的字符串去wcmatch肯定是行不通的，大小写修正下应该没什么问题了。
另外，vla-get-fontfile返回的已经是完整字体名了，个人觉得没必要再用通配符*号了，万一碰上那种特殊名字的字体名还容易出错。 lostbalance 发表于 2017-11-15 09:20
按你的描述的，程序能运行修改，只不过不能排除，应该是if的判断逻辑出错了。我这边试了下，vla-get-fontfi ...
是的，不能排除，全部改成大写或者小写，都不行，还是不能排除 hdlyt11 发表于 2017-11-15 09:39
是的，不能排除，全部改成大写或者小写，都不行，还是不能排除
这个是我测试的
========================
(vlax-for for-item (vla-get-TextStyles (vla-get-ActiveDocument (vlax-get-acad-object)))
(if (and
(not (wcmatch (setq a (vla-get-fontfile for-item)) "ldie.shx"))
(not (wcmatch (setq a (vla-get-fontfile for-item)) "romans.shx"))
(not (wcmatch (setq a (vla-get-fontfile for-item)) "complex.shx"))
)
(progn
(princ "\na=")
(princ a)
(princ "\nok")
)
(progn
(princ "\na=")
(princ a)
(princ "\nfalse")
)
)
)
返回如下:
a=ldie.shx
false
a=romans.shx
false
a=romand.shx
ok
========================
看着没问题了啊
顶个贴，黑体、宋体在C:\Windows\Fonts文件夹。attach://125934.png是否和这个有关系？ Mark一下，我也找一个除黑体以外其他字体一键替换为某个字体的代码。
页:
[1]