(已解决)请教高手如何将属性块内的字删除

song宋_74729

如何将属性块内的字删除 A为原图 B为我要结果 将PTCODE图层内的字删除,因为很多能否用LSP或VLX谢谢大师

属性

lee50310

song宋_74729 发表于 2022-8-5 16:58
可以直接删除吗

直接刪除圖檔內  99 及 99a 屬性塊的 ptcode 值

執行指令:atdel

2. 
   
3. ;;--------------------------------------------------------------------------------------
   
4. (defun  c:atdel()
   
5. 
   
6. (setq lst '("99" "99a") attname "ptcode")
   
7. (foreach x lst (att_del x attname))
   
8. 
   
9. )
   
10. (princ "\n 刪除 99及99a 屬性塊之屬性值.  執行指令:atdel ")
    
11. 
    
12. ;;--------------------------------------------------------------------------------------
    
13. (defun att_del(blkname attname / blkname attname bn bd en ed attlst)
    
14. (vl-load-com)
    
15. ;; (setq blkname (getstring T "\n輸入塊的名稱：ptcode "))
    
16.   (if (setq bn (tblobjname "BLOCK" blkname))
    
17.       (progn
    
18.             (setq bd  (entget bn)                  
    
19.                       en  (cdr(assoc -2 bd))          ;;第一個實體 insie 塊
    
20.                    attlst  nil                                      ;;初始化列表為空
    
21.             ) ;_ end of setq
    
22. 
    
23.       (while en      
    
24.                (setq ed (entget en))
    
25.            (if (= "ATTDEF" (cdr(assoc 0 ed)))      ;; 檢查實體是否是屬性定義
    
26.                    (setq attlst(cons (cons (strcase (cdr (assoc 2 ed))) ;; 添加到屬性列表
    
27.                                                        (vlax-ename->vla-object en)
    
28.                                               )
    
29.                                                     attlst
    
30.                                    )
    
31.                    )
    
32.                ) ;_ end of if
    
33.                    (setq en (entnext en))                        ;;獲取下一個實體
    
34.       ) ;_ end of while
    
35. 
    
36.   ;;    (setq attname (getstring T "\n輸入屬性標籤名稱: ptcode"))
    
37.   (if (setq en (assoc (strcase attname) attlst))    ;; 檢查屬性是否存在
    
38.           (progn
    
39.                 (setq ed (cdr en))                                ;;獲取屬性的VLA對象
    
40.                 (vla-Delete ed)
    
41.                 (princ "\n已成功從塊定義中刪除屬性。" )
    
42.                 (command "_.ATTSYNC" "_Name" blkname)
    
43.           ) ;_ end of progn
    
44.           (princ "\n此圖形中不存在該屬性。 退出...")
    
45. ) ;_ end of if
    
46. 
    
47.     ) ;_ end of progn
    
48. 
    
49.     (princ "\n此圖形中不存在該塊。 退出..." )
    
50. 
    
51.   ) ;_ end of if
    
52. 
    
53.   (princ)
    
54. ) ;_ end of defun
    
55. ;;--------------------------------------------------------------------------------------
    

<br /> ;;--------------------------------------------------------------------------------------<br /> (defun  c:atdel()<br /> <br /> (setq lst '("99" "99a") attname "ptcode")<br /> (foreach x lst (att_del x attname))<br /> <br /> )<br /> (princ "\n 刪除 99及99a 屬性塊之屬性值.  執行指令:atdel ") <br /> <br /> ;;--------------------------------------------------------------------------------------<br /> (defun att_del(blkname attname / blkname attname bn bd en ed attlst)<br /> (vl-load-com)<br /> ;; (setq blkname (getstring T "\n輸入塊的名稱：ptcode "))<br />   (if (setq bn (tblobjname "BLOCK" blkname))<br />       (progn<br />             (setq bd  (entget bn)                  <br />                       en  (cdr(assoc -2 bd))          ;;第一個實體 insie 塊<br />                    attlst  nil                                      ;;初始化列表為空<br />             ) ;_ end of setq<br /> <br />       (while en       <br />                (setq ed (entget en))<br />            (if (= "ATTDEF" (cdr(assoc 0 ed)))      ;; 檢查實體是否是屬性定義<br />                    (setq attlst(cons (cons (strcase (cdr (assoc 2 ed))) ;; 添加到屬性列表<br />                                                        (vlax-ename->vla-object en)<br />                                               )<br />                                                     attlst<br />                                    )<br />                    )<br />                ) ;_ end of if<br />                    (setq en (entnext en))                        ;;獲取下一個實體<br />       ) ;_ end of while<br /> <br />   ;;    (setq attname (getstring T "\n輸入屬性標籤名稱: ptcode"))<br />   (if (setq en (assoc (strcase attname) attlst))    ;; 檢查屬性是否存在<br />           (progn<br />                 (setq ed (cdr en))                                ;;獲取屬性的VLA對象<br />                 (vla-Delete ed)<br />                 (princ "\n已成功從塊定義中刪除屬性。" )<br />                 (command "_.ATTSYNC" "_Name" blkname)<br />           ) ;_ end of progn<br />           (princ "\n此圖形中不存在該屬性。 退出...")<br /> ) ;_ end of if<br /> <br />     ) ;_ end of progn<br /> <br />     (princ "\n此圖形中不存在該塊。 退出..." )<br /> <br />   ) ;_ end of if<br /> <br />   (princ)<br /> ) ;_ end of defun<br /> ;;--------------------------------------------------------------------------------------<br />

song宋_74729

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 塊
                   attlst  nil                                      ;;初始化列表為空
            ) ;_ 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

執行指令:attdel
         1. 輸入圖塊名稱 99a
         2. 輸入屬性名稱 PTCODE




執行指令:attdel
         1. 輸入圖塊名稱 99
         2. 輸入屬性名稱 PTCODE

jltx123456

你这个提问求助牛B ，向别人请教还要收人家一个币。

song宋_74729

jltx123456 发表于 2016-5-17 22:23
你这个提问求助牛B ，向别人请教还要收人家一个币。

不好意思我按錯在此致歉 已經修正好 請大師幫忙

ZZXXQQ

PtCode图层内没有文字。

ll_j

ZZXXQQ 发表于 2016-5-18 09:47
PtCode图层内没有文字。

他是要清除属性块的最后一个属性，很久没有写Lisp了，你可以看看。

song宋_74729

ZZXXQQ 发表于 2016-5-18 09:47
PtCode图层内没有文字。

屬性有文字 可以刪除嗎

song宋_74729

ZZXXQQ 发表于 2016-5-18 09:47
PtCode图层内没有文字。

屬性有文字 可以刪除嗎

ZZXXQQ

song宋_74729 发表于 2016-5-18 18:09
屬性有文字 可以刪除嗎

经查，该图层上没有任何实体。

song宋_74729

ZZXXQQ 发表于 2016-5-19 08:20
经查，该图层上没有任何实体。

我要刪除的是黃色的字如6L L R 062這些字能用框選刪除 麻煩大師

ZZXXQQ

2. ;属性替换 明经 ZZXXQQ 2008.12.27-2010.5.19-2016.5.20
   
3. (defun TT (oldlab newtxt)
   
4. (if (and (princ "\nSelect a Block have old attribute 选择带属性图块 :")
   
5.           (setq SS (ssget '((0 . "INSERT") (66 . 1))))
   
6.      ) (progn
   
7.   (setq I 0)
   
8.   (repeat (sslength SS)
   
9.    (setq EN (ssname SS I) ENT (entget EN))
   
10.    (setq I (1+ I) ENT1 ENT)
    
11.    (while (/= (cdr(assoc 0 (setq ENT1 (entget(entnext(cdr(assoc -1 ENT1))))))) "SEQEND")
    
12.     (if (= (cdr(assoc 0 ENT1)) "ATTRIB")
    
13.      (if (= (cdr(assoc 2 ENT3)) oldlab) (progn
    
14.       (setq ENT1 (subst (cons 1 newtxt) (assoc 1 ENT1) ENT1))
    
15.       (entmod ENT1)
    
16.       (entmod ENT)
    
17.      ))
    
18.     )
    
19.    )
    
20.   )
    
21. ))
    
22. (princ)
    
23. )
    

;属性替换 明经 ZZXXQQ 2008.12.27-2010.5.19-2016.5.20<br /> (defun TT (oldlab newtxt)<br /> (if (and (princ "\nSelect a Block have old attribute 选择带属性图块 :")<br />           (setq SS (ssget '((0 . "INSERT") (66 . 1))))<br />      ) (progn<br />   (setq I 0)<br />   (repeat (sslength SS)<br />    (setq EN (ssname SS I) ENT (entget EN))<br />    (setq I (1+ I) ENT1 ENT)<br />    (while (/= (cdr(assoc 0 (setq ENT1 (entget(entnext(cdr(assoc -1 ENT1))))))) "SEQEND")<br />     (if (= (cdr(assoc 0 ENT1)) "ATTRIB")<br />      (if (= (cdr(assoc 2 ENT3)) oldlab) (progn<br />       (setq ENT1 (subst (cons 1 newtxt) (assoc 1 ENT1) ENT1))<br />       (entmod ENT1)<br />       (entmod ENT)<br />      ))<br />     )<br />    )<br />   )<br /> ))<br /> (princ)<br /> )<br />

(tt "PTCODE" "")