Topic: Nested Xref Counter in Tree Format

[GDF]

Here is the final version. Special thanks to Marko!

Example of print out file:

======================================================================
        Project Name : [Merritt Lakeside Sr Village]
        Directory is: [F:\Jobs\2009\091138\acad\building\BL-Profile2]
        December 13, 2011 7:19 p.m.
======================================================================

 [X] Parent Drawing: BL-Profile2
    [ ] Main Xref: BL-01          = 2 Count
       [ ] Nested Xref: Key    = 1 Count
       [ ] Nested Xref: UTA2    = 6 Count
       [ ] Nested Xref: UTA3    = 6 Count
       [ ] Nested Xref: UTA5    = 3 Count
       [ ] Nested Xref: UTB1    = 3 Count
       [ ] Nested Xref: UTB3b    = 6 Count
       [ ] Nested Xref: UTB3c    = 6 Count
       [ ] Nested Xref: UTB4a    = 6 Count
       [ ] Nested Xref: UTB4b    = 6 Count
           -----------------------------------------------
           Total Nested per each Main Xref      = 43 Count

    [ ] Main Xref: BL-02          = 2 Count
       [ ] Nested Xref: Key    = 1 Count
       [ ] Nested Xref: UTA3    = 6 Count
       [ ] Nested Xref: UTA5    = 3 Count
       [ ] Nested Xref: UTB1    = 3 Count
       [ ] Nested Xref: UTB3a    = 6 Count
       [ ] Nested Xref: UTB4b    = 6 Count
       [ ] Nested Xref: UTB4c    = 6 Count
           -----------------------------------------------
           Total Nested per each Main Xref      = 31 Count

    [ ] Main Xref: BL-CLUB          = 1 Count

 List Of Saved Xref Paths:
======================================================================
 F:\Jobs\2009\091138\ACAD\building\BL-01.dwg
 F:\Jobs\2009\091138\ACAD\building\BL-02.dwg
 F:\Jobs\2009\091138\ACAD\club\BL-CLUB.dwg
 F:\Jobs\2009\091138\ACAD\units\UTA2.dwg
 F:\Jobs\2009\091138\ACAD\units\UTB1.dwg
 F:\Jobs\2009\091138\ACAD\units\UTA5.dwg
 F:\Jobs\2009\091138\ACAD\units\UTB3b.dwg
 F:\Jobs\2009\091138\ACAD\units\UTB4b.dwg
 F:\Jobs\2009\091138\ACAD\units\UTB4a.dwg
 F:\Jobs\2009\091138\ACAD\units\UTA3.dwg
 F:\Jobs\2009\091138\ACAD\units\UTB3c.dwg
 F:\Jobs\2009\091138\acad\building\Key.dwg
 F:\Jobs\2009\091138\ACAD\units\UTB4c.dwg
 F:\Jobs\2009\091138\ACAD\units\UTB3a.dwg

Updated code:

