$0$ # | 乱字符清除

尘缘一生 · 发表于 2023-2-1 01:06:22

本帖最后由尘缘一生于 2023-2-2 01:11 编辑

对于喜欢用参照的话，大量产生的乱字符，一直很头疼，
特别是字体类型名称，不好清除，结合本坛透露出的技术，
摸索几天，算是可以达到使用级别。
但对于字体类型乱码问题，倘有的图纸，未知原因，可能未能清除。
但，一般另开新图，复制进来，再一次清除即可完美
从前我发过段EMODE 修改STYLE DXF方式，不知什么原因，一直无效。

;;重命名字体样式去除$0$;参照----(一级)------存在BUG，不成功
(defun rensty$0$ (/ i n stylis sty stnew fstName fsdxf)
(setq stylis (getexiststynams))
(repeat (setq i (length stylis))
(setq sty (nth (setq i (1- i)) stylis) stnew sty)
(while (vl-string-search "\#" stnew 0) (setq stnew (vl-string-subst "" "\#" stnew)));去#的样式名称
(while (setq n (vl-string-search "$" stnew 0)) (setq stnew (substr stnew (+ 2 n))));处理有$的样式名称
(setq stnew (t-string-subst "" (slmsg "-参照" "-把酚" "-reference") stnew))
(setq stnew (t-string-subst "" "|" stnew))
(if (and (/= stnew sty) (= (tblobjname "style" stnew) nil))
(progn
(setq fstName (tblobjname "style" sty))
(setq fsdxf (entget fstName))
(entmod (emod fsdxf 2 stnew))
(entupd fstName)
)
)
)
)

对于测试成功的功能均首发集成于《三领设计》使用！

链接：https://pan.baidu.com/s/1IzA0ncDFqz2ytZfEAfzstg
提取码：1chu

