消除字体样式 $0$
本帖最后由 尘缘一生 于 2022-2-14 08:58 编辑没事想解决这个问题，写了段代码，调试有问题，又不想保存，还不想丢弃，由于加了块内实体，速度慢，这都是需要研究一下子。。。。
那么存这里吧。希望有人把这个课题完成。
[*]
[*](if (null vlax-dump-object) (vl-load-com));;将 Visual LISP 扩展功能加载到 AutoLISP----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)
[*])
[*];;返回 obj的 vla对象名-------(一级)------------------
[*](defun en2obj (object)
[*](cond
[*] ((= (type object) 'vla-object)
[*] object
[*] )
[*] ((= (type object) 'ename)
[*] (vl-catch-all-apply '(lambda () (setq object (vlax-ename->vla-object object))));;避免天正实体出错退出
[*] )
[*])
[*]object
[*])
[*];;返回 vla对象->ename对象名-------(一级)----------------
[*](defun obj2en (object)
[*](if (equal (type object) 'vla-object)
[*] (setq object (vlax-vla-object->ename object))
[*] object
[*])
[*]object
[*])
[*];;块内所有实体表-----（一级）----
[*](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
[*])
[*];;字符串以旧换新------------(一级)--------
[*](defun t-string-subst (new old str / n)
[*](setq n (- (strlen new)))
[*](while (setq n (vl-string-search old str (min (+ n (strlen new)) (strlen str))))
[*] (setq str (vl-string-subst new old str n))
[*])
[*]str
[*])
[*];提取除参照外所有图元----(一级)---------
[*];返回((0 obj1) (图层2 obj2)......)
[*](defun allenam (/ b1 obj enamlis tc)
[*](setq enamlis '())
[*](vlax-for obj *Model-Space*
[*] (if (null (vl-catch-all-error-p (setq tc (vl-catch-all-apply 'vla-get-layer (list obj)))))
[*] (setq enamlis (cons (list tc obj) enamlis))
[*] )
[*])
[*](vlax-for b1 *BLKS*
[*] (vlax-for obj b1
[*] (if (and (null (vl-catch-all-error-p (setq tc (vl-catch-all-apply 'vla-get-layer (list obj)))))
[*] (= :vlax-false (vla-get-isxref b1)) ;;非参照
[*] )
[*] (setq enamlis (cons (list tc obj) enamlis))
[*] )
[*] )
[*])
[*]enamlis
[*])
[*];;全图文字样式表----（一级）---
[*](defun slstylist (/ stylis stydxf styname)
[*](setq stydxf (tblnext "STYLE" T) stylis '())
[*](while stydxf
[*] (setq styname (dxf1 stydxf 2))
[*] (if (/= styname "")
[*] (setq stylis (append stylis (list styname)))
[*] )
[*] (setq stydxf (tblnext "STYLE"))
[*])
[*]stylis
[*])
[*];;选择集改文字样式(支持标注、属性块、嵌套块内文字)---（一级）----
[*];;ss 选择集styi 比较中文字样式sty 要改变文字样式
[*](defun ch-ss-sty (ss styi sty / ent ent1 i lst name name1 tp sty0)
[*](repeat (setq i (sslength ss))
[*] (setq ent (entget (setq name (ssname ss (setq i (1- i)))))
[*] tp (dxf1ent 0) sty0 (dxf1 ent 7)
[*] )
[*] (cond
[*] ((member tp '("TEXT" "MTEXT"))
[*] (if (= sty0 styi)
[*] (entmod (emod ent 7 sty))
[*] )
[*] )
[*] ((= tp "DIMENSION")
[*] (setq sty0 (vlax-get (en2obj name) 'TextStyle))
[*] (if (= sty0 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")
[*] (setq sty0 (dxf1 ent1 7))
[*] (if (= sty0 styi)
[*] (progn
[*] (setq ent1 (emod ent1 7 sty))
[*] (entmod ent1)
[*] (entmod ent)
[*] )
[*] )
[*] )
[*] (setq lst (kualst name))
[*] (foreach name1 lst
[*] (setq ent1 (entget name1))
[*] (if (member (dxf1 ent1 0) '("TEXT" "MTEXT"))
[*] (progn
[*] (setq sty0 (dxf1 ent1 7))
[*] (if (= sty0 styi)
[*] (entmod (emod ent1 7 sty))
[*] )
[*] )
[*] )
[*] )
[*] (entmod ent)
[*] )
[*] )
[*])
[*](princ)
[*])
[*];元素列表→选择集----------(一级)-----------
[*](defun sl:pickset-fromlist (eList / ss)
[*](setq ss (ssadd))
[*](while eList
[*] (if (equal (type (car eList)) 'ENAME)
[*] (setq ss (ssadd (car eList) ss))
[*] )
[*] (setq eList (cdr elist))
[*])
[*]ss
[*])
[*];;去除字体样式 $0$----参照
[*](defun del$0$ (/ stylis enamlis elis styi styii)
[*](setq stylis (slstylist) elis '())
[*](setq enamlis (allenam))
[*](repeat (setq i (length enamlis))
[*] (setq enami (obj2en (cadr (nth (setq i (1- i)) enamlis))))
[*] (setq elis (cons enami elis))
[*])
[*](setq ss (sl:pickset-fromlist elis))
[*];;(setq ss (ssget "x" '((0 . "TEXT,MTEXT,DIMENSION,INSERT,ATTRIB"))))
[*](repeat (setq i (length stylis))
[*] (setq styi (nth (setq i (1- i)) stylis))
[*] (setq styii (t-string-subst "" "$0$" styi))
[*] (setq styii (t-string-subst "" "-参照" styii))
[*] (if (/= styii styi)
[*] (ch-ss-sty ss styi styii)
[*] )
[*])
[*](command "purge" "st" "*" "n")
[*])
[*](del$0$)
[*]
赞一个!{:1_1:}{:1_1:}{:1_1:} 我也遇到了这种图，好像这个代码运行不了，期待有高手能完成这个 缺少 DXF1 函数 楼主和补上不？ flowerson 发表于 2022-11-11 20:41
缺少 DXF1 函数 楼主和补上不？
;取得图元参数值内容-----(一级)-------
;;(setq h (dxf1 ent 40))
; ent 为实体名或实体entget，
(defun dxf1 (ent i / tmp)
(if (= (type ent) 'ENAME)
(setq ent (entget ent '("*")))
)
(setq tmp (cdr (assoc i ent)))
(if (null tmp)
(cond
((= i 66) 0)
((= i 48) (getvar "celtscale"))
((= i 62) 256)
((= i 370) (setq tmp -1))
((= i 6) "ByLayer")
)
tmp
)
) 一个小建议：插入代码可使用顶栏的插入代码按钮，方便复制和编辑。
[*];;已有文字样式表----(一级)------
[*];返回("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
[*])
[*];;重命名字体样式 去除$0$;参照----(一级)------(rensty$0$)
[*](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)
[*] )
[*] )
[*])
[*])
感觉你在处理文字样式名称时特别绕。逻辑是不是可以优化下：1、历遍所有的文字样式名称放入一个列表内，2、循环列表内所有的每一个文字样式名称为oldName，如果带有$0$字符的文字样式名称，就以“$0$”为分割符进行分割字符串，分割后的字符应该变成字符数组了，那么该数组内最后一组元素就是newName了，3、将循环的每一个oldName替换成newName，如果newName已存在，就将oldName赋值的文字样式删除了，这样就能清除掉文字样式中所有的带$0$之前的文字前缀。 赞一个!赞一个!
页:
[1]