Change from select one to select all?

[stev98312]

Found this a while back and it works perfectly.
I have modified it a wee bit to suit my accasional needs.

-HOWEVER-

The drawings I'm working on now, from another company, each have hundreds of these to remove, but the one-at-a-time manner of this program as written is not very efficient in this scenario. The attribute must be removed to facilitate follow-on processing.

Is there a way to easily modify this to check each block(insert) and, for each that has this attribute, remove the attribute from all of them in one go?

; found @ 
; forums.augi.com/showthread.php?94696-Deleting-an-attribute-from-a-block&highlight=attdel
; posted by inerb

; Modified by Greg B. to allow spaces for block name and attribute tag
;
; Modified again by SteveJ to allow block selection and automatic (hard-coded)
; attribute tag name for use on several objects with the same
; attribute to remove.
;
;;; Command to delete an attribute from a block
;
;;; Delete an attribute from a block

(defun c:ATTDEL (/ blkname attname bn bd en ed attlst)

;;; wedge - 
 (setq blkname (vla-get-effectivename (vlax-ename->vla-object (car (entsel "\nSelect block: ")))))

;;;  Ask user for block name  
;;;  (setq blkname (getstring "\nEnter the block's name: "))
;;   Check if block exists

  (if (setq bn (tblobjname "BLOCK" blkname))
    (progn
      ;; Get list of attributes
      (setq bd     (entget bn) ;Block def's data
            en     (cdr (assoc -2 bd)) ;1st entity insie block
            attlst nil ;Initialize list to empty
      ) ;_ end of setq
      (while en ;Step through all entities in block
        (setq ed (entget en)) ;Get entity's data
        ;; Check if entity is an attribute definition
        (if (= "ATTDEF" (cdr (assoc 0 ed)))
          ;; Add to list of attributes
          (setq attlst (cons (cons (strcase (cdr (assoc 2 ed))) (vlax-ename->vla-object en)) attlst))
        ) ;_ end of if
        (setq en (entnext en)) ;Get next entity
      ) ;_ end of while

      ;; Ask user for attribute tag name
;;;    (setq attname (getstring "\nEnter the attribute Tag Name: "))

;;; PUT YOUR ATTRIBUTE TAG IN THE FOLLOWING LINE BETWEEN THE QUOTES
	  (setq attname "POLYGONDATA") 

      ;; Check if attribute exists
      (if (setq en (assoc (strcase attname) attlst))
        (progn
          (setq ed (cdr en)) ;Get the VLA object of the attribute
          (vla-Delete ed)
          (princ
            "\nAttribute successfully deleted from block definition.\nSynchronizing block references ..."
          ) ;_ end of princ
          (command "_.ATTSYNC" "_Name" blkname)
        ) ;_ end of progn
        (princ "\nThat Attribute doesn't exist in this block reference. Exiting ...")
      ) ;_ end of if
    ) ;_ end of progn
    (princ "\nThat Block doesn't exist in this drawing. Exiting ...")
  ) ;_ end of if
  (princ)
) ;_ end of defun
;(c:ATTDEL);; for testing

Thanks for any help and ideas,
Steve

[Sea-Haven]

(setq blkname (vla-get-effectivename (vlax-ename->vla-object (car (entsel "\nSelect block: ")))))

 So you are asking for multiple block names, is that correct and do you know their names ?

[stev98312]

There is currently no need to enter a block name and I'd like to keep it that way.

Each block name is made by a different program and is typically 14 or 15 characters, so entering each block name for the hundreds on a drawing would just be burdensome.

The program currently does not ask for a block name, but asks only that the block reference be selected.