;;常量定义--------0000级加载
(setq *Acad* (vlax-get-acad-object)
*AcDocument* (vla-get-activedocument *Acad*) ; 获取当前图档指针
*Model-Space* (vla-get-modelspace *AcDocument*)
*Paper-Space* (vla-get-PaperSpace *AcDocument*)
*BLKS* (vla-get-Blocks *AcDocument*)
*LAYS* (vla-get-Layers *AcDocument*)
*ACLYS* (vla-get-activeLayer *AcDocument*)
*LTS* (vla-get-Linetypes *AcDocument*)
pi2 (* pi 0.5)
pi4 (* pi 0.25)
3pi4 (* 0.75 pi)
2pi (+ pi pi)
3pi2 (+ 3pi4 3pi4) ;; (* 1.5 pi)
5pi4 (+ pi pi4) ;;(* 1.25 pi)
7pi4 (+ 3pi2 pi4) ;;(* 1.75 pi)
)
;所有图层去除【$0$】参照-----(一级)----
(defun dellay$0$ (/ n obj s2 ss1 ss2 ss3 tc tc1 tc2 x y)
(setq ss1 '() ss2 '())
(vlax-for obj *Model-Space* ;取得所有图元
(if (null (vl-catch-all-error-p (setq tc (vl-catch-all-apply 'vla-get-layer (list obj)))))
(setq ss1 (cons (list tc obj) ss1))
)
)
(vlax-for b2 *BLKS* ;查找出所有块
(vlax-for obj b2 ;块里面所有对象
(if (null (vl-catch-all-error-p (setq tc (vl-catch-all-apply 'vla-get-layer (list obj)))))
(setq ss1 (cons (list tc obj) ss1))
)
)
)
(vlax-for obj *LAYS* (setq ss2 (cons (list (vla-get-name obj) obj) ss2)));图层集合
(setq
ss3 (mapcar 'strcase (mapcar 'car ss2));图层名称集合
tc1 (getvar "clayer");取得当前图层名称
)
(if (or (vl-string-search "\#" tc1 0) (vl-string-search "$" tc1 0)) (setvar "clayer" "0") );如果当前图层需要修改，就转换图层为"0"
(while (setq s2 (car ss2));处理图层
(setq ss2 (cdr ss2) tc1 (car s2) tc2 tc1 obj (cadr s2))
(while (vl-string-search "\|" tc2 0) (setq tc2 (vl-string-subst "" "\|" tc2)))
(while (vl-string-search "\#" tc2 0) (setq tc2 (vl-string-subst "" "\#" tc2)))
(while (setq n (vl-string-search "$" tc2 0)) (setq tc2 (substr tc2 (+ 2 n))))
(setq tc2 (t-string-subst "" (slmsg "-参照" "-把酚" "-reference") tc2))
(if (= tc2 "") (setq tc2 "0"));如果是空就修改图层为"0"
(if (/= tc2 tc1) ;如果名称发生变化
(if (member (strcase tc2) ss3) ;2;如果已经有这个图层名称
(progn
(mapcar '(lambda (y) (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-layer (list y tc2))))
(mapcar 'cadr
(vl-remove-if-not '(lambda (x) (= (car x) tc1)) ss1);取得所有TC1的对象
) ;提取出图元名称
) ;所有这个图层的所有图元改变图层
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-delete (list obj)));删除这个图层
(command "laymrg" "N" tc1 "" "N" tc2 "Y");如果图层不能删除就合并
)
)
(if (null (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-name (list obj tc2))));如果没有相同命名的图层就改变图层名称
(setq ss3 (cons (strcase tc2) ss3))
)
)
)
)
)
;;已有文字样式表----(一级)------
;返回("Standard" "图框-结构$0$黑" "MtXpl_" "檩托|Standard")
(defun getexiststynams (/ FontStys exstylis stynam)
(setq FontStys (tblnext "STYLE" T))
(while FontStys
(setq stynam (dxf1 FontStys 2))
(if (/= stynam "")
(setq exstylis (append exstylis (list stynam)))
)
(setq FontStys (tblnext "STYLE"))
)
exstylis
)
;;创建、修改文字样式 ----(一级)-------
;2:样式名 40:高度 41:宽度因子 3:主要字体文件名 4:大字体文件名
;;(emk_style "样式名" (* use 0.003) 1 "黑体" "SIMHEI.TTF")
(defun emk_style (Name h w rd hz / fsdxf)
(if (not (tblobjname "style" Name))
(entmake
(list '(0 . "STYLE") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbTextStyleTableRecord")
(cons 2 Name) '(70 . 0) (cons 40 h) (cons 41 w) (cons 3 rd) (cons 4 hz)
)
)
(progn
(setq fsdxf (entget (tblobjname "style" Name)))
(if (/= (dxf1 fsdxf 40) h) (entmod (emod fsdxf 40 h)))
(if (/= (dxf1 fsdxf 41) w) (entmod (emod fsdxf 41 w)))
(if (/= (dxf1 fsdxf 3) rd) (entmod (emod fsdxf 3 rd)))
(if (/= (dxf1 fsdxf 4) hz) (entmod (emod fsdxf 4 hz)))
)
)
)
;;块内所有实体表-----(一级)----
(defun kualst (bname / blk kua lst name1 ty)
(setq kua (cdr (assoc 2 (entget bname))) lst '())
(setq blk (tblobjname "Block" kua))
(while (setq name1 (entnext blk))
(setq ty (cdr (assoc 0 (entget name1))))
(if (= ty "INSERT")
(setq lst (cons name1 lst) lst (append (kualst name1) lst))
(setq lst (cons name1 lst))
)
(setq blk name1)
)
lst
)
;;改文字实体:文字样式 (支持标注、属性块、嵌套块内文字)---(一级)----
;;ss 选择集 styi 旧文字样式 sty 新文字样式
(defun ch-ss-sty (ss styi sty / ent ent1 i name name1 tp)
(repeat (setq i (sslength ss))
(setq ent (entget (setq name (ssname ss (setq i (1- i))))) tp (dxf1 ent 0))
(cond
((member tp '("TEXT" "MTEXT" "TCH_TEXT" "TCH_MTEXT"))
(if (= (dxf1 ent 7) styi) (entmod (emod ent 7 sty)))
)
((= tp "DIMENSION")
(if (= (vlax-get (en2obj name) 'TextStyle) styi)
(progn
(command "DIMOVERRIDE" "DIMTXSTY" sty "dimfit" 3 "" name "")
(entmod ent)
)
)
)
((member tp '("INSERT"))
(setq ent1 ent)
(while (= (dxf1 (setq ent1 (entget (entnext (dxf1 ent1 -1)))) 0) "ATTRIB")
(if (= (dxf1 ent1 7) styi)
(progn (entmod (emod ent1 7 sty)) (entmod ent))
)
)
(foreach name1 (kualst name)
(setq ent1 (entget name1))
(if (member (dxf1 ent1 0) '("TEXT" "MTEXT" "TCH_TEXT" "TCH_MTEXT"))
(if (= (dxf1 ent1 7) styi) (progn (entmod (emod ent1 7 sty)) (entmod ent)))
)
)
)
)
)
(if (tblsearch "style" styi)
(vl-catch-all-error-p (vl-catch-all-apply 'vla-delete (list (vla-item (vla-get-textstyles *AcDocument*) styi))));删除
)
(command "purge" "st" "*" "n")
(princ)
)
;;文字样式去除 $0$参照#|乱码----(一级)------(rensty$0$)
(defun rensty$0$ (/ i n stylis sty stnew stdxf Font BigFont hi w Obj k)
(setq stylis (getexiststynams))
(repeat (setq i (length stylis))
(setq sty (nth (setq i (1- i)) stylis))
(setq stdxf (tblsearch "STYLE" sty))
(setq Font (dxf1 stdxf 3)) ;主要字体文件名
(setq BigFont (dxf1 stdxf 4)) ;大字体文件名
(setq hi (dxf1 stdxf 40)) ;固定的文字高度
(setq w (dxf1 stdxf 41)) ;宽度因子
(setq stnew sty)
(while (vl-string-search "\#" stnew 0) (setq stnew (vl-string-subst "" "\#" stnew))) ;去#的样式名称
(while (setq n (vl-string-search "$" stnew 0)) (setq stnew (substr stnew (+ 2 n)))) ;处理有$的样式名称
(setq stnew (t-string-subst "" (slmsg "-参照" "-把酚" "-reference") stnew))
(setq stnew (t-string-subst "" "|" stnew))
(if (/= stnew sty)
(progn
(vlax-for Obj (vla-get-TextStyles *AcDocument*)
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-Name (list Obj stnew)))
(setq k t)
)
)
(if (= k t)
(progn
(if (= (tblobjname "style" stnew) nil)
(emk_style stnew hi w Font BigFont)
)
(ch-ss-sty (ssget "X" '((0 . "TEXT,MTEXT,TCH_TEXT,TCH_MTEXT,DIMENSION,INSERT,ATTRIB"))) sty stnew)
)
)
)
)
)
)

;;常量定义--------0000级加载 
(setq *Acad* (vlax-get-acad-object) 
  *AcDocument* (vla-get-activedocument *Acad*)  ; 获取当前图档指针 
  *Model-Space* (vla-get-modelspace *AcDocument*) 
  *Paper-Space* (vla-get-PaperSpace *AcDocument*) 
  *BLKS* (vla-get-Blocks *AcDocument*) 
  *LAYS* (vla-get-Layers *AcDocument*) 
  *ACLYS*  (vla-get-activeLayer *AcDocument*) 
  *LTS*  (vla-get-Linetypes *AcDocument*) 
  pi2     (* pi 0.5) 
  pi4     (* pi 0.25) 
  3pi4   (* 0.75 pi) 
  2pi     (+ pi pi) 
  3pi2   (+ 3pi4 3pi4)  ;; (* 1.5 pi) 
  5pi4   (+ pi pi4)  ;;(* 1.25 pi) 
  7pi4   (+ 3pi2 pi4) ;;(* 1.75 pi) 
) 
;所有图层去除【$0$】参照-----(一级)---- 
(defun dellay$0$ (/ n obj s2 ss1 ss2 ss3 tc tc1 tc2 x y) 
  (setq ss1 '() ss2 '()) 
  (vlax-for obj *Model-Space* ;取得所有图元 
    (if (null (vl-catch-all-error-p (setq tc (vl-catch-all-apply 'vla-get-layer (list obj))))) 
      (setq ss1 (cons (list tc obj) ss1)) 
    ) 
  ) 
  (vlax-for b2 *BLKS* ;查找出所有块 
    (vlax-for obj b2 ;块里面所有对象 
      (if (null (vl-catch-all-error-p (setq tc (vl-catch-all-apply 'vla-get-layer (list obj))))) 
        (setq ss1 (cons (list tc obj) ss1)) 
      ) 
    ) 
  ) 
  (vlax-for obj *LAYS* (setq ss2 (cons (list (vla-get-name obj) obj) ss2)));图层集合 
  (setq 
    ss3 (mapcar 'strcase (mapcar 'car ss2));图层名称集合 
    tc1 (getvar "clayer");取得当前图层名称 
  ) 
  (if (or (vl-string-search "\#" tc1 0) (vl-string-search "$" tc1 0)) (setvar "clayer" "0") );如果当前图层需要修改，就转换图层为"0" 
  (while (setq s2 (car ss2));处理图层 
    (setq ss2 (cdr ss2) tc1 (car s2) tc2 tc1 obj (cadr s2)) 
    (while (vl-string-search "\|" tc2 0) (setq tc2 (vl-string-subst "" "\|" tc2))) 
    (while (vl-string-search "\#" tc2 0) (setq tc2 (vl-string-subst "" "\#" tc2))) 
    (while (setq n (vl-string-search "$" tc2 0)) (setq tc2 (substr tc2 (+ 2 n)))) 
    (setq tc2 (t-string-subst "" (slmsg "-参照" "-把酚" "-reference") tc2)) 
    (if (= tc2 "") (setq tc2 "0"));如果是空就修改图层为"0" 
    (if (/= tc2 tc1) ;如果名称发生变化 
      (if (member (strcase tc2) ss3)  ;2;如果已经有这个图层名称 
        (progn 
          (mapcar '(lambda (y) (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-layer (list y tc2)))) 
            (mapcar 'cadr 
              (vl-remove-if-not '(lambda (x) (= (car x) tc1)) ss1);取得所有TC1的对象 
            ) ;提取出图元名称 
          ) ;所有这个图层的所有图元改变图层 
          (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-delete (list obj)));删除这个图层 
            (command "laymrg" "N" tc1 "" "N" tc2 "Y");如果图层不能删除就合并 
          ) 
        ) 
        (if (null (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-name (list obj tc2))));如果没有相同命名的图层就改变图层名称 
          (setq ss3 (cons (strcase tc2) ss3)) 
        ) 
      ) 
    ) 
  ) 
) 
;;已有文字样式表----(一级)------ 
;返回("Standard" "图框-结构$0$黑" "MtXpl_" "檩托|Standard") 
(defun getexiststynams (/ FontStys exstylis stynam) 
  (setq FontStys (tblnext "STYLE" T)) 
  (while FontStys 
    (setq stynam (dxf1 FontStys 2)) 
    (if (/= stynam "") 
      (setq exstylis (append exstylis (list stynam))) 
    ) 
    (setq FontStys (tblnext "STYLE")) 
  )   
  exstylis 
) 
;;创建、修改文字样式 ----(一级)------- 
;2:样式名 40:高度 41:宽度因子 3:主要字体文件名 4:大字体文件名 
;;(emk_style "样式名" (* use 0.003) 1 "黑体" "SIMHEI.TTF") 
(defun emk_style (Name h w rd hz / fsdxf) 
  (if (not (tblobjname "style" Name)) 
    (entmake 
      (list '(0 . "STYLE") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbTextStyleTableRecord") 
        (cons 2 Name) '(70 . 0) (cons 40 h) (cons 41 w) (cons 3 rd) (cons 4 hz) 
      ) 
    ) 
    (progn 
      (setq fsdxf (entget (tblobjname "style" Name))) 
      (if (/= (dxf1 fsdxf 40) h) (entmod (emod fsdxf 40 h))) 
      (if (/= (dxf1 fsdxf 41) w) (entmod (emod fsdxf 41 w))) 
      (if (/= (dxf1 fsdxf 3) rd) (entmod (emod fsdxf 3 rd))) 
      (if (/= (dxf1 fsdxf 4) hz) (entmod (emod fsdxf 4 hz))) 
    ) 
  ) 
) 
;;块内所有实体表-----(一级)---- 
(defun kualst (bname / blk kua lst name1 ty) 
  (setq kua (cdr (assoc 2 (entget bname))) lst '()) 
  (setq blk (tblobjname "Block" kua)) 
  (while (setq name1 (entnext blk)) 
    (setq ty (cdr (assoc 0 (entget name1)))) 
    (if (= ty "INSERT") 
      (setq lst (cons name1 lst) lst (append (kualst name1) lst)) 
      (setq lst (cons name1 lst)) 
    ) 
    (setq blk name1) 
  ) 
  lst 
) 
;;改文字实体:文字样式 (支持标注、属性块、嵌套块内文字)---(一级)---- 
;;ss 选择集  styi 旧文字样式  sty 新文字样式 
(defun ch-ss-sty (ss styi sty / ent ent1 i name name1 tp) 
  (repeat (setq i (sslength ss)) 
    (setq ent (entget (setq name (ssname ss (setq i (1- i))))) tp (dxf1 ent 0)) 
    (cond 
      ((member tp '("TEXT" "MTEXT" "TCH_TEXT" "TCH_MTEXT")) 
        (if (= (dxf1 ent 7) styi) (entmod (emod ent 7 sty))) 
      ) 
      ((= tp "DIMENSION") 
        (if (= (vlax-get (en2obj name) 'TextStyle) styi) 
          (progn 
            (command "DIMOVERRIDE" "DIMTXSTY" sty "dimfit" 3 "" name "") 
            (entmod ent) 
          ) 
        ) 
      ) 
      ((member tp '("INSERT")) 
        (setq ent1 ent) 
        (while (= (dxf1 (setq ent1 (entget (entnext (dxf1 ent1 -1)))) 0) "ATTRIB") 
          (if (= (dxf1 ent1 7) styi) 
            (progn (entmod (emod ent1 7 sty)) (entmod ent)) 
          ) 
        ) 
        (foreach name1 (kualst name) 
          (setq ent1 (entget name1)) 
          (if (member (dxf1 ent1 0) '("TEXT" "MTEXT" "TCH_TEXT" "TCH_MTEXT")) 
            (if (= (dxf1 ent1 7) styi) (progn (entmod (emod ent1 7 sty)) (entmod ent))) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (if (tblsearch "style" styi) 
    (vl-catch-all-error-p (vl-catch-all-apply 'vla-delete (list (vla-item (vla-get-textstyles *AcDocument*) styi))));删除 
  ) 
  (command "purge" "st" "*" "n") 
  (princ) 
) 
;;文字样式 去除 $0$参照#|乱码----(一级)------(rensty$0$) 
(defun rensty$0$ (/ i n stylis sty stnew stdxf Font BigFont hi w Obj k) 
  (setq stylis (getexiststynams)) 
  (repeat (setq i (length stylis)) 
    (setq sty (nth (setq i (1- i)) stylis)) 
    (setq stdxf (tblsearch "STYLE" sty)) 
    (setq Font (dxf1 stdxf 3)) ;主要字体文件名 
    (setq BigFont (dxf1 stdxf 4)) ;大字体文件名 
    (setq hi (dxf1 stdxf 40)) ;固定的文字高度 
    (setq w (dxf1 stdxf 41)) ;宽度因子 
    (setq stnew sty) 
    (while (vl-string-search "\#" stnew 0) (setq stnew (vl-string-subst "" "\#" stnew)))  ;去#的样式名称 
    (while (setq n (vl-string-search "$" stnew 0)) (setq stnew (substr stnew (+ 2 n))))   ;处理有$的样式名称 
    (setq stnew (t-string-subst "" (slmsg "-参照" "-把酚" "-reference") stnew)) 
    (setq stnew (t-string-subst "" "|" stnew)) 
    (if (/= stnew sty) 
      (progn 
        (vlax-for Obj (vla-get-TextStyles *AcDocument*) 
          (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-Name (list Obj stnew)))   
            (setq k t) 
          ) 
        ) 
        (if (= k t) 
          (progn 
            (if (= (tblobjname "style" stnew) nil) 
              (emk_style stnew hi w Font BigFont) 
            ) 
            (ch-ss-sty (ssget "X" '((0 . "TEXT,MTEXT,TCH_TEXT,TCH_MTEXT,DIMENSION,INSERT,ATTRIB"))) sty stnew) 
          ) 
        ) 
      ) 
    ) 
  ) 
)

本来想发个我画的测试图纸，附件上传不了。

vladimir · 发表于 2023-2-1 08:41:59

非常不错的代码，谢谢分享啊。

yuanziyou · 发表于 2023-2-1 09:36:41

帅哥，能不能用论坛自带的代码格式化（论坛编辑栏笑脸符号左侧那个括号图标）排版，你这种带行号的，看着太恼火了

cghdy · 发表于 2023-2-1 09:39:58

谢谢分享。参照的绑定保留前缀是用来区分的参照图和本图信息的，一般发图时绑定，自己需要绘制的图很少绑定使用。还就就是清楚图层图块等前缀还存在重名的问题，可能会造成位置错误。

尘缘一生 · 发表于 2023-2-1 09:54:59

yuanziyou 发表于 2023-2-1 09:36
帅哥，能不能用论坛自带的代码格式化（论坛编辑栏笑脸符号左侧那个括号图标）排版，你这种带行号的，看着太 ...

这样发，有颜色区分，对看原理比较好，

附件已上传，

czb203 · 发表于 2023-2-1 10:44:50

非常不错的代码，谢谢分享啊。

hzyhzjjzh · 发表于 2023-2-1 13:24:07

谢谢分享

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

$0$ # | 乱字符清除

本帖子中包含更多资源

评分