Delete all attributes except for certain blocks

I need to have a lisp routine that will delete all attributes in all block except for certain blocks. Those few need to stay. Also it needs little to no user input.

I found this lisp but I don't have a clue on how to add an exclusion list of block names to it. If someone could point me in the right direction it would be appriciated.

(defun c:DelTXT (/ ss i sn x)(vl-load-com)
 (if (setq ss (ssget '((0 . "INSERT") (66 . 1))))
   (repeat (setq i (sslength ss))
     (setq sn (ssname ss (setq i (1- i))))
     (while
       (not
         (eq (cdr (assoc 0 (entget (setq x (entnext sn))))) "SEQEND")
       )
        (if (eq (cdr (assoc 0 (entget x))) "ATTRIB")
          (vla-delete
            (vlax-ename->vla-object (cdr (assoc -1 (entget x))))
          )
        )
     )
   )
    )
 (princ)
)

Thnaks

Sean

Maybe you can do that by the layer that the block lays on

I think that code is written by me if I am not mistaken .

Yes I think it is yours and thank you for sharing it. I tried locking the layer that the block was on but if the block definition has the text on layer zero it will still delete the attribute. My issue is I need the room id block, door tag's and the like not to be effected yet delete text from chairs or desks.

Or maybe by the Attributes ' values then .

I suppose that would work but one of the blocks is room name and number and could be any value. On top of that I have no clue how. There are only ten block names I need to exclude. With your routine I select all and then tried to remove but you can't remove by name.

If your blocks are not in a way confidential works , just upload a sample drawing to have a look at it , we may can find a way to hit it down to the floor .

Here is the drawing. Ideally the routine would select all then exclude or remove these blocks from the selection. Bubble, gridbubble-b, gridbubble-l, gridbubble-t, gridbubble-r, rmnm-no, dr-no, windowtype, partiontype, iden.

Testing-2.dwg

What are the name of blocks that you do not want to delete their attributes ?

What are the name of blocks that you do not want to delete their attributes ?

Bubble, gridbubble-b, gridbubble-l, gridbubble-t, gridbubble-r, rmnm-no, dr-no, windowtype, partiontype, iden

Did it work for you? It deletes the attributes in all the blocks still.

Did it work for you? It deletes the attributes in all the blocks still.

My mistake was with number 8 instead of 2 .

Try it now ...

(defun c:Test (/ ss i sn x)
;;; Tharwat 30. Jan. 2013 ;;;
 (vl-load-com)
 (if (setq ss (ssget "_x" '((0 . "INSERT") (66 . 1))))
   (repeat (setq i (sslength ss))
     (setq sn (ssname ss (setq i (1- i))))
     (if (not (member (strcase (cdr (assoc 2 (entget sn))))
                      '("BUBBLE"          "GRIDBUBBLE-B"
                        "GRIDBUBBLE-L"    "GRIDBUBBLE-T"
                        "GRIDBUBBLE-R"    "RMNM-NO"
                        "DR-NO"           "WINDOWTYPE"
                        "PARTIONTYPE"     "IDEN"
                       )
              )
         )
       (while
         (not
           (eq (cdr (assoc 0 (entget (setq x (entnext sn))))) "SEQEND")
         )
          (if (eq (cdr (assoc 0 (entget x))) "ATTRIB")
            (vla-delete
              (vlax-ename->vla-object (cdr (assoc -1 (entget x))))
            )
          )
       )
     )
   )
 )
 (princ)
)

Thank you so much!!!

My mistake was with number 8 instead of 2 .

 

Try it now ...

 

(defun c:Test (/ ss i sn x)
;;; Tharwat 30. Jan. 2013 ;;;
 (vl-load-com)
 (if (setq ss (ssget "_x" '((0 . "INSERT") (66 . 1))))
   (repeat (setq i (sslength ss))
     (setq sn (ssname ss (setq i (1- i))))
     (if (not (member (strcase (cdr (assoc 2 (entget sn))))
                      '("BUBBLE"          "GRIDBUBBLE-B"
                        "GRIDBUBBLE-L"    "GRIDBUBBLE-T"
                        "GRIDBUBBLE-R"    "RMNM-NO"
                        "DR-NO"           "WINDOWTYPE"
                        "PARTIONTYPE"     "IDEN"
                       )
              )
         )
       (while
         (not
           (eq (cdr (assoc 0 (entget (setq x (entnext sn))))) "SEQEND")
         )
          (if (eq (cdr (assoc 0 (entget x))) "ATTRIB")
            (vla-delete
              (vlax-ename->vla-object (cdr (assoc -1 (entget x))))
            )
          )
       )
     )
   )
 )
 (princ)
)

Thank you so much!!!

You're welcome any time.

Tharwat,

Is there any significance to the block list being in two columns? I tried adding another block name and is not catching that block. Is there something special I need to do if adding another block name to the list?

Thanks,

Sean

Tharwat,

 

Is there any significance to the block list being in two columns?

No at all , that is something related to Visual Lisp editor formatting way .

Tharwat,

 

Is there any s I tried adding another block name and is not catching that block. Is there something special I need to do if adding another block name to the list?

 

Thanks,

Sean

The Block name must be add as a string with capital letter . e.g. "BLOCK NAME"

Good luck

Thanks I didn't use all caps.

Thanks I didn't use all caps.

Good luck .