$0$ # | 乱字符清除
本帖最后由 尘缘一生 于 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)
)
)
)
)
)
)
本来想发个我画的测试图纸，附件上传不了。
非常不错的代码，谢谢分享啊。 帅哥，能不能用论坛自带的代码格式化（论坛编辑栏笑脸符号左侧那个括号图标）排版，你这种带行号的，看着太恼火了 谢谢分享。参照的绑定保留前缀是用来区分的参照图和本图信息的，一般发图时绑定，自己需要绘制的图很少绑定使用。还就就是清楚图层图块等前缀还存在重名的问题，可能会造成位置错误。 yuanziyou 发表于 2023-2-1 09:36
帅哥，能不能用论坛自带的代码格式化（论坛编辑栏笑脸符号左侧那个括号图标）排版，你这种带行号的，看着太 ...
这样发，有颜色区分，对看原理比较好，
附件已上传，
非常不错的代码，谢谢分享啊。 谢谢分享{:1_1:}
页:
[1]