(已解决)请教高手如何将属性块内的字删除
本帖最后由 song宋_74729 于 2022-9-2 07:09 编辑如何将属性块内的字删除 A为原图 B为我要结果 将PTCODE图层内的字删除,因为很多能否用LSP或VLX谢谢大师属性 本帖最后由 lee50310 于 2022-9-2 04:29 编辑
song宋_74729 发表于 2022-8-5 16:58
可以直接删除吗
直接刪除圖檔內99 及 99a 屬性塊的 ptcode 值
執行指令:atdel
;;--------------------------------------------------------------------------------------
(defunc:atdel()
(setq lst '("99" "99a") attname "ptcode")
(foreach x lst (att_del x attname))
)
(princ "\n 刪除 99及99a 屬性塊之屬性值.執行指令:atdel ")
;;--------------------------------------------------------------------------------------
(defun att_del(blkname attname / blkname attname bn bd en ed attlst)
(vl-load-com)
;; (setq blkname (getstring T "\n輸入塊的名稱：ptcode "))
(if (setq bn (tblobjname "BLOCK" blkname))
(progn
(setq bd(entget bn)
en(cdr(assoc -2 bd)) ;;第一個實體 insie 塊
attlstnil ;;初始化列表為空
) ;_ end of setq
(while en
(setq ed (entget en))
(if (= "ATTDEF" (cdr(assoc 0 ed))) ;; 檢查實體是否是屬性定義
(setq attlst(cons (cons (strcase (cdr (assoc 2 ed))) ;; 添加到屬性列表
(vlax-ename->vla-object en)
)
attlst
)
)
) ;_ end of if
(setq en (entnext en)) ;;獲取下一個實體
) ;_ end of while
;; (setq attname (getstring T "\n輸入屬性標籤名稱: ptcode"))
(if (setq en (assoc (strcase attname) attlst)) ;; 檢查屬性是否存在
(progn
(setq ed (cdr en)) ;;獲取屬性的VLA對象
(vla-Delete ed)
(princ "\n已成功從塊定義中刪除屬性。" )
(command "_.ATTSYNC" "_Name" blkname)
) ;_ end of progn
(princ "\n此圖形中不存在該屬性。 退出...")
) ;_ end of if
) ;_ end of progn
(princ "\n此圖形中不存在該塊。 退出..." )
) ;_ end of if
(princ)
) ;_ end of defun
;;--------------------------------------------------------------------------------------
lee50310 发表于 2022-8-5 17:04
當然可以,不過需要 自行修改程式
;;
;;取自網路
;;https://autocadtips1.com/2011/04/12/autolisp-delete-attributes/
;;刪除塊中屬性
;;--------------------------------------------------------------------------------------
(vl-load-com)
(defun c:ATTDEL (/ blkname attname bn bd en ed attlst)
(setq blkname (getstring T "\n輸入塊的名稱：ptcode "))
(if (setq bn (tblobjname "BLOCK" blkname))
(progn
(setq bd(entget bn)
en(cdr(assoc -2 bd)) ;;第一個實體 insie 塊
attlstnil ;;初始化列表為空
) ;_ end of setq
(while en
(setq ed (entget en))
(if (= "ATTDEF" (cdr(assoc 0 ed))) ;; 檢查實體是否是屬性定義
(setq attlst(cons (cons (strcase (cdr (assoc 2 ed))) ;; 添加到屬性列表
(vlax-ename->vla-object en)
)
attlst
)
)
) ;_ end of if
(setq en (entnext en)) ;;獲取下一個實體
) ;_ end of while
(setq attname (getstring T "\n輸入屬性標籤名稱: ptcode"))
(if (setq en (assoc (strcase attname) attlst)) ;; 檢查屬性是否存在
(progn
(setq ed (cdr en)) ;;獲取屬性的VLA對象
(vla-Delete ed)
(princ "\n已成功從塊定義中刪除屬性。" )
(command "_.ATTSYNC" "_Name" blkname)
) ;_ end of progn
(princ "\n此圖形中不存在該屬性。 退出...")
) ;_ end of if
) ;_ end of progn
(princ "\n此圖形中不存在該塊。 退出..." )
) ;_ end of if
(princ)
) ;_ end of defun
;;--------------------------------------------------------------------------------------
怎么修改删除ptcode文字 本帖最后由 lee50310 于 2022-8-5 17:01 编辑
執行指令:attdel
1. 輸入圖塊名稱 99a
2. 輸入屬性名稱 PTCODE
執行指令:attdel
1. 輸入圖塊名稱 99
2. 輸入屬性名稱 PTCODE
你这个提问求助牛B ，向别人请教还要收人家一个币。 jltx123456 发表于 2016-5-17 22:23 static/image/common/back.gif
你这个提问求助牛B ，向别人请教还要收人家一个币。
不好意思我按錯在此致歉 已經修正好 請大師幫忙 PtCode图层内没有文字。 ZZXXQQ 发表于 2016-5-18 09:47 static/image/common/back.gif
PtCode图层内没有文字。
他是要清除属性块的最后一个属性，很久没有写Lisp了，你可以看看。 ZZXXQQ 发表于 2016-5-18 09:47 static/image/common/back.gif
PtCode图层内没有文字。
屬性有文字 可以刪除嗎 ZZXXQQ 发表于 2016-5-18 09:47 static/image/common/back.gif
PtCode图层内没有文字。
屬性有文字 可以刪除嗎 song宋_74729 发表于 2016-5-18 18:09 static/image/common/back.gif
屬性有文字 可以刪除嗎
经查，该图层上没有任何实体。 ZZXXQQ 发表于 2016-5-19 08:20 static/image/common/back.gif
经查，该图层上没有任何实体。
我要刪除的是黃色的字如6L L R 062這些字能用框選刪除 麻煩大師 ;属性替换 明经 ZZXXQQ 2008.12.27-2010.5.19-2016.5.20
(defun TT (oldlab newtxt)
(if (and (princ "\nSelect a Block have old attribute 选择带属性图块 :")
(setq SS (ssget '((0 . "INSERT") (66 . 1))))
) (progn
(setq I 0)
(repeat (sslength SS)
(setq EN (ssname SS I) ENT (entget EN))
(setq I (1+ I) ENT1 ENT)
(while (/= (cdr(assoc 0 (setq ENT1 (entget(entnext(cdr(assoc -1 ENT1))))))) "SEQEND")
(if (= (cdr(assoc 0 ENT1)) "ATTRIB")
(if (= (cdr(assoc 2 ENT3)) oldlab) (progn
(setq ENT1 (subst (cons 1 newtxt) (assoc 1 ENT1) ENT1))
(entmod ENT1)
(entmod ENT)
))
)
)
)
))
(princ)
)
(tt "PTCODE" "")