Find nested blocks

[marko_ribar]

My version is also simple enough (I only slightly changed my posted link)... And IMHO it's better than Lee's example :

 

 

- my version prints info of type (Xref/Block) is parent/nested...

- my version prints count per insertion...

- my version prints relevant paths if there is/are Xref(s) in DWG...

- my version don't account for insertions that are in database and haven't been inserted in DWG... (With Lee's example if you erase insertion - nesting structure will remain which is wrong all until you purge block... My version will recognize this situations and it will truly represent DWG current structure...)

 

 

If you want to count insertions that are deeply nested - you have to multiply all counts with it's parents counts and perform additions... For this process I suggest that you use Peter J.'s BlockSchedule.lsp you can find on www.augi.com - I'll attach it here along with my version for practical purposes...

 

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Print Xref/Block Nesting ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; http://www.theswamp.org/index.php?topic=28062.msg337119#msg337119
;;; original routine by Tim Willey
;;; major editing by Marko Ribar
;;; Prints nested block tree to command line, no matter how deep the nesting.
;;; edited by Gary Fowler
;;; Added output file with project header and routine progress bar and paths info
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun  c:PrintNestingIT ( / Flatten xrefs-list ARCH:DATE2 mainfilter filter  nestedblockcount FilterNestedBlocks filternested GetBlockNesting n kk k  datestring FileName opened    PrintNestedList projectDesc projectName  ACET:UI-PROGRESS-FACTOR )

 (vl-load-com)

 (defun Flatten ( l )
   (if (atom l) (list l)
     (append (Flatten (car l)) (if (cdr l) (Flatten (cdr l))))
   )
 )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defun xrefs-list nil
   (write-line (strcat "\n List Of Saved Xref Paths:") opened)
   (write-line "----------------------------------------------------------------------" opened)
   (vlax-for
     objFileDep
     (vla-get-filedependencies
       (vla-get-activedocument
         (vlax-get-acad-object)
       )
     )
     (if (= "Acad:XRef" (vla-get-feature objFileDep))
       (write-line
         (strcat " " (vla-get-fullfilename objFileDep))
         opened
       )
     )
   )
 )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defun ARCH:DATE2 (/ DATST MON DAY YEAR HRS MON2 NHRS XTR)
   (setq DATST    (rtos (getvar "CDATE") 2 16)
         MON    (substr DATST 5 2)
         DAY    (substr DATST 7 2)
         YEAR    (substr DATST 1 4)
         HRS    (atoi (substr DATST 10 2))
   )
   (cond
     ( (= MON "01") (setq MON2 "January") )
     ( (= MON "02") (setq MON2 "Feburary") )
     ( (= MON "03") (setq MON2 "March") )
     ( (= MON "04") (setq MON2 "April") )
     ( (= MON "05") (setq MON2 "May") )
     ( (= MON "06") (setq MON2 "June") )
     ( (= MON "07") (setq MON2 "July") )
     ( (= MON "08") (setq MON2 "August") )
     ( (= MON "09") (setq MON2 "September") )
     ( (= MON "10") (setq MON2 "October") )
     ( (= MON "11") (setq MON2 "November") )
     ( (= MON "12") (setq MON2 "December") )
   )
   (cond
     ( (= HRS 00) (setq NHRS (itoa (+ HRS 12))) (setq XTR "a.m.") )
     ( (< HRS 12) (setq NHRS (itoa HRS)) (setq XTR "a.m.") )
     ( (= HRS 12) (setq NHRS (itoa HRS)) (setq XTR "p.m.") )
     ( (> HRS 12) (setq NHRS (itoa (- HRS 12))) (setq XTR "p.m.") )
   )
   (setq datestring (strcat MON2 " " DAY ", " YEAR " " NHRS ":" (substr DATST 12 2) " " XTR))
 )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;    
 (setq    mainfilter
   (getstring
     T
     "\n* Input prefix filter for Main Blocks: 
[*] "
   )
 )
 (if (= mainfilter "")
   (setq mainfilter "*")
 )
 (setq    filter
   (getstring T
       "\n* Input prefix filter for Nested Blocks: 
[*] "
   )
 )
 (if (= filter "")
   (setq filter "*")
 )
 (prompt "* Please Wait while the Program is Running...")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defun nestedblockcount ( mainname nestedname / bl item n )
   (setq bl (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
   (vlax-for item bl
     (if (= (vla-get-name item) mainname)
       (progn
         (setq n 0)
         (vlax-for b item
           (if (= (vl-catch-all-apply 'vla-get-EffectiveName (list b)) nestedname)
             (setq n (1+ n))
           )
         )
       )
     )
   )
   n
 )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;    
 (defun FilterNestedBlocks ( lst mainfilter filter / ifillst inewlst newlst )
   (foreach i lst
     (if (and (atom (car i)) (wcmatch (strcase (cdr (assoc 2 (entget (car i))))) (strcase mainfilter)))
       (progn
         (if (listp (cdr i))
           (progn
             (setq ifillst (filternested (cdr i) filter))
             (setq inewlst (cons (car i) ifillst))
             (setq newlst (cons inewlst newlst))
           )
           (setq newlst (cons i newlst))
         )
       )
     )
   )
   (reverse newlst)
 )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defun filternested ( lst filter / newlst ii )
   (foreach i lst
     (setq ii i)
     (if (not (and (atom (car i)) (wcmatch (strcase (cdr (assoc 2 (entget (car i))))) (strcase filter))))
       (setq ii nil)
     )
     (cond
       ( (if (and (listp (cdr i)) (member (car i) ii)) (filternested (cdr i) filter) (setq ii nil)) )
       ( (and (atom (cdr i)) (not (eq (cdr i) nil)))
         nil
       )
       ( (eq (cdr i) nil) 
         nil
       )
     )
     (setq newlst (cons ii newlst))
   )
   (reverse newlst)
 )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defun GetBlockNesting ( / checknestinserts GetBlockInfo tempData def BlockList objBlocks )

   (defun checknestinserts ( def / f )
     (vlax-for obj def
       (if (= (cdr (assoc 0 (entget (vlax-vla-object->ename obj)))) "INSERT")
         (setq f t)
       )
     )
     f
   )

   (defun GetBlockInfo ( def / uniqueref refl NestList )

     (defun uniqueref ( l )
       (if l (cons (car l) (uniqueref (vl-remove-if '(lambda ( x ) (= (vla-get-name x) (vla-get-name (car l)))) l))))
     )

     (vlax-for obj def
       (if (= (cdr (assoc 0 (entget (vlax-vla-object->ename obj)))) "INSERT")
         (setq refl (cons obj refl))
       )
     )
     (setq refl (reverse refl))
     (setq refl (uniqueref refl))
     (foreach obj refl
       (if (not (checknestinserts (vla-item objBlocks (vla-get-name obj))))
         (setq NestList (cons (list (vlax-vla-object->ename obj)) NestList))
          (setq NestList (cons (cons (vlax-vla-object->ename obj)  (GetBlockInfo (vla-item objBlocks (vla-get-name obj)))) NestList))
       )
     )
     NestList
   )

   (while (setq tempData (tblnext "BLOCK" (not tempData)))
     (if (assoc 102 (entget (cdr (assoc 330 (entget (tblobjname "BLOCK" (cdr (assoc 2 tempData))))))))
       (progn
          (setq def (vla-item (setq objBlocks (vla-get-blocks  (vla-get-activedocument (vlax-get-acad-object)))) (cdr (assoc 2  tempData))))
         (setq names nil name nil)
         (setq BlockList
           (cons
             (cons
               (vlax-vla-object->ename def)
               (GetBlockInfo def)
             )
             BlockList
           )
         )
       )
     )
   )
   BlockList
 )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (setq n 1)
 (ACET-UI-PROGRESS-INIT
   "Please Wait while the Program is Running"
   (length 
     (Flatten
       (progn
         (setq kk nil)
         (foreach k (vl-remove nil (FilterNestedBlocks (GetBlockNesting) mainfilter filter))
           (setq k (vl-remove nil k))
           (setq kk (cons k kk))
         )
         (reverse kk)
       )
     )
   )
 )
 (ARCH:DATE2)
 (setq    FileName (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 4)))
 (setq    opened (open (strcat (getvar "dwgprefix") FileName " PrintNesting.txt") "w"))
 (write-line
   "----------------------------------------------------------------------"
   opened
 )
 (write-line (strcat "        Directory is: [" (getvar "dwgprefix") FileName "]") opened)
 (write-line (strcat "        " datestring) opened)
 (write-line
   "----------------------------------------------------------------------"
   opened
 )

 (defun PrintNestedList ( lst spc mainname / lstn k kk )
    (foreach i (setq lstn (vl-sort lst (function (lambda ( a b ) (<  (strcase (cdr (assoc 2 (entget (car a))))) (strcase (cdr (assoc 2  (entget (car b))))))))))
     (if (and (not (listp (car i))) (car i))
       (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-get-path (list (vlax-ename->vla-object (car i))))))
         (write-line
            (strcat "" spc " Nested xref: " (cdr (assoc 2 (entget (car i)))) " - "  (itoa (nestedblockcount mainname (cdr (assoc 2 (entget (car i)))))))
           opened
         )
         (write-line
            (strcat "" spc " Nested block: " (cdr (assoc 2 (entget (car i)))) " - "  (itoa (nestedblockcount mainname (cdr (assoc 2 (entget (car i)))))))
           opened
         )
       )
       (prompt (strcat "\n" spc " Nested block: nil"))
     )
     (PrintNestedList
       (if (cdr i)
         (cdr i)
         nil
       )
       (strcat "  " spc)
       (cdr (assoc 2 (entget (car i))))
     )
     (ACET-UI-PROGRESS-SAFE n)
     (setq n (1+ n))
   )
   (setq k 0)
   (foreach i lstn
     (setq k (+ k (nestedblockcount mainname (cdr (assoc 2 (entget (car i)))))))
   )
   (if lstn (write-line (strcat spc " *** Total count per branch : " (itoa k) " *** ") opened))
 )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (foreach i
   (vl-sort
     (progn
       (setq kk nil)
       (foreach k (vl-remove nil (FilterNestedBlocks (GetBlockNesting) mainfilter filter))
         (setq k (vl-remove nil k))
         (setq kk (cons k kk))
       )
       (reverse kk)
     )
     (function
       (lambda ( a b )
         (<
           (strcase (cdr (assoc 2 (entget (car a)))))
           (strcase (cdr (assoc 2 (entget (car b)))))
         )
       )
     )
   )
    (if (ssget "_A" (list '(0 . "INSERT") (assoc 2 (entget (car i))) (cons  410 (if (= 1 (getvar 'cvport)) (getvar 'ctab) "Model"))))
     (progn
       (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-get-path (list (vlax-ename->vla-object (car i))))))
         (write-line
            (strcat "\n [ ] Main xref: " (cdr (assoc 2 (entget (car i)))) " - "  (itoa (sslength (ssget "_A" (list '(0 . "INSERT") (assoc 2 (entget (car  i))) (cons 410 (if (= 1 (getvar 'cvport)) (getvar 'ctab) "Model")))))))
           opened
         )
         (write-line
            (strcat "\n [ ] Main block: " (cdr (assoc 2 (entget (car i)))) " - "  (itoa (sslength (ssget "_A" (list '(0 . "INSERT") (assoc 2 (entget (car  i))) (cons 410 (if (= 1 (getvar 'cvport)) (getvar 'ctab) "Model")))))))
           opened
         )
       )
       (ACET-UI-PROGRESS-SAFE n)
       (setq n (1+ n))
       (PrintNestedList
         (if (and (/= (cadr i) nil) (cdr i))
           (vl-remove nil (cdr i))
         )
         "     >"
         (cdr (assoc 2 (entget (car i))))
       )
     )
   )
 )

 (if (> (vla-get-count (vla-get-filedependencies (vla-get-activedocument (vlax-get-acad-object)))) 0)
   (xrefs-list)
 )

 (if Opened
   (close Opened)
 )
 (startapp "notepad.exe"
       (strcat (getvar "dwgprefix")
           FileName
           " PrintNesting.txt"
       )
 )
 (ACET-UI-PROGRESS-DONE)
 (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Regards, M.R.

P.S. I also changed little my previously posted link - I removed Project description sub as I don't think it is needed while checking DWG structure - txt file will be named by DWG name and will be placed in the same folder as DWG... So like R.K. explained you can see nesting structure of DWG and find the way how to approach and more complex DWGs which have big number of references and now you can work and on projects that have exhaustive linking info stored in database...

PrintNestingIT - counter per branches.lsp

BlockSchedule.lsp