Code: [Select]

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Project Name Function ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ARCH:ProjectName (/)   
  (setq ARCH#PROJ (nth 3 (ARCH:Split (getvar "dwgprefix") "\\")))
  (cond ((/= (atoi ARCH#PROJ) 0) (setvar "users1" ARCH#PROJ)))
  (cond ((/= (getvar "users1") 0)
   (setq ARCH#PNAM
  (dos_getini
    "PROJECTS"
    (getvar "users1")
    (strcat ARCH#CUSF "FILE/ARCH_Projects.ini")
  )
   )
  )
  )   
  (princ)
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Date Function ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ARCH:DATE2 (/ DATST MON DAY YEAR HRS)
    (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 ARCH#DATE ;datestring
   (strcat MON2
   " "
   DAY
   ", "
   YEAR
   " "
   NHRS
   ":"
   (substr DATST 12 2)
   " "
   XTR
   )
    )
  )


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Print Xref Nesting ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; original routine by Tim Willey
;;; prints nested xref tree to command line, no matter how deep the nesting.
;;; http://www.theswamp.org/index.php?topic=28062.msg337119#msg337119
;;;
;;; major editing and rewrite by Marko Ribar
;;; edited by Gary Fowler
;;; added output file with project header and routine progress bar and xref paths
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun PrintXrefNestingIT  (/ mainfilter filter opened projectDesc projectName datestring n)
  (vl-load-com)
  (princ "\n*** ------ Print Xref Nested Routine ----- ***")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Sub Routines ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; External routines: (ARCH:DATE2) and (ARCH:ProjectName)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun Flatten  (l)
    (if (atom l)
      (list l)
      (append (Flatten (car l))
              (if (cdr l)
                (Flatten (cdr l))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;; Function: xrefs-list
  ;; Purpose: get information regarding xrefs
  ;; Arguments: none
  ;; Returns: rtlist - a list of lists, one for each xref, as follows:
  ;; (nth 0 (car rtlist)) = filename
  ;; (nth 1 (car rtlist)) = fullfilename
  ;; (nth 2 (car rtlist)) = foundpath
  ;; (nth 3 (car rtlist)) = ismodified - vlax:true/vlax:false
  ;; (nth 4 (car rtlist)) = reference count
  ;; by Mike Weaver
  (defun xrefs-list  (/ rtlist)
    (vl-load-com)
    (write-line (strcat "\n List Of Saved Xref Paths:") opened)
    (write-line
      (strcat
        "======================================================================")
      opened)
    (vlax-for
           objFileDep  (vla-get-filedependencies
                         (vla-get-activedocument (vlax-get-acad-object)))
      (if (= "Acad:XRef" (vla-get-feature objFileDep))
        (setq rtlist
               (cons
                 (cons
                   (vla-get-filename objFileDep)
                   ;;(list
                   ;;(vla-get-fullfilename objFileDep)
                   ;;(vla-get-foundpath objFileDep)
                   ;;(vla-get-ismodified objFileDep)
                   ;;(vla-get-referencecount objFileDep)
                   ;;)
                   (write-line (strcat " " (vla-get-fullfilename objFileDep)) opened))
                 rtlist))))
    rtlist)
  ;;(foreach i rtlist (write-line (strcat " " (nth 1 (car rtlist))) opened))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Main Routine ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;   
  (setq mainfilter (getstring T "\n* Input prefix filter for Main Xrefs: [*] "))
  (if (= mainfilter "")
    (setq mainfilter "*"))
  (setq filter (getstring T "\n* Input prefix filter for Nested Xrefs: [*] "))
  (if (= filter "")
    (setq filter "*"))
  (prompt "* Please Wait while the Program is Running...")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun nestedxrefcount  (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
                 xr  item
            (if (= (vl-catch-all-apply 'vla-get-EffectiveName (list xr)) nestedname)
              (setq n (1+ n)))))))
    n)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun FilterNestedXrefs  (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 (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))) ())
            ((eq (cdr i) nil) nil))
      (setq newlst (cons ii newlst)))
    (reverse newlst))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun GetXrefNesting  (/ tempData tempEnt XrefList NonNestedXrefList NestedXrefList)
    (defun GetXrefInfo  (ent / NestList)
      (foreach
             i  (member '(102 . "{BLKREFS") (entget ent))
        (if (equal (car i) 332)
          (progn (setq NestedList (cons (cdr i) NestedList))
                 (setq NestList (cons (cons (cdr i) (GetXrefInfo (cdr i))) NestList)))))
      NestList)
    (while (setq tempData (tblnext "block" (not tempData)))
      (if (equal (logand (cdr (assoc 70 tempData)) 4) 4)
        (progn (setq tempEnt (tblobjname "block" (cdr (assoc 2 tempData))))
               (setq tempEnt (cdr (assoc 330 (entget tempEnt))))
               (setq XrefList (cons (cons tempEnt (GetXrefInfo tempEnt)) XrefList)))))
    (foreach
           i  XrefList
      (if (not (member (car i) NestedList))
        (setq NonNestedXrefList (cons i NonNestedXrefList))))
    NonNestedXrefList)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (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 (FilterNestedXrefs (GetXrefNesting) mainfilter filter))
            (setq k (vl-remove nil k))
            (setq kk (cons k kk)))
          (reverse kk)))))
  (ARCH:DATE2)
  (ARCH:ProjectName)
  (setq FileName (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 4)))
  (setq Opened (open (strcat (getvar "dwgprefix")
                             "Arch "
                             ARCH#PROJ
                             " "
                             FileName
                             " PrintXrefNesting.txt")
                     "w"))
  (write-line
    "======================================================================"
    opened)
  (cond ((= ARCH#PNAM nil) (setq ProjectDesc ""))
        ((/= ARCH#PNAM nil)
         (setq projectDesc (strcat "        Project Name : [" ARCH#PNAM "]"))))
  (write-line projectDesc opened)
  (write-line
    (strcat "        Directory is: [" (getvar "dwgprefix") FileName "]")
    opened)
  (write-line (strcat "        " ARCH#DATE) opened) ;DATE-STRING
  (write-line
    "======================================================================"
    opened)
  (write-line (strcat "\n [X] Parent Drawing: " FileName) 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))
        (write-line
          (strcat ""
                  spc
                  " Nested Xref: "
                  (cdr (assoc 2 (entget (car i))))
                  "\t = "
                  (itoa (nestedxrefcount mainname (cdr (assoc 2 (entget (car i))))))
                  " Count")
          opened)
        (prompt (strcat "\n" spc " Nested Xref: nil")))
      (PrintNestedList
        (if (cdr i)
          (cdr i)
          nil)
        (strcat "  " spc)
        (cdr (assoc 2 (entget (car i)))))
      (ACET-UI-PROGRESS-SAFE n)
      (setq n (+ n 1)))
    (setq k 0)
    (foreach
           i  lstn
      (setq k (+ k (nestedxrefcount mainname (cdr (assoc 2 (entget (car i))))))))
    (progn (if lstn
             (write-line
               "           -----------------------------------------------"
               opened))
           (if lstn
             (write-line
               (strcat "           Total Nested per each Main Xref      = "
                       (itoa k)
                       " Count\n")
               opened))
           ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;   
  (foreach
         i
         (vl-sort
           (progn (setq kk nil)
                  (foreach
                         k  (vl-remove
                              nil
                              (FilterNestedXrefs (GetXrefNesting) 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)))))))))
    (write-line
      (strcat "    [ ] Main Xref: "
              (cdr (assoc 2 (entget (car i))))
              "\t\t\t = "
              (itoa (sslength
                      (ssget "_X"
                             (list '(0 . "INSERT")
                                   (assoc 2 (entget (car i)))
                                   (cons 410 (getvar 'ctab))))))
              " Count")
      opened)
    (ACET-UI-PROGRESS-SAFE n)
    (setq n (+ n 1))
    (PrintNestedList
      (if (and (/= (cadr i) nil) (cdr i))
        (vl-remove nil (cdr i))
        nil)
      "       [ ]"
      (cdr (assoc 2 (entget (car i))))))
  (xrefs-list)
  (if Opened
    (close Opened))
  (startapp
    "notepad.exe"
    (strcat (getvar "dwgprefix")
            "Arch "
            ARCH#PROJ
            " "
            FileName
            " PrintXrefNesting.txt"))
  (ACET-UI-PROGRESS-DONE)
  (princ))
(vl-load-com)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(princ)


[ribarm]

Gary, I would still suggest you that you use this line for count sum :

Code: [Select]

(if lstn (write-line (strcat spc " *** Total count per branch : " (itoa k) " *** ") opened))

Imagine that you don't have only one branch of Xrefs like this :
----------------------------------------------------------------------
        Directory is: [C:\Documents and Settings\Marica\Desktop\xrefs\xrefss]
        December 14, 2011 12:06 p.m.
----------------------------------------------------------------------

 [ ] Main xref: xrefs2 - 1
     > Nested xref: Drawing2 - 1
       > Nested xref: ex2 - 3
         > Nested xref: ex4 - 2
         > *** Total count per branch : 2 ***
       > *** Total count per branch : 3 ***
     > Nested xref: Drawing3 - 1
     > Nested xref: Drawing4 - 1
     > *** Total count per branch : 3 ***

 [ ] Main xref: xrefs3 - 1
     > Nested xref: Drawing1 - 2
       > Nested xref: ex1 - 2
         > Nested xref: ex3 - 1
         > Nested xref: ex4 - 1
         > *** Total count per branch : 2 ***
       > Nested xref: ex2 - 1
         > Nested xref: ex4 - 2
         > *** Total count per branch : 2 ***
       > *** Total count per branch : 3 ***
     > Nested xref: Drawing2 - 1
       > Nested xref: ex2 - 3
         > Nested xref: ex4 - 2
         > *** Total count per branch : 2 ***
       > *** Total count per branch : 3 ***
     > Nested xref: Drawing3 - 1
     > Nested xref: Drawing4 - 1
     > *** Total count per branch : 5 ***

 List Of Saved Xref Paths:
----------------------------------------------------------------------
 C:\Documents and Settings\Marica\Desktop\xrefs\xrefs3.dwg
 C:\Documents and Settings\Marica\Desktop\xrefs\xrefs2.dwg
 C:\Documents and Settings\Marica\Desktop\xrefs\Drawing1.dwg
 C:\Documents and Settings\Marica\Desktop\xrefs\Drawing3.dwg
 C:\Documents and Settings\Marica\Desktop\xrefs\Drawing4.dwg
 C:\Documents and Settings\Marica\Desktop\xrefs\Drawing2.dwg
 C:\Documents and Settings\Marica\Desktop\xrefs\ex1.dwg
 C:\Documents and Settings\Marica\Desktop\xrefs\ex2.dwg
 C:\Documents and Settings\Marica\Desktop\xrefs\ex3.dwg
 C:\Documents and Settings\Marica\Desktop\xrefs\ex4.dwg

In this case, this way of summing counter would be more appropriate... I will update my code above...

M.R.

[GDF]

Thanks again...it's almost beer Friday...

[Koenig]

Hi guys, this is looking exactly like the tool i've been looking for, for a long time now. I'm currently employed at a company that produces modular housing units, which means a lot of x-ref work i acad.

To ease the process of summing up the different elements used in each unit, i'd like to implement your work with this programming, but being a novice at lisps and programming, i have no idea how to make this work.
Please guide me and help me elliminate the slave work of counting elements 'by hand'?

And ofc, a wish of happy hollidays to you all.

Rune Christensen,
BM Byggeindustri, Hobro
Denmark

[ribarm]

I removed sub with showing project description - not necessary for my needs...

Here is *.lsp that should work on all CAD environments...
Use APPLOAD command and select *.lsp ... Execution is : PRINTXREFNESTINGIT

Code: [Select]

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Print Xref Nesting ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; http://www.theswamp.org/index.php?topic=28062.msg337119#msg337119
;;; original routine by Tim Willey
;;; major editing by Marko Ribar
;;; Prints nested xref 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 xref paths
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:PrintXrefNestingIT ( / Flatten xrefs-list ARCH:DATE2 mainfilter filter nestedxrefcount FilterNestedXrefs filternested GetXrefNesting 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 Xrefs: [*] "
    )
  )
  (if (= mainfilter "")
    (setq mainfilter "*")
  )
  (setq filter
    (getstring T
        "\n* Input prefix filter for Nested Xrefs: [*] "
    )
  )
  (if (= filter "")
    (setq filter "*")
  )
  (prompt "* Please Wait while the Program is Running...")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun nestedxrefcount ( 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 xr item
            (if (= (vl-catch-all-apply 'vla-get-EffectiveName (list xr)) nestedname)
              (setq n (1+ n))
            )
          )
        )
      )
    )
    n
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun FilterNestedXrefs ( 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 GetXrefNesting ( / GetXrefInfo tempData tempEnt XrefList NonNestedXrefList NestedXrefList NestedList )

    (defun GetXrefInfo ( ent / NestList )
      (foreach i (member '(102 . "{BLKREFS") (entget ent))
        (if (equal (car i) 332)
          (progn
            (setq NestedList (cons (cdr i) NestedList))
            (setq NestList
              (cons
                (cons
                  (cdr i)
                  (GetXrefInfo (cdr i))
                )
                NestList
              )
            )
          )
        )
      )
      NestList
    )

    (while (setq tempData (tblnext "block" (not tempData)))
      (if (equal (logand (cdr (assoc 70 tempData)) 4) 4)
        (progn
          (setq tempEnt (tblobjname "block" (cdr (assoc 2 tempData))))
          (setq tempEnt (cdr (assoc 330 (entget tempEnt))))
          (setq XrefList
            (cons
              (cons
                tempEnt
                (GetXrefInfo tempEnt)
              )
              XrefList
            )
          )
        )
      )
    )
    XrefList
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (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 (FilterNestedXrefs (GetXrefNesting) 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 " PrintXrefNesting.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))
        (write-line
          (strcat "" spc " Nested xref: " (cdr (assoc 2 (entget (car i)))) " - " (itoa (nestedxrefcount mainname (cdr (assoc 2 (entget (car i)))))))
          opened
        )
        (prompt (strcat "\n" spc " Nested xref: 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 (nestedxrefcount 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 (FilterNestedXrefs (GetXrefNesting) 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
        (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
        )
        (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
    " PrintXrefNesting.txt"
    )
  )
  (ACET-UI-PROGRESS-DONE)
  (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Regards, M.R.

[Koenig]

It works and it is exactly what i was looking for. Thanks guys! This lisp just removed a lot of slavework from my job and added a nice system om element-management.

Best wishes for a great 2012 for you all.

[GDF]

Update code for xref nesting with my personal filters and formatting of the print out file with added text padding. I know there is a better more cleaner way of coding this. My personal xrefs print out results are only needed two levels deep. The main reason being to count up the unit plans per building plan within an overall "profile" building with multiple buildings.

The padding format for the text print out is only to pretty up the printed results. Thanks again to Marko for his help. The updated code will of course have to be modified to work for your environment. I have included the updated code and a printed test example.

Gary

[ribarm]

Inspired by Lee's blockhierarchy.lsp, I developed further more Xref nesting to account and for nesting of blocks...

http://www.cadtutor.net/forum/showthread.php?48702-Find-nested-blocks/page3&p=#21

HTH., M.R.