求“不存在的字体”批量替换程序lsp

gaics · 发表于 2020-8-11 17:27:05

本帖最后由 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)
)

(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) 
)

重新写了一下，感觉这版问题少一些。但是对外部参照缺失的字体会出错。

gaics · 发表于 2020-8-11 17:28:26

sctw 发表于 2020-8-11 15:19
这跟用wcmatch有什么区别呢

没有后缀名的情况(vl-filename-extension zt3)返回“nil”，对于wcmatch是无效参数。

sctw · 发表于 2020-8-11 23:48:02

gaics 发表于 2020-8-11 17:27
重新写了一下，感觉这版问题少一些。但是对外部参照缺失的字体会出错。

这个版本不能运行成功，每个字体样式都会弹出提示框，命令行也对应提示：字体文件不存在

sctw · 发表于 2020-8-11 23:59:51

我另外想了一个思路，用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:13:43

本帖最后由 gaics 于 2020-8-12 08:23 编辑

sctw 发表于 2020-8-11 23:59
我另外想了一个思路，用style命令里能看到的中文字体名来判断是否为windows字体，否则为CAD字体。
...

你可以按你的思路尝试写一下

前面那个提示框可以把(alert name)这句删除。字体不存在就把“楷体”换一个你的系统里有的字体。

gaics · 发表于 2020-8-12 15:15:05

本帖最后由 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)
)

(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:36:46

本帖最后由 magicheno 于 2020-8-12 17:44 编辑

gaics 发表于 2020-8-12 15:15
我现在测试比较完美了，外部参照也没有问题。判断非法字符感觉没有必要，外部参照的字体样式名称是包含“ ...

大爱，非常好用，一直想找这样的功能，非常喜欢，感谢大侠

sctw · 发表于 2020-8-12 22:38:23

gaics 发表于 2020-8-12 15:15
我现在测试比较完美了，外部参照也没有问题。判断非法字符感觉没有必要，外部参照的字体样式名称是包含“ ...

测试了，非常好，还有一个小疑问：
(vla-setfont x "仿宋" b c d e)；这一句中的“仿宋”我改成其它（比如楷体等）没有作用，都是用FangSong_GB2312.ttf来替换，不知为什么？

gaics · 发表于 2020-8-12 22:40:47

楷体可以啊，我最早就是用楷体测试的。什么系统？多少位？

sctw · 发表于 2020-8-12 22:51:19

sctw 发表于 2020-8-12 22:38
测试了，非常好，还有一个小疑问：
(vla-setfont x "仿宋" b c d e)；这一句中的“仿宋”我改成 ...

是我自已搞错了，是可以变化的

账号		自动登录	找回密码
密码			注册

[提问] 求“不存在的字体”批量替换程序lsp

本帖子中包含更多资源

评分