【K:StyleNonBoldSong】非黑宋规整

kucha007

最早是根据文字样式名称修改，见此贴：http://bbs.mjtd.com/thread-186303-1-1.html

现在是获取文字样式的字体名称，如果不是黑体宋体或形字体(ltypeshp.shx)，就规整为设置的标准字体。

2. ;如果不成功则抓取错误，如果成功就执行程序
   
3. (defun K:CatchApply (fun args / result)
   
4.   (if
   
5.     (not
   
6.       (vl-catch-all-error-p
   
7.         (setq result (vl-catch-all-apply
   
8.                       (if (= 'SYM (type fun)) fun (function fun))
   
9.                       args
   
10.                     )
    
11.         )
    
12.       )
    
13.     )
    
14.     result
    
15.   )
    
16. )

;如果不成功则抓取错误，如果成功就执行程序<br /> (defun K:CatchApply (fun args / result) <br />   (if <br />     (not <br />       (vl-catch-all-error-p <br />         (setq result (vl-catch-all-apply <br />                       (if (= 'SYM (type fun)) fun (function fun))<br />                       args<br />                     )<br />         )<br />       )<br />     )<br />     result<br />   )<br /> )

函数部分：

2. ;(字体)非黑宋规整为标准字体
   
3. (defun K:StyleNonBoldSong (FNam BFNam Width / TmpDoc obj FindFlag TypeFace Bold Italic Charset PitchandFamily)
   
4.   (setq TmpDoc (vla-get-activedocument (vlax-get-acad-object)))
   
5.   (vlax-for obj (vla-get-textstyles TmpDoc)
   
6.       (if
   
7.         (and
   
8.             (not (vl-string-search "|" (vla-get-Name obj)))
   
9.             (not (vl-string-search "$" (vla-get-Name obj)))
   
10.         );排除外部参照的字体样式
    
11.         (progn
    
12.           (setq FindFlag Nil)
    
13.           (K:CatchApply 'vla-Getfont (list obj 'TypeFace 'Bold 'Italic 'Charset 'PitchandFamily))
    
14.           (if (eq TypeFace "")
    
15.               (if (/= (vla-get-fontfile obj)  "ltypeshp.shx");线型形文件
    
16.                   (setq FindFlag T)
    
17.               )
    
18.               (if (not (wcmatch (strcase TypeFace) "**宋**,**FANGSONG**,**黑体**,**SIMHEI**"))
    
19.                 (setq FindFlag T)
    
20.               )
    
21.           )
    
22.           (if FindFlag
    
23.               (progn
    
24.                 (K:CatchApply 'vla-setfont (list obj FNam "false" "false" 1 0));TTF
    
25.                 (K:CatchApply 'vla-put-fontfile (list obj FNam));SHX
    
26.                 (K:CatchApply 'vla-put-bigfontfile (list obj BFNam));大字体
    
27.                 (K:CatchApply 'vla-put-width (list obj Width));宽度因子
    
28.               )
    
29.           )
    
30.         )
    
31.       )
    
32.   )
    
33.   (princ)
    
34. )

;(字体)非黑宋规整为标准字体<br /> (defun K:StyleNonBoldSong (FNam BFNam Width / TmpDoc obj FindFlag TypeFace Bold Italic Charset PitchandFamily)<br />   (setq TmpDoc (vla-get-activedocument (vlax-get-acad-object)))<br />   (vlax-for obj (vla-get-textstyles TmpDoc)<br />       (if <br />         (and <br />             (not (vl-string-search "|" (vla-get-Name obj)))<br />             (not (vl-string-search "$" (vla-get-Name obj)))<br />         );排除外部参照的字体样式<br />         (progn<br />           (setq FindFlag Nil)<br />           (K:CatchApply 'vla-Getfont (list obj 'TypeFace 'Bold 'Italic 'Charset 'PitchandFamily))<br />           (if (eq TypeFace "")<br />               (if (/= (vla-get-fontfile obj)  "ltypeshp.shx");线型形文件<br />                   (setq FindFlag T)<br />               )<br />               (if (not (wcmatch (strcase TypeFace) "**宋**,**FANGSONG**,**黑体**,**SIMHEI**"))<br />                 (setq FindFlag T)<br />               )<br />           )<br />           (if FindFlag<br />               (progn<br />                 (K:CatchApply 'vla-setfont (list obj FNam "false" "false" 1 0));TTF<br />                 (K:CatchApply 'vla-put-fontfile (list obj FNam));SHX<br />                 (K:CatchApply 'vla-put-bigfontfile (list obj BFNam));大字体<br />                 (K:CatchApply 'vla-put-width (list obj Width));宽度因子<br />               )<br />           )<br />         )<br />       )<br />   )<br />   (princ)<br /> )

用法：

1. (K:StyleNonBoldSong "仿宋_GB2312" nil 0.8);TTF
   
2. (K:StyleNonBoldSong "txt" nil 0.8);SHX：不使用大字体
   
3. (K:StyleNonBoldSong "gbenor" "gbcbig" 0.8);SHX：使用大字体
   

(K:StyleNonBoldSong "仿宋_GB2312" nil 0.8);TTF<br /> (K:StyleNonBoldSong "txt" nil 0.8);SHX：不使用大字体<br /> (K:StyleNonBoldSong "gbenor" "gbcbig" 0.8);SHX：使用大字体<br />

其它：
;获取TTF字体名称

1. (vla-Getfont obj 'TypeFace 'Bold 'Italic 'Charset 'PitchandFamily)
   
2. (princ TypeFace)

复制代码

;打印所有字体样式名称

2. (defun C:TT ()
   
3.     (vlax-for TS (vla-get-textstyles (vla-get-activedocument (vlax-get-acad-object)))
   
4.         (princ (strcat "\n" (vla-get-Name TS)))
   
5.     )(princ)
   
6. )

(defun C:TT ()<br />     (vlax-for TS (vla-get-textstyles (vla-get-activedocument (vlax-get-acad-object)))<br />         (princ (strcat "\n" (vla-get-Name TS)))<br />     )(princ)<br /> )

;打印非外部参照的字体样式名称

2. (defun C:TT ()
   
3.     (vlax-for TS (vla-get-textstyles (vla-get-activedocument (vlax-get-acad-object)))
   
4.         (if (not (vl-string-search "|" (vla-get-Name TS)))
   
5.              (princ (strcat "\n" (vla-get-Name TS)))
   
6.         )
   
7.     )(princ)
   
8. )

(defun C:TT ()<br />     (vlax-for TS (vla-get-textstyles (vla-get-activedocument (vlax-get-acad-object)))<br />         (if (not (vl-string-search "|" (vla-get-Name TS)))<br />              (princ (strcat "\n" (vla-get-Name TS)))<br />         )<br />     )(princ)<br /> )

;打印非外部参照的字体样式所使用的字体名称

2. (vlax-for TS (vla-get-textstyles (vla-get-activedocument (vlax-get-acad-object)))
   
3.     (if (not (vl-string-search "|" (vla-get-Name TS)));排除外部参照
   
4.           (progn
   
5.           (setq FontNam (vla-get-fontfile (vlax-ename->vla-object (tblobjname "style" (vla-get-Name TS)))))
   
6.           (princ (strcat "\n" FontNam))
   
7.         )
   
8.     )
   
9. )(princ)

(vlax-for TS (vla-get-textstyles (vla-get-activedocument (vlax-get-acad-object)))<br />     (if (not (vl-string-search "|" (vla-get-Name TS)));排除外部参照<br />           (progn<br />           (setq FontNam (vla-get-fontfile (vlax-ename->vla-object (tblobjname "style" (vla-get-Name TS)))))<br />           (princ (strcat "\n" FontNam))<br />         )<br />     )<br /> )(princ)

panliang9

谢谢楼主分享！

中国梦

谢谢楼主分享！

w379106181

谢谢楼主分享！

bai2000

好像哪里有点问题？不能过滤黑体（包括：黑体.ttf   simhei.ttf)

kucha007

bai2000 发表于 2022-11-18 20:10
好像哪里有点问题？不能过滤黑体（包括：黑体.ttf   simhei.ttf)

我没问题唉，麻烦提供处理失败的文件看看哈

LIULISHENG

谢谢楼主分享！

jackAqwq

提示参数过多誒

kucha007

jackAqwq 发表于 2023-6-9 14:33
提示参数过多誒

嗯嗯，下面用法忘记改了，再看一下