Leave only one block if multiple are present

Hello everybody,

I am looking for a routine which can find a specific block in a drawing and if there are more blocks with the same name to delete all except one.

I am running a lisp over multiple drawings, which is changing the attributes of certain blocks depending on the "key" of that drawing. So the key is the block which should be present only once in those drawings, otherwise all the calculations in the code are getting nuts.

Those keys can be anywhere in the drawing, meaning they are not on top of each other or with identical insertion point.

Any ideas will be highly appreciated.

Totally untested and probably dangerous :

[b][color=BLACK]([/color][/b]defun c:foo [b][color=FUCHSIA]([/color][/b]/ bn b ss en i[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]not bn[b][color=NAVY])[/color][/b]
   [b][color=NAVY]([/color][/b]setq b [b][color=MAROON]([/color][/b]strcase [b][color=GREEN]([/color][/b]getstring [color=#2f4f4f]"\nBLOCK Name:   "[/color][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
   [b][color=NAVY]([/color][/b]cond [b][color=MAROON]([/color][/b][b][color=GREEN]([/color][/b]not [b][color=BLUE]([/color][/b]snvalid b[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
         [b][color=MAROON]([/color][/b][b][color=GREEN]([/color][/b]not [b][color=BLUE]([/color][/b]tblsearch [color=#2f4f4f]"BLOCK"[/color] b[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
         [b][color=MAROON]([/color][/b][b][color=GREEN]([/color][/b]setq ss [b][color=BLUE]([/color][/b]ssget [color=#2f4f4f]"X"[/color] [b][color=RED]([/color][/b]list [b][color=PURPLE]([/color][/b]cons 0 [color=#2f4f4f]"INSERT"[/color][b][color=PURPLE])[/color][/b][b][color=PURPLE]([/color][/b]cons 2 b[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
         [b][color=MAROON]([/color][/b][b][color=GREEN]([/color][/b]setq bn b[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq i 0[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]setq en [b][color=MAROON]([/color][/b]ssname ss i[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]if [b][color=MAROON]([/color][/b]/= i 0[b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]entdel en[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]setq i [b][color=MAROON]([/color][/b]1+ i[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

And probably totally useless with dynamic blocks.

-David

Thanks for your replay David,

I am afraid that this code will not work in mode I am working. All the processing in my code is done over a multiple drawings in background where ssget selection is not possible.

Davids code will work over multiple dwgs with no interaction just need to take a different approach.

C:foo implies type at keyboard so 2 choices (defun foo then (foo) or (c:foo) will work from keyboard or in a script

You can hard code the block name or ask once and save say to a text file. (setq b

Using a script it will change multiple dwgs. I expect thats what your doing now. If not please explain how your doing it.

Bigal,

thank you for appearing on the horizon.

Some more information indeed might be useful.

Here is a part of the code for which I am looking for a solution.

(setq *acad (vlax-get-acad-object)
docx  (vla-get-activedocument *acad)    
doc (vla-getinterfaceobject *acad (if (< (setq acVer (atoi (getvar "ACADVER"))) 16)
       "ObjectDBX.AxDbDocument" (strcat "ObjectDBX.AxDbDocument." (itoa acVer))))
dwgs files
     dwgs (vl-sort dwgs '<)
)
 
(foreach dwg dwgs;for each dwg of the dwgs list
 (setq dprefix (vl-filename-directory dwg))
 (setq emsg (vl-catch-all-apply '(lambda ()
 (vla-open doc dwg :vlax-false)
      (setq my_doc  (vla-get-activedocument (vlax-get-acad-object)))
			  
(if (= drawing "1")				  
     (progn 
     (vlax-for layout (vla-get-layouts doc)
     (vlax-for ent (vla-get-block layout)



   (if (and (vlax-property-available-p ent 'hasattributes)
        (eq (vla-get-name ent) bname_dwg))
(progn
  (setq atts (vlax-invoke ent 'getattributes))
		(foreach att atts
			(if (= (vla-get-tagstring att) tag_dwg)
				(progn
					(setq edit t)
					(vla-put-textstring att val_dwg)
					(setq key_dwg (vla-get-textstring att))
					(setq val_dwg (itoa (+ (atoi val_dwg) _inc) ))

				)
			)
		)
)
 
   )
)))
);end if
; here i call another function to change the tag
(if (= TAG_EMPLOYER "1") 
(replace_tags "DWG_" "EMPLOYER#" "B" "Sheet1" key_dwg 1))			    
 ))))

I use this part to find a block with tag in a list of drawings after user selection and change the value with increment, but if there are more than one block with that name and tag the counter will increase every time it finds it.

The general purpose is linking drawings with an excel sheet, containing name and revision for each drawing. The link is made with a unique block in each drawing - changing the tag of the block (the "key") will be the reference to the name and revision in the sheet.

So if this counter doesn't work properly it will cause a mistake in all of numbering of the following drawings.

Hope this makes the idea more clear to everybody.

How do you determine which blocks should be deleted? Keeping the first block, as in the code below, may not always be a good idea.

(vlax-for layout (vla-get-layouts doc)
 (setq found nil)
 (vlax-for ent (vla-get-block layout)
   (if
     (and
       (eq (vla-get-name ent) bname_dwg)
       (vlax-property-available-p ent 'hasattributes) ; Required?
     )
     (if found
       (vla-delete ent) ; Already found one so delete.
       (progn
         (setq found T)
         ... ; Do your stuff.
       )
     )
   )
 )
)

Thanks Roy_043,

Implementing your idea and setting back found to nil after each drawing does the trick.

It works great now and I have one less thing to check when I run my code.

I love this forum:D

I would've wrote it like this (well basically just like roy did):

(defun C:test ( / CADapp Docs BlkNms )
(setq CADapp (vlax-get-acad-object))
(setq Docs (vla-get-Documents CADapp))
(vlax-for doc Docs
	(vlax-for blk (vla-get-Blocks doc)
		(if
			(and
				(eq (vla-get-IsLayout blk) :vlax-false)
				(eq (vla-get-IsDynamicBlock blk) :vlax-false)
				(eq (vla-get-IsXRef blk) :vlax-false)
			)
			(setq BlkNms (cons (vla-get-Name blk) BlkNms))
		)
	); iterate blkdefs
	(vlax-for layout (vla-get-Layouts doc)
		(vlax-for obj (vla-get-Block layout)
			(if
				(and
					(= (vla-get-ObjectName obj) "AcDbBlockReference")
					(not (vl-remove (vla-get-EffectiveName obj) BlkNms)) ; first block that remove its name from this list is NOT deleted
				)
				(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-delete (list obj)))
					(progn
						(vla-put-Lock (vla-item (vla-get-Layers doc) (vla-get-Layer obj)) :vlax-false)
						(vl-catch-all-error-p (vl-catch-all-apply 'vla-delete (list obj)))
					); progn
				); if
			); if
		); iterate graphical objects
	); iterate tabs
); iterate docs		
(princ)
);| defun |; (vl-load-com) (princ)

Now I'm thinking about including a prompt using (getfiled) and invoking (vla-open) on the Documents Collection.

@Grrr: I think your code does not work as intended. Have you tested it?

@Roy its completely untested, after having a second look at it I shouldn't include this row ( I even don't remember that I added it - LOL ) :

(eq (vla-get-IsDynamicBlock blk) :vlax-false)

Maybe I had to change it to:

(eq (vla-get-HasAttributes blk) :vlax-false)

Also it doesn't match this criteria:

Those keys can be anywhere in the drawing, meaning they are not on top of each other or with identical insertion point.

I don't know if you are refering to some other problem.

@Grrr: the main problem I see is with the blkNms list.

Suggestion:

...
(vlax-for doc docs
 (setq blkNms nil)
 ...
 (if (vl-postion ... blkNms)
   (progn
     (setq blkNms (vl-remove ... blkNms))
     ...
   )
 )
 ...
)
...

@Roy,

I see the problem now! I had serious lacks in the code I posted.. I even thought that vl-remove would return nil if the element to remove is not member of the list, but I was wrong:

_$ (setq Lst '("A" "B" "C" "D" "E" "F"))
("A" "B" "C" "D" "E" "F")
_$ (vl-remove "N" Lst)
("A" "B" "C" "D" "E" "F")
_$ (vl-remove "D" Lst)
("A" "B" "C" "E" "F")
_$ 

Thanks!