Find and Select Blocks by Attribute AutoLisp

[Stephen.Purk]

Hello, I'm trying to use a find and select function specifically for blocks. It works by asking you for whatever attribute is in the block and then it selects that block along with any other block that shares the same attribute. I augmented this code to do that but I need it to any block with a similar name and it my code can only find the exact string you type. So instead of FVC226H1, I want to type in FVC and it just highlights the block with the prior attribute. 

Here's what I got: 

;; Block Selection  -  Lee Mac
;; Selects all blocks in the current layout with a given block name or which contain a specified attribute tag and/or value.

(defun c:bsap ( / att atx blk cnt ent enx flg idx sel str tag )
    (setq blk (strcase "")
          tag (strcase "")
          str (strcase (getstring t (strcat "\nSpecify Tool ID" (if (= "" tag blk) ": " " <any>: "))))
    )
    (if (not (= "" str tag blk))
        (if
            (and
                (setq sel
                    (ssget "_X"
                        (append
                           '((000 . "INSERT"))
                            (if (not (= "" tag str)) '((066 . 1)))
                            (if (/= "" blk) (list (cons 2 (strcat "`*U*," blk))))
                            (if (= 1 (getvar 'cvport))
                                (list (cons 410 (getvar 'ctab)))
                               '((410 . "Model"))
                            )
                        )
                    )
                )
                (progn
                    (repeat (setq idx (sslength sel))
                        (setq ent (ssname sel (setq idx (1- idx)))
                              enx (entget ent)
                        )
                        (cond
                            (   (not (or (= "" blk) (wcmatch (strcase (LM:name->effectivename (cdr (assoc 2 enx)))) blk)))
                                (ssdel ent sel)
                            )
                            (   (member (cdr (assoc 66 enx)) '(nil 0)))
                            (   (progn
                                    (setq att (entnext ent)
                                          atx (entget  att)
                                          flg nil
                                    )
                                    (while
                                        (and (= "ATTRIB" (cdr (assoc 0 atx)))
                                            (not
                                                (and
                                                    (or (= "" str) (wcmatch (strcase (cdr (assoc 1 atx))) str))
                                                    (or (= "" tag) (wcmatch (strcase (cdr (assoc 2 atx))) tag))
                                                )
                                            )
                                        )
                                        (setq att (entnext att)
                                              atx (entget  att)
                                        )
                                    )
                                    (= "SEQEND" (cdr (assoc 0 atx)))
                                )
                                (ssdel ent sel)
                            )
                        )
                    )
                    (< 0 (setq cnt (sslength sel)))
                )
            )
            (progn
                (princ (strcat "\n" (itoa cnt) " block" (if (= 1 cnt) "" "s") " found."))
                (sssetfirst nil sel)
            )
            (princ "\nNo blocks found.")
        )
    )
    (princ)
)

;; Block Name -> Effective Block Name  -  Lee Mac
;; blk - [str] Block name

(defun LM:name->effectivename ( blk / rep )
    (if
        (and (wcmatch blk "`**")
            (setq rep
                (cdadr
                    (assoc -3
                        (entget
                            (cdr (assoc 330 (entget (tblobjname "block" blk))))
                           '("acdbblockrepbtag")
                        )
                    )
                )
            )
            (setq rep (handent (cdr (assoc 1005 rep))))
        )
        (cdr (assoc 2 (entget rep)))
        blk
    )
)

(princ)
 

Like 

Hope someone can help...

[ronjonp]

@Stephen.Purk 

If you're using WCMATCH you need to supply the search string as FVC* 

Alternatively you can use the built in FIND command and check 'Use wildcards'

[Stephen.Purk]

Thankyou but I want to expedite the process for the office space. It would just make things much easier.

[ВeekeeCZ]

You can also try THIS  from CadStudio. See video HERE 

[ronjonp · Accepted solution]

@Stephen.Purk 

See below:

FWIW, You should also take off Lee's name off of this or put a note at top that you've made a bunch of edits. I know it irks him when people mangle his code then ask for help fixing it.

[Stephen.Purk]

Oh my god, it worked! Thankyou so much! 

Also I tried removing the blk and tag strings, but the code wouldn't work unless I change it to not use those strings and I'm still pretty much a beginner. So I found it much easier to just set the blk and tag variables to be nothing by default. 

And sorry yes, I didn't want to remove his name because I don't like stealing but I see your point. I'll put in heavily augmented by Stephen Purk in my new code. 

Again, thankyou so much!

[ronjonp]

Glad to help! 🙂

It looks like you don't care about block names, just the values found? I have a feeling this code could be pared down quite a bit. Are these only attributes or text as well ?

[Stephen.Purk]

just the value, I would've simplified but im very new to lisp

[ronjonp]

@Stephen.Purk 

Here's a quick refactor of the code to remove the unnecessary parts and I added an option to have exact match or wild card. Enjoy!

(defun c:bsap (/ cnt ent idx sel str)
  (if (and (/= "" (setq str (strcase (getstring t "\nSpecify Tool ID: "))))
	   (setq sel (ssget "_X" '((0 . "INSERT") (66 . 1))))
      )
    (progn (initget 1 "Y N")
	   (setq str (cond ((= "N" (getkword "\nExact match:<N>")) (strcat "*" str "*"))
			   (str)
		     )
	   )
	   (repeat (setq idx (sslength sel))
	     (setq ent (ssname sel (setq idx (1- idx))))
	     (or (vl-some '(lambda (x) (wcmatch (strcase (vla-get-textstring x)) str))
			  (vlax-invoke (vlax-ename->vla-object ent) 'getattributes)
		 )
		 (ssdel ent sel)
	     )
	   )
	   (if (< 0 (setq cnt (sslength sel)))
	     (progn (princ (strcat "\n"
				   (itoa cnt)
				   " block"
				   (if (= 1 cnt)
				     ""
				     "s"
				   )
				   " found."
			   )
		    )
		    (sssetfirst nil sel)
	     )
	     (princ "\nNo blocks found.")
	   )
    )
  )
  (princ)
)

[Stephen.Purk]

thankyou