QSelect multiple specific blocks

[JCprog]

Hello Everyone!

I need help to modify a simple code that selects a specific block by its effective name. The lisp works perfect on a single entity but I need it to select multiple blocks. Thanks in advance 

(defun c:QSBlocks (/ blkname found objs ss i blk name)
  (vl-load-com)

  (if (and (setq blkname "BLOCK1");Change the name of the block in quotes
           (setq found (tblsearch "BLOCK" blkname))
           (setq objs (ssadd)
                 ss   (ssget "_x" '((0 . "INSERT")))
           )
      )
    (progn
      (repeat
        (setq i (sslength ss))
         (setq name (vla-get-effectivename
                      (vlax-ename->vla-object
                        (setq blk (ssname ss (setq i (1- i))))
                      )
                    )
         )
         (if (eq (strcase blkname) (strcase name))
           (ssadd blk objs)
         )
      )
      (if objs
        (sssetfirst nil objs)
      )
    )
    (cond ((not blkname)
           (princ "\n Missed name of block ***")
          )
          ((not found)
           (princ "\n Block not found in drawing !!!")
          )
          (t
           (princ "\n couldn't find any block !!! ")
          )
    )

  )
  (princ)
)

 I was hoping to be as simple as changing this line:

  (if (and (setq blkname "BLOCK1");Change the name of the block in quotes

 to this:

  (if (and (setq blkname "BLOCK1,BLOCK2,BLOCK3");Change the name of the block in quotes

but that doesnt work as I expected.

[Kent1Cooper]

I think [without testing] that it may work if you make that change [multiple comma-delimited Block names in the blkname variable] and change this:

(if (eq (strcase blkname) (strcase name))

to this:

(if (wcmatch (strcase name) (strcase blkname))

[Note the switch of the order of the (strcase) functions -- (wcmatch) wants the specific string first, then the pattern to match it to.]

[JCprog]

Hello Kent,

Thanks for the reply. tried ur suggestion but it didnt work.

[Kent1Cooper]

---

@JCprog wrote:

Hello Kent,

Thanks for the reply. tried ur suggestion but it didnt work.

---

Tell us more.  What didn't work about it?  Did it do nothing?  Did it do something, but not what you expected?  Did it put values into all of the variables?  Was there a message of any kind?

[dbroad]

You don't need to filter twice,

Change this:

(if (and (setq blkname "BLOCK1");Change the name of the block in quotes
           (setq found (tblsearch "BLOCK" blkname))
           (setq objs (ssadd)
                 ss   (ssget "_x" '((0 . "INSERT")))
           )
      )
    (progn

 to this

(setq blknames (list "BLOCK1""BLOCK2"))
(setq objs (ssadd))
(IF (setq ss (ssget "_x" '((0 . "INSERT"))))
   (progn

 and this:

(if (eq (strcase blkname) (strcase name))
           (ssadd blk objs)
         )
      )

 to this:

(if (member (strcase name) blknames)
           (ssadd blk objs)
         )

 (not tested but should work.  might've missed a parenthesis).

[JCprog]

Hello dbroad,

I did change the code per ur intructions but I get this message "malformed list on input"

[hmsilva · Accepted solution]

Trying to keep your code logic, modified for multiple block names

(defun c:QSBlocks (/ a blkname found lst obj objs ss i blk name)
  (vl-load-com)

  (if (and (setq blkname '("BLOCK1" "BLOCK2" "BLOCK3"));;Change the name of the block in quotes
	   (foreach x blkname
	     (if (member x
			 (while	(setq a (tblnext "BLOCK" (null a)))
			   (setq lst (cons (strcase (cdr (assoc 2 a))) lst))
			   lst
			 )
		 )
	       (setq found (cons x found))
	     )
	     found
	   )
	   (setq objs (ssadd)
		 ss   (ssget "_x" '((0 . "INSERT")))
	   )
      )
    (progn
      (repeat
	(setq i (sslength ss))
	 (setq blk (ssname ss (setq i (1- i))))
	 (setq obj (vlax-ename->vla-object blk))
	 (setq name
		(if (vlax-property-available-p obj 'effectivename)
		  (vla-get-effectivename obj)
		  (vla-get-name obj)
		)
	 )
	 (if (member (strcase name) blkname)
	   (ssadd blk objs)
	 )
      )
      (if objs
	(sssetfirst nil objs)
      )
    )
    (cond ((not blkname)
	   (princ "\n Missed name of block ***")
	  )
	  ((not found)
	   (princ "\n Blocks not found in drawing !!!")
	  )
	  (t
	   (princ "\n couldn't find any block !!! ")
	  )
    )
  )
  (princ)
)

HTH
Henrique

[MetroVancouverDrafting]

Hi,

There is a way easier ways to do it.

here is what I use

(defun GetDynBlNames (name / i ent ss AllNames)
  (setq AllNames "" i 0)
  (if (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat name ",`*U*")))))
    (while (setq ent (ssname ss i))
      (if (eq name (vla-get-EffectiveName (vlax-ename->vla-object ent)))
        (setq AllNames (strcat AllNames ",`"  (dxf 2(entget ent))))
      )
      (setq i (1+ i))
    )
  )
  AllNames
)

 This function reterns all related names.

So now you can use it in other lisp, sometnig like this:

(setq ss (sssget "x" (list (cons 2 (GetDynBlNames "YourBlockName")))))

or

(setq ss (sssget "x" (list (cons 8 "LayerName") (cons 2 (GetDynBlNames "YourBlockName")))))

[dbroad]

Yeah, I did say I might have missed a parenthesis.  I think I took too many away from this

(if (member (strcase name) blknames)
           (ssadd blk objs)
         ))

[JCprog]

Hello Henrique,

Thank you very much for the code it worked perfectly!!!!!! 

Also thanks to all who chipped in.....very much appreciated.

[hmsilva]

---

@JCprog wrote:

Hello Henrique,

Thank you very much for the code it worked perfectly!!!!!! 

---

You're welcome, JCprog
Glad I could help

Henrique

[krazeymike]

Hi all, I'm trying to run the command posted by Henrique.
However while it selects my point crosses fine, my dynamic Contour Labels are not added to the selection set. Could somebody please take a look at the attached please and let me know where I've gone wrong. Thankyou 

[hmsilva]

---

@krazeymike wrote:

Hi all, I'm trying to run the command posted by Henrique.
However while it selects my point crosses fine, my dynamic Contour Labels are not added to the selection set. Could somebody please take a look at the attached please and let me know where I've gone wrong. Thankyou 

---

@krazeymike change

(if (and (setq blkname '("POINT_CROSS" "Label - Contour Minor" "Label - Contour"));;Change the name of the block in quotes

to

 (if (and (setq blkname (mapcar 'strcase '("Label - Contour" "Label - Contour Minor" "POINT_CROSS")));;Change the name of the block in quotes

Hope this helps,
Henrique

[krazeymike]

Worked perfectly thankyou

[hmsilva]

You're welcome, @krazeymike 
Glad I could help

Henrique