What would work best is the program check all block references in turn ( I guess a while loop, but I don't know how to incorporate) and if the specific TAG is found, then delete that attribute and move to the next block reference.

Steve

[calderg1000 · Accepted solution]

Regards @stev98312 

Try this code, modified to select several blocks at once and evaluate them if they meet the specified condition...

; found @ 
; forums.augi.com/showthread.php?94696-Deleting-an-attribute-from-a-block&highlight=attdel
; posted by inerb
; Modified by Greg B. to allow spaces for block name and attribute tag
;
; Modified again by SteveJ to allow block selection and automatic (hard-coded)
; attribute tag name for use on several objects with the same
; attribute to remove.
;
;;; Command to delete an attribute from a block
;
;;; Delete an attribute from a block
;;; Edit by calderg1000@mail.com, 10-01-23
;;;___
(defun c:ATTDEL (/ blkname attname bn bd en ed attlst)
;;; wedge - 
;;; (setq blkname (vla-get-effectivename (vlax-ename->vla-object (car (entsel "\nSelect block: ")))))
  (setq sblk(ssget '((0 . "insert"))))
  (repeat (setq i (sslength sblk))
    (setq blkname (vla-get-effectivename (vlax-ename->vla-object (ssname sblk (setq i(1- i))))))
;;;  Ask user for block name  
;;;  (setq blkname (getstring "\nEnter the block's name: "))
;;   Check if block exists
  (if (setq bn (tblobjname "BLOCK" blkname))
    (progn
      ;; Get list of attributes
      (setq bd     (entget bn) ;Block def's data
            en     (cdr (assoc -2 bd)) ;1st entity insie block
            attlst nil ;Initialize list to empty
      ) ;_ end of setq
      (while en ;Step through all entities in block
        (setq ed (entget en)) ;Get entity's data
        ;; Check if entity is an attribute definition
        (if (= "ATTDEF" (cdr (assoc 0 ed)))
          ;; Add to list of attributes
          (setq attlst (cons (cons (strcase (cdr (assoc 2 ed))) (vlax-ename->vla-object en)) attlst))
        ) ;_ end of if
        (setq en (entnext en)) ;Get next entity
      ) ;_ end of while
      ;; Ask user for attribute tag name
;;;    (setq attname (getstring "\nEnter the attribute Tag Name: "))
;;; PUT YOUR ATTRIBUTE TAG IN THE FOLLOWING LINE BETWEEN THE QUOTES
	  (setq attname "POLYGONDATA") 
      ;; Check if attribute exists
      (if (setq en (assoc (strcase attname) attlst))
        (progn
          (setq ed (cdr en)) ;Get the VLA object of the attribute
          (vla-Delete ed)
          (princ
            "\nAttribute successfully deleted from block definition.\nSynchronizing block references ..."
          ) ;_ end of princ
          (command "_.ATTSYNC" "_Name" blkname)
        ) ;_ end of progn
        (princ "\nThat Attribute doesn't exist in this block reference. Exiting ...")
      ) ;_ end of if
    ) ;_ end of progn
    (princ "\nThat Block doesn't exist in this drawing. Exiting ...")
  ) ;_ end of if
    )
  (princ)
) ;_ end of defun
;(c:ATTDEL);; for testing

[stev98312]

@calderg1000 

After your changes, this program work exactly as needed.

I have another program written by @Kent1Cooper  (BWST.LSP) that selects blocks with specified tags. It is modified to select all block references with that tag

Then, with this modified program run immediately after, the offending tags are removed from all those blocks selected by that program. This is a definite win.

I think I'll try to combine them.

Thank you,

Steve

[paullimapa · Accepted solution]

Try this modified version which will automatically cycle through the entire Block table to search for and delete found matching attribute tag (although I don't know why there would be so many Blocks with different names but have the same attribute tag):

; AttDel deletes specific attribute matching tag name from all blocks
; found @ 
; forums.augi.com/showthread.php?94696-Deleting-an-attribute-from-a-block&highlight=attdel
; posted by inerb

; Modified by Greg B. to allow spaces for block name and attribute tag
;
; Modified again by SteveJ to allow block selection and automatic (hard-coded)
; attribute tag name for use on several objects with the same
; attribute to remove.
;
; Modified again by Paul Li to cycle through all blocks in current drawing 
; OP:
; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/change-from-select-one-to-select-all/m-p/12489956#M460265

(defun c:ATTDEL (/ attname blkname en flg index items obj)
;;; PUT YOUR ATTRIBUTE TAG IN THE FOLLOWING LINE BETWEEN THE QUOTES
 (setq attname "POLYGONDATA") 
; check if there are blocks in dwg
 (if (tblnext "BLOCK" (not tmp))
  (progn
; loop through block table
   (while (setq tmp (tblnext "BLOCK" (not tmp)))
    (setq blkname (cdr (assoc 2 tmp))) ; get block name
; create list of items within block
    (setq items nil)
    (vlax-for item 
     (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) blkname)
     (setq items (cons (vlax-vla-object->ename item) items))
    )
    (setq index 0)
; cycle through objects
    (repeat (length items)
     (setq en (nth index items))
     (setq obj (vlax-ename->vla-object en)) 
     (if (and (= (cdr (assoc 0 (entget en))) "ATTDEF") (= (strcase(vla-get-TagString obj)) (strcase attname)))
      (progn ; when matching tag found
       (setq flg T)
       (vla-Delete obj) ; delete attribute
      )
     ) ; if        
     (setq index (+ index 1))
    ) ; repeat
    (if flg ; if matching tag found
     (progn ; then
      (princ
       (strcat
       "\nAttribute [" attname "] successfully deleted... synchronizing Block: [" blkname "]\n"
       )
      ) ;_ end of princ
      (vl-cmdf "_.ATTSYNC" "_Name" blkname)
      (setq flg nil) ; reset flg
     ) ; progn
     (princ  ; else princ
      (strcat
      "\nAttribute [" attname "] doesn't exist in Block: [" blkname "]"
      )
     )
    ) ; if 
   ) ; while
   (vl-cmdf"_.Regen") ; refresh screen
  ) ; progn
  (princ"\nDrawing has no Blocks.")
 ) ; if
 (princ) ; clean exit
) ;_ end of defun
;(c:ATTDEL);; for testing

[stev98312]

@paullimapa 

Your version of the program works perfectly. Thank you.

"so many Blocks with different names but have the same attribute tag"

The Autocad drawings we make are for a Navy application that shipboard personnel use. Each block reference must have a different block number, even for duplicated items. Each block has the same list of attributes whose data is unique to that particular block, but sometimes, when work is done by others, they sometimes feel the need to add their own attributes to the block definition, and those attributes need to be removed to facilitate follow-on processing, as the attributes and data are extracted and put into a SQL database for use by the end application, so block numbers must not be duplicated.

Yeah. It's a nightmare sometimes.

Thanks again,

Steve

[paullimapa]

Thanks for the detailed explanation and glad that I could help…cheers!!!