求修正字体统一程序

hdlyt11

;;; ------------------------------------------------------------------
;;;  字体统一批处理工具
;;;
;;;  原创 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
此程序的问题是，运行后，所有字体都变成了探索者字体，而不能排除黑体，宋体那些，不知道该如果调整程序？请各位高手帮忙，谢谢

lostbalance

有可能是大小写的问题，判断之前先转换成大写试试，注意后面的字体名称也要全大写
比如
(wcmatch (strcase (vla-get-fontfile for-item)) "SIMPLEX.SHX*")

hdlyt11

lostbalance 发表于 2017-11-14 11:28
有可能是大小写的问题，判断之前先转换成大写试试，注意后面的字体名称也要全大写
比如
(wcmatch (strcas ...

不是这个的问题

lostbalance

按你的描述的，程序能运行修改，只不过不能排除，应该是if的判断逻辑出错了。我这边试了下，vla-get-fontfile返回的是全小写的字符串，你用带大写的字符串去wcmatch肯定是行不通的，大小写修正下应该没什么问题了。
另外，vla-get-fontfile返回的已经是完整字体名了，个人觉得没必要再用通配符*号了，万一碰上那种特殊名字的字体名还容易出错。

hdlyt11

lostbalance 发表于 2017-11-15 09:20
按你的描述的，程序能运行修改，只不过不能排除，应该是if的判断逻辑出错了。我这边试了下，vla-get-fontfi ...

是的，不能排除，全部改成大写或者小写，都不行，还是不能排除

lostbalance

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文件夹。http://bbs.mjtd.com/forum.php?mod=attachment&aid=MTI1OTM0fDc5YTYxYzg1MTUyZGQ0ODI5OWViNmQ4NjBlMWZkOTIzfDE3MzE3NTQyNjY%3D&request=yes&_f=.png是否和这个有关系？

howboo

Mark一下，我也找一个除黑体以外其他字体一键替换为某个字体的代码。