Remove Attributes from nested blocks

[jjorovi]

Hi all.

I have a big problem with some attributes that I need remove.
The file attached contain a set of blocks with nested blocks and attributes.
I want to remove all attributes with a window selection and without explode the blocks.

The code below does not remove attributes in nested blocks and some types of attributes are not eliminated at all.

What I can do?

(defun tl_fld (v1 v2) (cdr (assoc v1 v2)))

(defun c:attdel (/	     ss		cnt	   blk

blkdat     blknam	blktblnam  blknewdat

blktbldat  newblkdat	atk_dbug   nextent

nextentdat nextenttyp	endblklst

)

(command "undo" "group")

(setq atk_dbug nil)

;;  (setq atk_dbug T)

(if (setq ss (ssget (list (cons 0 "insert") (cons 66 1))))

(progn

(setq cnt -1)

(repeat (sslength ss)

(setq blk	(ssname ss (setq cnt (1+ cnt)))

blkdat	(entget blk)

blknam	(tl_fld 2 blkdat)

newblknam	(strcat blknam "_na")

blknewdat	(subst (cons 2 newblknam)

(assoc 2 blkdat)

blkdat

)

blknewdat	(subst (cons 66 0)

(assoc 66 blknewdat)

blknewdat

)

)

(if (not (tblsearch "block" newblknam))

(progn

(setq blktblnam (tblobjname "block" blknam)

blktbldat (entget blktblnam)

newblkdat (subst (cons 2 newblknam)

(assoc 2 blktbldat)

blktbldat

)

newblkdat (subst (cons 70 (- (tl_fld 70 blktbldat) 2))

(assoc 70 blktbldat)

newblkdat

)

)

(if	(entmake newblkdat)

(progn

(if atk_dbug

(princ "\nStarting new block definition . . . ")

)

(setq nextent	 (entnext blktblnam)

nextentdat (entget nextent)

nextenttyp (tl_fld 0 nextentdat)

)

(while (and nextenttyp (/= nextenttyp "ENDBLK"))

(if (/= nextenttyp "ATTDEF")

(if	(not (entmake nextentdat))

(princ "\nCan't make subentity.")

(if atk_dbug

(princ (strcat "\nAdding "

nextenttyp

" as subentity "

(itoa xcnt)

)

)

)

)

(if	atk_dbug

(princ "\nSkipping attribute definition.")

)

)

(setq	nextentdat

nil

nextenttyp nil

)

(if (setq nextent (entnext nextent))

(setq

nextentdat (entget nextent)

nextenttyp (tl_fld 0 nextentdat)

)

)

)

(setq endblklst	(list (cons 0 "endblk")

(cons 100 "AcDbBlockEnd")

)

)

(if (not (entmake endblklst))

(princ "\nCan't terminate block definition")

)

)

(princ "\nCan't start new block definition.")

)

)

)

(if (tblsearch "block" newblknam)

(progn

(entdel blk)

(entmake blknewdat)

)

)

)

(setq ss nil)

)

)

(command "undo" "end")

(tl_$tlp)

)