select block with a nested block

[Anonymous]

Hi all

i want to select all block with nested block in it call "grille", but idont know how to do.

can you help me?

thank

[rkmcswain]

Taaz-Ttuj wrote:

i want to select all block with nested block in it call "grille", but idont know how to do.

can you help me?

Take a look at this thread over at the Swamp. Post #3 should contain what you need.

[Anonymous]

Yes i have see that but that return a list af name or i want to select all block and i don't know haow to transform that.

[rkmcswain]

Here is a sample. May not work with dynamic blocks, or blocks nested more than one level deep.

(defun c:foo (/ g blst item sset)
  (setq g "")
  (setq blst (_listofblockswithnestedblock "grille"))
  (if blst
    (progn
      (foreach item blst
        (if (eq g "")
          (setq g item)
          (setq g (strcat g "," item))
        )
      )
      (setq sset (ssget "_X" (list '(0 . "INSERT") (cons 2 g))))
      (vl-cmdf "._erase" sset "")
    )
  )
)

[Anonymous]

Thank you

but for dynamic block can you make it workable?

And can you explain me how it work?

[Moshe-A]

@Anonymous hi,

what do you mean by i want to select a "grille" block with all it's nested blocks?

and what do you want to do with it?

post a sample dwg

moshe

[Anonymous]

I have multiple blocks with different name, in some we can find another block nemed "grille".

i want to select only blocks that inclcude "grill"

[braudpat]

Hello

Please could you indicate that you have already posted in others forums !!

http://cadxp.com/topic/46321-selection-des-blocs-contenant-un-bloc-indexer/

You can post into multiple forums but please give the Info !

Because if a solution is found into one forum then we will not spend our time to find a second solution ...

THE HEALTH, Happy Christmas, Thanks, Regards, Patrice

[Moshe-A]

@Anonymous,

here is the command c:test, you can change it to any name you like.

i know (DatabaseScan) is inefficient but it will work fast as long as your blocks are not so big or very deep. 

look at the first line:

(setq *BNAME* (strcase "grille,other-block-name")) 

you can include as much blocks name as you like by delimited their name with "," - ok? 

enjoy,

moshe

; Load ActivX Support
(vl-load-com)

;;; database object and containers
(setq *acad-object* nil)      ; Initialize global variable
(defun acad-object ()
  (cond (*acad-object*)       ; Return the cached object
    (t
     (setq *acad-object* (vlax-get-acad-object))
    )
  )
)

(setq *active-document* nil)  ; Initialize global variable
(defun active-document ()
  (cond (*active-document*)   ; Return the cached object
    (t
     (setq *active-document* (vla-get-activedocument (acad-object)))
    )
  )
)


(setq *blocks* nil)      ; Initialize global variable
(defun blocks ()
  (cond (*blocks*)       ; Return the cached object
    (t
     (setq *blocks* (vla-get-blocks (active-document)))
    )
  )
)

(setq *activeSelectionSet* nil)      ; Initialize global variable
(defun activeSelectionSet ()
  (cond (*activeSelectionSet*)       ; Return the cached object
    (t
     (setq *activeSelectionSet* (vla-get-ActiveSelectionSet (active-document)))
    )
  )
)

; select block references according nested 'grille' block name
; support dynamic block
(defun c:test (/ isXRef databaseScan ; local functions
	         *BNAME* ss0 ss1 lst0 lst1 bn bname bnames AcDbEntity)

 (defun isXRef (blk / AcDbBlockTableRecord)
  (and 
   (setq AcDbBlockTableRecord (vla-item (blocks) blk))
   (eq (vla-get-isXRef AcDbBlockTableRecord) :vlax-true)
  )
 ); isXRef
  
 (defun DatabaseScan (bname / flag blk)
  (cond 
   ((wcmatch (strcase bname) *BNAME*)
    (setq flag t)
   )
   ( t
    (vlax-for AcDbEntity (vla-item (blocks) bname) 
     (if (and
          (eq (vla-get-objectName AcDbEntity) "AcDbBlockReference")
          (wcmatch (strcase (setq blk (vla-get-effectivename AcDbEntity))) *BNAME*)
	  (not (isXRef blk)); deny xref
         )
      (setq flag t)
     ); if
      
     (vlax-release-object AcDbEntity)
    ); vlax-for
   ); case
  ); cond

  flag
 ); DatabaseScan

 ; here start command
 (setq *BNAME* (strcase "grille,other-block-name")) 
  
 (if (setq ss0 (ssget '((0 . "insert"))))
  (progn
   (setq lst0 '())
   (vlax-for AcDbEntity (activeSelectionSet)
    (if (not (isXRef (setq bn (vla-get-effectivename AcDbEntity)))) ; deny xref
     (setq lst0 (cons bn lst0))
    )

    (vlax-release-object AcDbEntity)
   ); vlax-for
   
   ; remove duplicate items
   (setq lst1 '())
   (foreach bn lst0
    (if (not (member bn lst1))
     (setq lst1 (cons bn lst1))
    )
   ); foreach

   (setq bnames "")
   (foreach bn lst1
    (if (DatabaseScan bn)
     (setq bnames (strcat bnames bn ","))
    )
   ); foreach
   
   (if (/= bnames "")
    (progn
     (setq bnames (substr bnames 1 (1- (strlen bnames)))) ; remove last ","
     (if (setq ss1 (ssget "x" (list '(0 . "insert") (cons '2 bnames))))
      (sssetfirst ss1 ss1)
      (prompt "\nNoting found.")
     )
    ); progn
   ); if
   
  ); progn
 ); if

 (princ)
); c:test

[Anonymous]

Thank you

It's beautiful, if you have a bit of time can you mark some comments for i
can understand and learn to do by myself.


I much appreciate your help. Thanks a lot.

[Moshe-A]

@Anonymous,

here you are

; Load ActivX Support
(vl-load-com)

;;; database object and containers
(setq *acad-object* nil)      ; Initialize global variable
(defun acad-object ()
  (cond (*acad-object*)       ; Return the cached object
    (t
     (setq *acad-object* (vlax-get-acad-object))
    )
  )
)

; return a pointer to active document
(setq *active-document* nil)  ; Initialize global variable
(defun active-document ()
  (cond (*active-document*)   ; Return the cached object
    (t
     (setq *active-document* (vla-get-activedocument (acad-object)))
    )
  )
)

; return a pointer to block records
(setq *blocks* nil)      ; Initialize global variable
(defun blocks ()
  (cond (*blocks*)       ; Return the cached object
    (t
     (setq *blocks* (vla-get-blocks (active-document)))
    )
  )
)

; return a pointer to active selection set
(setq *activeSelectionSet* nil)      ; Initialize global variable
(defun activeSelectionSet ()
  (cond (*activeSelectionSet*)       ; Return the cached object
    (t
     (setq *activeSelectionSet* (vla-get-ActiveSelectionSet (active-document)))
    )
  )
)

; select block references according nested 'grille' block name
; support dynamic block
(defun c:test (/ isXRef databaseScan ; local functions declaration
	         *BNAME* ss0 ss1 lst0 lst1 bn bname bnames AcDbEntity ;| local variables declaration |;)

 ; return T(true) if block is an xref otherwise return nil
 (defun isXRef (blk / AcDbBlockTableRecord)
  (and 
   (setq AcDbBlockTableRecord (vla-item (blocks) blk))
   (eq (vla-get-isXRef AcDbBlockTableRecord) :vlax-true)
  )
 ); isXRef

 ; return T(true) if nested block if found otherwise return nil
 (defun DatabaseScan (bname / flag blk)
  (cond 
   ((wcmatch (strcase bname) *BNAME*)
    (setq flag t) ; header block is match the finding
   )
   ( t
    (vlax-for AcDbEntity (vla-item (blocks) bname) 
     (if (and
          (eq (vla-get-objectName AcDbEntity) "AcDbBlockReference")
          (wcmatch (strcase (setq blk (vla-get-effectivename AcDbEntity))) *BNAME*)
	  ; call local function
	  (not (isXRef blk)); deny xref
         )
      (setq flag t) ; nested block if found
     ); if
      
     (vlax-release-object AcDbEntity) ; dispose object memory
    ); vlax-for
   ); case
  ); cond

  flag ; return
 ); DatabaseScan

 ; here start C:TEST command
 (setq *BNAME* (strcase "grille,other-block-name")) ; set global block names to search
  
 (if (setq ss0 (ssget '((0 . "insert")))) ; pause for user select objects filter only block references (insert)
  (progn
   ; build list of header block names 
   (setq lst0 '()) ; Initialize list
   ; next lines is a loop
   (vlax-for AcDbEntity (activeSelectionSet)
    (if ; call local function
        (not (isXRef (setq bn (vla-get-effectivename AcDbEntity)))) ; deny xref
     (setq lst0 (cons bn lst0))
    )

    (vlax-release-object AcDbEntity) ; dispose object memory
   ); vlax-for
   
   ; remove duplicate items from list lst0 define new list as lst1
   (setq lst1 '()); Initialize list
   ; next lines is a loop
   (foreach bn lst0
    (if (not (member bn lst1))
     (setq lst1 (cons bn lst1))
    )
   ); foreach

   ; construct a list of blocks name as one string delimited by ","
   (setq bnames "") ; Initialize string
   ; next lines is a loop
   (foreach bn lst1
    (if (DatabaseScan bn) ; call local function
     (setq bnames (strcat bnames bn ",")) ; concatinate strings
    )
   ); foreach
   
   (if (/= bnames "") ; is there findings?
    (progn
     (setq bnames (substr bnames 1 (1- (strlen bnames)))) ; remove last ","
     (if (setq ss1 (ssget "x" (list '(0 . "insert") (cons '2 bnames)))) ; excute select objects (no user pause) filter by blocks name in question
      (sssetfirst ss1 ss1)        ; highligh + select blocks on screen
      (prompt "\nNoting found.")  ; send when noting found 
     )
    ); progn
   ); if
   
  ); progn
 ); if

 (princ) ; clean exit to autocad command line window
); c:test

[Anonymous]

Thanks a lot for your help

[Moshe-A · Accepted solution]

does it work?

please close this thread and mark it as your solution.

[Moshe-A · Accepted solution]

@Anonymous,

After a night sleep i realised that it does not deep search nested blocks plus does not really handle dynamic blocks so here is the fix and hope it will work.

; Load ActivX Support
(vl-load-com)

;;; database object and containers
(setq *acad-object* nil)      ; Initialize global variable
(defun acad-object ()
  (cond (*acad-object*)       ; Return the cached object
    (t
     (setq *acad-object* (vlax-get-acad-object))
    )
  )
)

; return a pointer to active document
(setq *active-document* nil)  ; Initialize global variable
(defun active-document ()
  (cond (*active-document*)   ; Return the cached object
    (t
     (setq *active-document* (vla-get-activedocument (acad-object)))
    )
  )
)


; return a pointer to block records
(setq *blocks* nil)      ; Initialize global variable
(defun blocks ()
  (cond (*blocks*)       ; Return the cached object
    (t
     (setq *blocks* (vla-get-blocks (active-document)))
    )
  )
)

; select block references according nested 'grille' block name
; support dynamic block
(defun c:test (/ isXRef databaseScan is-match ; local functions declaration
	         *BNAME* ss0 ss1 ss2 lst0 lst1 bn blk bname bnames bnames^ AcDbEntity AcDbBlockReference ;| local variables declaration |;)

 ; return T(true) if block is an xref otherwise return nil
 (defun isXRef (blk / AcDbBlockTableRecord)
  (and 
   (setq AcDbBlockTableRecord (vla-item (blocks) blk))
   (eq (vla-get-isXRef AcDbBlockTableRecord) :vlax-true)
   (vlax-release-object AcDbBlockTableRecord) ; dispose memory
  )
 ); isXRef
  
 (defun DatabaseScan (bname / build_list ; local function
		               blk)

  (defun build_list (bn)
   (if (not (member (strcase bn) bnames^))
    (setq bnames^ (cons (strcase bn) bnames^))
   )
  ); build_list

  (build_list bname)
   
  (vlax-for AcDbEntity (vla-item (blocks) bname)
   (if (and
        (eq (vla-get-objectName AcDbEntity) "AcDbBlockReference")
        (setq blk (vla-get-effectivename AcDbEntity))
        ; call local function
        (not (isXRef blk)); deny xref
       )
    (progn
     (build_list blk)
     (DatabaseScan blk) ; recursion call
    ); progn
   ); if

   (vlax-release-object AcDbEntity) ; dispose memory
  ); vlax-for
 ); DatabaseScan
  
 ; return T if match found
 (defun is-match (lst / bn)
  (vl-some
    '(lambda (bn)
      (wcmatch bn *BNAME*) 
     )
   lst
  )
 ); is-applicable
  
 ; here start C:TEST command
 ; const,  ; set global block names to search
 (setq *BNAME* (strcase "grille,other-block-name"))
  
 (if (setq ss0 (ssget '((0 . "insert")))) ; pause for user select objects filter only block references (insert)
  (progn
   ; build list of header block names 
   (setq lst0 '()) ; Initialize list
   ; next lines is a loop
   (vlax-for AcDbEntity (vla-get-ActiveSelectionSet (active-document))
    (if ; call local function
        (not (isXRef (setq bn (vla-get-effectivename AcDbEntity)))) ; deny xref
     (setq lst0 (cons bn lst0))
    )

    (vlax-release-object AcDbEntity) ; dispose object memory
   ); vlax-for
   
   ; remove duplicate items from list lst0 define new list as lst1
   (setq lst1 '()); Initialize list
   ; next lines is a loop
   (foreach bn lst0
    (if (not (member bn lst1))
     (setq lst1 (cons bn lst1))
    )
   ); foreach
   
   ; construct a list of blocks name as one string delimited by ","
   (setq bnames "") ; Initialize string
   ; next lines is a loop
   (foreach bn lst1
    (setq bnames^ '())
    (DatabaseScan bn)
    
    (foreach blk bnames^
     (if (and
	  (is-match bnames^)
          (not (vl-string-search (strcase blk) bnames))
	 )
      (setq bnames (strcat bnames blk ",")) ; concatinate strings
     )
    )
   ); foreach
  
   (if (eq bnames "") ; is there findings?
    (prompt "\nNoting found.")  ; echo noting found 
    (progn
     (setq bnames (substr bnames 1 (1- (strlen bnames)))) ; remove last ","
     ; excute select objects (no user pause) filter by blocks in question
     (if (not (setq ss1 (ssget "x" (list '(0 . "insert") (cons '2 bnames) (cons '410 (getvar "ctab"))))))
      (setq ss1 (ssadd))
     )
      
     ; excute select objects (no user pause) filter by dynamic blocks
     (setq ss2 (ssget "x" (list '(0 . "insert") '(2 . "`*u*") (cons '410 (getvar "ctab")))))
     ; next lines is a loop	   
     (foreach ename (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss2)))	   
      (setq AcDbBlockReference (vlax-ename->vla-object ename)) ; allocating memory
      (if (vl-string-search (strcase (vla-get-effectivename AcDbBlockReference)) bnames)
       (ssadd ename ss1)
      )

      (vlax-release-object AcDbBlockReference) ; dispose memory
     ); foreach

     (if (> (sslength ss1) 0)
      (sssetfirst ss1 ss1)        ; highligh + select blocks on screen
      (prompt "\nNoting found.")  ; echo noting found 
     )
    ); progn
   ); if
   
  ); progn
 ); if

 (princ) ; clean exit to autocad command line window
); c:test

[Anonymous]

Thank you so much

[patrick_35 · Accepted solution]

Hi

I just saw that you got a solution for your problem.
I still give the link to my solution because it proposes another way of doing things.

@+