清理多余字体样式和标注样式

头大无恼

主程序源码应该是[Gu_xl]老大的，
拼接改造了一下
主要是拿到别家图纸很多字型，讨厌打开文件时恼人的字体丢失提示
可以根据自己需要修改
可以把所有的文字样式和标注样式清理只保留默认样式。
这样图纸清爽了，哈哈


;清理文字样式
(defun c:wzgy ()
    ;(SETVAR "CMDECHO" 0)
    (command "undo" "be")
    (u:reset_dimtextstandard);更改标注样式中的文字样式
    (u:reset_textstandard);全部转换至standard
    (command "undo" "e")
(princ);静默退出
)


;清理标注样式
(defun c:bzgy()
(u:reset_dimtextstandard)
(command "purge" "dimstyle" "*" "n")
)



;;;②★所有文字归一

;分函数
(defun u:standard_song(stylename /)
  (command "style" stylename "宋体"  "0" "1.0" "0.0" "" "")
  (setq filter_style stylename)
)

(defun u:standard_zhanghaishan(stylename /)
  (command "style" stylename "张海山锐线体2.0"  "0" "1.0" "0.0" "" "")
  (setq filter_style stylename)
)

(defun u:standard_hei(stylename /)
  (command "style" stylename "黑体"  "0" "1.0" "0.0" "" "")
  (setq filter_style stylename)
)

(defun u:standard_yahei(stylename /)
  (command "style" stylename "微软雅黑 light"  "0" "1.0" "0.0" "" "")
  (setq filter_style stylename)
)

(defun u:standard_youyuan(stylename /)
  (command "style" stylename "幼圆"  "0" "1.0" "0.0" "" "")
  (setq filter_style stylename)
)

(defun u:standard_tianzheng(stylename /)
  (command "style" stylename "Romans1.shx,hztxt.shx"  "0" "1" "0.0" "n" "n" "n");注意这个字型会多一个是否垂直选项所以需要增加一个输入
  (setq filter_style stylename)
)


;定义字体归一主函数
(defun u:allinone_textstyle(filter_style / blkobj obj objname atts)
     (vlax-for blkobj (vla-get-blocks
                     (vla-get-ActiveDocument (vlax-get-acad-object))
                     )
     (vlax-for obj blkobj
      (if (or (= "AcDbMText" (setq objname (vla-get-objectname obj)))
              (= "AcDbText" objname)
              (= "AcDbAttribute" objname)
              (= "AcDbAttributeDefinition" objname)
              )
        (VL-CATCH-ALL-APPLY 'vla-put-stylename (list obj filter_style))
        )
      (if (and
            (or (= "AcDbMInsertBlock" objname)
              (= "AcDbBlockReference" objname)
              )
            (setq atts (vlax-invoke obj 'GetAttributes))
            )
        (foreach a atts (VL-CATCH-ALL-APPLY 'vla-put-stylename (list a filter_style)))
        )
      )
    )
);end_defun



(defun u:reset_textstandard (/ filter_style)
(setvar "cmdecho" 0)
(redraw)
(initget "0 1 2 3 4 5 ")
  (princ "\n请选择统一后的字型:")
  (setq key (getkword "
            \n■0:黑体\★1:宋体\★2:微软雅黑 light\■3:张海山锐线体2.0\■4:幼圆\★5:Romans1.shx,hztxt.SHX<默认为0>:"))
  (cond
    ((not key) (u:standard_hei "黑体"));注引号内为字体样式名称
    ((= key "0") (u:standard_hei "黑体"))
    ((= key "1") (u:standard_song "宋体"));
    ((= key "2") (u:standard_yahei "standard"));
    ((= key "3") (u:standard_zhanghaishan "text1"));
    ((= key "4") (u:standard_youyuan "幼圆"));
    ((= key "5") (u:standard_tianzheng "text1"));

    );cond

   (u:allinone_textstyle filter_style)

  (command "purge" "st" "*" "n")
  (princ)
  )

;;;③★所有标注文字归一

;;;增加遍历和循环获取文件中所有的标注样式,注意先必须运行将当前标注字体改为standard，否则会多出一个样式替代的字体不能换
(defun u:reset_dimtextstandard (/ AcadObject AcadDocument mSpace DimstyCol DimstyCount DimstyName lst txt newtxt dimst txtst)
  (VL-LOAD-COM)
  (command "-dimstyle" "r" "standard");当前标注样式换为standard【本句用于消除样式替代】
  (command "dimtxsty""standard");当前标注字体换为standard

  (setq AcadObject (vlax-get-acad-object)
        AcadDocument (vla-get-ActiveDocument Acadobject)
        mSpace (vla-get-ModelSpace Acaddocument)
  )
        (setq DimstyCol (vla-get-dimstyles AcadDocument))
        (setq DimstyCount (vla-get-count DimstyCol))
        (setq index 0)
        (repeat DimstyCount
                (setq DimstyName (vla-get-name (vla-item DimstyCol index)));;依次获取标注样式
                (princ (strcat "\n" (itoa (1+ index)) "." DimstyName));;列印标注样式
;;;;赋值dimst
                (setq dimst DimstyName)
                (print dimst)
                (setq lst (entget(tblobjname "dimstyle" dimst));赋值1st
                      txt (assoc 340 lst);赋值txt
                )
;;;;替换标注样式字体
               (setq newtxt (tblobjname "style" "standard"))
               (entmod (subst (cons 340 newtxt) txt lst))
               (setq index (1+ index))
        )
  (princ)
);end_defun

觉得好用可以打赏

头大无恼

l18c19 发表于 2018-5-17 15:07
好程序，若楼主能把涉及到的字体文件上传就更棒啦！

字体都是系统自带的哦，网上搜下大把下，而且字体看自己喜欢，然后修改相应的字型定义字函数就好了。因为每个公司的规范不一样，按自己需求改下吧

有区别吗

我还是习惯用自带的checkstandards命令去对比标准dws文件.

再见熊猫衣服

楼主你还在论坛吗？你这个程序，无法修改块里面的文字样式啊。

zhangcan0515

谢谢分享好用的程序

taoyi0727

G版的都是好东西  先保存

sunny_8848

挺好用的，多谢楼主分享

囗Peanut囗

还好吧，也分什么图，搞不好出来一大推的“？？？？”

l18c19

好程序，若楼主能把涉及到的字体文件上传就更棒啦！

suker

代码非常有用

H-浩浩-H

谢谢分享