Topic: Another selection method question

[EddieFromDc]

Hello again,

I receive dwgs from a client that does not use autocad. The way that program insert
blocks is that it gives it a random name every time it inserts it (even though its the same block)
..ex 1AD3C_PC_GROUP, 1BDD4_PC_GROUP. The problem is that all blocks are all in one layer. I
dont know if its a translation issue or just bad drafting. I need to select certain blocks & put it in
a seperate layer.

The block has text in it (not attributes)....Has anyone come up yet with a lisp program that can
select blocks that has a certain "text" string in it? Maybe text and attribute?

[CAB]

Would a partial block name help with the selection?

Code: [Select]

(setq ss (ssget '((2 . "*_PC_GROUP"))))

[EddieFromDc]

Hi Cab,

No. I forget to mention all  block names end with "_PC_GROUP". No block
will have the same name. I tried to use "ssx" but it only gave me one
selection....Thanks Cab

[CAB]

Well a simple selection won't do. You will need select potential blocks and then iterate through the block to find matching text.

[T.Willey]

Well a simple selection won't do. You will need select potential blocks and then iterate through the block to find matching text.

Or get the text string, and then search through the block collection, and build a filter list of the block names.  This way your selection will only allow those blocks that you desire to be selected.

[CAB]

You can give this a test drive. Modeled after Tim's suggestion. 

Code: [Select]

;;  CAB  12/12/2008
;;  Find Text within blocks and selects the inserts
;; set the variable IgnoreCase as desired
(defun c:BlockTextFind (/ txt adoc blk obj BlockNameList ss filter)
  (vl-load-com)
  (setq IgnoreCase t)
  (if (setq txt (getstring t "\nEnter text to find."))
    (progn
      (and IgnoreCase (setq txt (strcase txt)))
      (setq ss (ssadd))
      (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
      (vlax-for blk (vla-get-blocks adoc)
        ;; Exclude model and paper spaces, xref and anonymus blocks
        (if (and (equal (vla-get-IsLayout blk) :vlax-false)
                 (equal (vla-get-IsXref blk) :vlax-false)
                 (/= (substr (vla-get-Name blk) 1 1) "*")
            )
          (vlax-for obj blk
            (if (and (vl-position (vla-get-objectname obj) '("AcDbText" "AcDbMText"))
                     (= txt
                        (if IgnoreCase
                          (strcase (vla-get-textstring obj))
                          (vla-get-textstring obj)))
                )
              (setq BlockNameList (cons (vla-get-name blk) BlockNameList))
            )
          )
        )
      )
    )
  )
  (if BlockNameList
    (progn
      (setq filter "")
      (mapcar '(lambda (x) (setq filter (strcat filter x ","))) BlockNameList)
      ;;  get matching blocks in current space
      (and (setq ss (ssget "_X" (list (cons 2 filter) (cons 410 (getvar "ctab")))))
           (sssetfirst nil ss)
      )
    )
    (prompt "\nNo matching blocks found.")
  )
  (princ)
)<edit: Fixed Mtext error>

[EddieFromDc]

Cab,

Thank you very much! Works exactly the way I want it to....Could you please do me a favor
when you get the chance. You & Tim kindda gave me some ideas earlier so I made several
attemps to write the program (I'm a beginner) & got stuck. Could you please help me with "ssadd".


(defun C:Test ( / txt ss sslen cnt ename entdata blkname tempent nextent tempnext)
(setq Txt (getstring "\nEnter string to search in blocks: "))
(setq ss (ssget "x" '((0 . "INSERT"))))
(setq cnt 0)
(setq sslen (sslength ss))
(while (< cnt sslen)
       (setq ename (ssname ss cnt))
       (setq entdata (entget ename))
       (setq blkname (cdr (assoc 2 entdata)))
       (setq tempent (tblobjname "block" blkname))
       (setq nextent (entnext tempent))
       (setq tempnext (entget nextent))
       (if (= (cdr (assoc 1 tempnext)) Txt) (progn

                                                        ;This is where I wanted to use ssadd to collect the blocks

                                                         )
       )
(setq cnt (1+ cnt))
)
)

[CAB]

Glad we could help.
Make sure you initialize a selection set before adding to it.

Code: [Select]

(defun C:Test (/ txt ss sslen cnt ename entdata blkname tempent nextent tempnext)
  (setq Txt (getstring "\nEnter string to search in blocks: "))
  (setq ss (ssget "x" '((0 . "INSERT"))))
  (setq cnt 0
        ss2 (ssadd) ; initialize the selection set  ***
  )
  (setq sslen (sslength ss))
  (while (< cnt sslen)
    (setq ename (ssname ss cnt))
    (setq entdata (entget ename))
    (setq blkname (cdr (assoc 2 entdata)))
    (setq tempent (tblobjname "block" blkname))
    (setq nextent (entnext tempent))
    (setq tempnext (entget nextent))
    (if (= (cdr (assoc 1 tempnext)) Txt)
      (ssadd ename ss2) ; add to the selection set  ***
    )
    (setq cnt (1+ cnt))
  )
)

[T.Willey]

Alan,

  Another way to do it, since you are selecting all the blocks, in the code you posted based off my idea, is to just get all the block inserts from the block definition without a selection set.  Also you had a mis-type in your if statement here

Code: [Select]

(if (and (vl-position (vla-get-objectname obj) '("AcDbText" "AcDbText"))I think it should be

Code: [Select]

(if (and (vl-position (vla-get-objectname obj) '("AcDbText" "AcDbMText"))
Just another way to the skin a cat on a friday. 

[CAB]

Thanks Tim, good catch. I updated the code.

[CAB]

Alan,

  Another way to do it, since you are selecting all the blocks, in the code you posted based off my idea, is to just get all the block inserts from the block definition without a selection set. 
Just another way to the skin a cat on a friday. 

I was being lazy as I wanted only current space inserts. 

[T.Willey]

Alan,

  Another way to do it, since you are selecting all the blocks, in the code you posted based off my idea, is to just get all the block inserts from the block definition without a selection set. 
Just another way to the skin a cat on a friday. 

I was being lazy as I wanted only current space inserts. 

Maybe I should of read it better, as I didn't notice the filter for the current tab.  Since it is in there, nevermind my other part of the post.

[T.Willey]

All this talking made me what you write some code.  Here is a sub function that will return a selection of ( empty or not ) of the blocks that contain a certain string in either text or mtext within the definition.  Now before you go bitting my head off.  I figured that there wasn't going to be a string within an mtext entity that is long than 256 characters within a block.  That case can be rectified, but I just didn't code for it now.  It will also let you pass a string name for the space desired to grab within ( maybe it could be list, so that more than one space could be passed ) or nil for all spaces.  Hope that isn't confusing.  Well here is the code.

Case is ignored in both arguments.

Code: [Select]

(defun GetSsBlockByString (str spaceName / ss BlkEntData tempEnt tempData tempInsList)
   
    (setq ss (ssadd))
    (while (setq BlkEntData (tblnext "block" (not BlkEntData)))
        (setq tempEnt (cdr (assoc -2 BlkEntData)))
        (while tempEnt
            (setq tempData (entget tempEnt))
            (if
                (and
                    (not (wcmatch (cdr (assoc 2 BlkEntData)) "*|*"))
                    (member (cdr (assoc 0 tempData)) '("TEXT" "MTEXT"))
                    (wcmatch (strcase (cdr (assoc 1 tempData))) (strcase (strcat "*" str "*")))
                    (setq tempData (entget (tblobjname "block" (cdr (assoc 2 BlkEntData)))))
                    (setq tempInsList
                        (cdr
                            (member
                                '(102 . "{BLKREFS")
                                (entget
                                    (cdr
                                        (assoc
                                            330
                                            (entget
                                                (tblobjname "block" (cdr (assoc 2 tempData)))
                                            )
                                        )
                                    )
                                )
                            )
                        )
                    )
                    (setq tempInsList (cdr (member '(102 . "}") (reverse tempInsList))))
                    (not (setq tempEnt nil))
                )
                (foreach i tempInsList
                    (if spaceName
                        (if (= (strcase spaceName) (strcase (cdr (assoc 410 (entget (cdr i))))))
                            (ssadd (cdr i) ss)
                        )
                        (ssadd (cdr i) ss)
                    )
                )
                (setq tempEnt (entnext tempEnt))
            )
        )
    )
    ss
)


[CAB]

You having coding withdrawal?
Nice code Tim.

All we need to do now is add attributes in the string match.

[CAB]

Me too.

Code: [Select]

;;  CAB  12/12/2008  version 1.1
;;  Find Text within blocks and selects the inserts
;;  set the variable IgnoreCase as desired
;;  http://www.theswamp.org/index.php?topic=26368.msg318197#msg318197
(defun c:BlockTextFind (/ txt adoc blk obj BlockNameList ss filter)
  (vl-load-com)
  (setq IgnoreCase t) ; this can be globle
  (if (setq txt (getstring t "\nEnter text to find."))
    (progn
      (and IgnoreCase (setq txt (strcase txt)))
      (setq ss (ssadd))
      (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
      (vlax-for blk (vla-get-blocks adoc) ; in the drawing
        ;; Exclude model and paper spaces, xref and anonymus blocks
        (if (and (equal (vla-get-IsLayout blk) :vlax-false)
                 (equal (vla-get-IsXref blk) :vlax-false)
                 (/= (substr (vla-get-Name blk) 1 1) "*")
            )
          (vlax-for obj blk ; in the block definition
            (if (and (vl-position (vla-get-objectname obj) '("AcDbText" "AcDbMText")) ; removed "AcDbAttributeDefinition"))
                     (= txt
                        (if IgnoreCase
                          (strcase (vla-get-textstring obj))
                          (vla-get-textstring obj)))
                     (not (vl-position (vla-get-name blk) BlockNameList))
                )
              (setq BlockNameList (cons (vla-get-name blk) BlockNameList))
            )
          )
        )
      )
    )
  )
  (if BlockNameList
    (progn
      (setq filter "")
      (mapcar '(lambda (x) (setq filter (strcat filter x ","))) BlockNameList)
      ;;  get matching blocks in current space
      (and (setq ss (ssget "_X" (list (cons 2 filter) (cons 410 (getvar "ctab")))))
           (sssetfirst nil ss)
      )
    )
    (prompt "\nNo matching blocks found.")
  )
  (princ)
)
<edit: removed attributes >