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

song宋_74729

ZZXXQQ 发表于 2016-5-20 10:16
(tt "PTCODE" "")

命令打TT發現錯誤

song宋_74729

song宋_74729 发表于 2016-5-20 18:40
命令打TT發現錯誤

無法刪除ptcode圖塊文字

skg123

提问最好发图，发个附件大家还要下载，麻烦

song宋_74729

将黄色字删除

lee50310

取自網路
https://autocadtips1.com/2011/04/12/autolisp-delete-attributes/

lee50310

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




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

song宋_74729

lee50310 发表于 2022-8-5 16:47
取自網路
https://autocadtips1.com/2011/04/12/autolisp-delete-attributes/

可以直接删除吗

lee50310

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

當然可以,不過需要 自行修改程式

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

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 />