Author Topic: Nested Xref Counter in Tree Format  (Read 14190 times)

0 Members and 1 Guest are viewing this topic.

GDF

  • Water Moccasin
  • Posts: 2081
Nested Xref Counter in Tree Format
« on: December 09, 2011, 11:06:54 AM »
Need help with modifing Tim Willey's code to add a xref counter for each nested xref and print it in a tree format as per his code.

Code can be found here:
http://www.theswamp.org/index.php?topic=34277.msg409437#msg409437

Need to list all xrefs named "BL*" found with model space of the opened drawing:
Then list and count all nested xrefs named "UT*" within each of the xrefs listed above:

Example of text screen:
Code: [Select]
Main xref: BL-02b
  |- Nested xref: UT-B2a_985hc
  |- Nested xref: UT-B2b_985
  |- Nested xref: UT-B2c_985
  |- Nested xref: UT-B2d_985
 Main xref: BL-04
  |- Nested xref: UT-A1a_760hc
  |- Nested xref: UT-A1b_760
  |- Nested xref: UT-A1c_760
  |- Nested xref: UT-A1d_760
  |- Nested xref: UT-A2a_760
  |- Nested xref: UT-A2b_760
  |- Nested xref: UT-A2c_760
  |- Nested xref: UT-A2d_760
  |- Nested xref: UT-B1b_985
  |- Nested xref: UT-B1c_985
  |- Nested xref: UT-B1d_985
  |- Nested xref: UT-B3a_985
  |- Nested xref: UT-B3b_985
  |- Nested xref: UT-B3c_985
  |- Nested xref: UT-B3d_985
  |- Nested xref: UTB-GAR
« Last Edit: December 12, 2011, 10:55:31 PM by GDF »
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Nested Xref Counter in Tree Format
« Reply #1 on: December 09, 2011, 01:27:09 PM »
Not tested, but try something like this way :
EDIT: Code tested
Code: [Select]
(defun c:PrintXrefNesting ( / mainfilter filter )
    ; Prints nested xref tree to command line, no matter how deep the nesting.
    (setq mainfilter (getstring T "\nInput prefix filter for Main Xrefs : "))
    (setq filter (getstring T "\nInput prefix filter for Nested Xrefs : "))

    (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     ((listp (cdr i)) (filternested (cdr i) filter))
                ((and (atom (cdr i)) (wcmatch (strcase (cdr (assoc 2 (entget (cdr i))))) (strcase filter))) () (setq ii 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
    )
    ;------------------------------------------------
    (defun PrintNestedList ( lst spc )
        (foreach
            i
            (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)) (prompt (strcat "\n" spc " Nested xref: " (cdr (assoc 2 (entget (car i)))))) (prompt (strcat "\n" spc " Nested xref: nil" )) )
            (PrintNestedList (if (cdr i) (cdr i) nil) (strcat "  " spc))
            ;(PrintNestedList (cdr i) (strcat "  |" spc)) [color=red]; second option shown below[/color]
        )
    )
    ;-----------------------------------------------------
   
    (foreach
        i
        (vl-sort
            (FilterNestedXrefs (GetXrefNesting) mainfilter filter)
            (function
                (lambda ( a b )
                    (<
                        (strcase (cdr (assoc 2 (entget (car a)))))
                        (strcase (cdr (assoc 2 (entget (car b)))))
                    )
                )
            )
        )
        (prompt (strcat "\n Main xref: " (cdr (assoc 2 (entget (car i)))) " - " (itoa (sslength (ssget "_X" (list '(0 . "INSERT") (assoc 2 (entget (car i))) (cons 410 (getvar 'ctab)))))) ))
        (PrintNestedList (if (and (/= (cadr i) nil) (cdr i)) (vl-remove nil (cdr i)) nil) "  |-")
    )
    (princ)
)

M.R.
« Last Edit: December 12, 2011, 08:50:42 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

GDF

  • Water Moccasin
  • Posts: 2081
Re: Nested Xref Counter in Tree Format
« Reply #2 on: December 09, 2011, 02:35:24 PM »
Thanks Marko. I get nil when entering the filters from your code.
The filters are not really needed, but would be nice to have.

My main question was how to add a counter for the total number for each xref and nested xref found.
Something like:
(defun C:UTC (/ ent_count)
  (setq ent_count (sslength (ssget "a" '((2 . "*UT*")(8 . "0-XREF")))))
  (alert (strcat (rtos ent_count 2 0) " Total Units"))
  (princ)
)
(defun C:BLC (/ ent_count)
  (setq ent_count (sslength (ssget "a" '((2 . "*BL*")(8 . "0-XREF")))))
  (alert (strcat (rtos ent_count 2 0) " Total Buildings"))
  (princ)
)

But in Tim's tree format code. for example:

[1]  Main xref: BL-01a                         
  [2]  |- Nested xref: UT-A1a_760hc
  [4]  |- Nested xref: UT-A1b_760
  [1]  | - Nested xref: UT-A1c_760

  ...and so on.
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

GDF

  • Water Moccasin
  • Posts: 2081
Re: Nested Xref Counter in Tree Format
« Reply #3 on: December 09, 2011, 04:37:28 PM »
;;;http://www.theswamp.org/index.php?topic=28062.msg337119#msg337119
;;;Tim Willey

In this example the main xref is counted...I want to also count the nested xrefs within the list.
So how do I modify the code below to count all xrefs, main and nested?

Code: [Select]
(defun c:test ()

(defun GetXrefs (/ tempData tempEnt XrefList)   
    (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 tempData (entget (cdr (assoc 330 (entget tempEnt)))))
                (setq XrefList
                    (cons
                        (cons
                            tempEnt
                            (
                                (lambda ( x / InsList NestList )
                                    (foreach i x
                                        (cond
                                            ((equal (car i) 331)
                                                (setq InsList (cons (cdr i) InsList))
                                            )
                                            ((equal (car i) 332)
                                                (setq NestList (cons (cdr i) NestList))
                                            )
                                        )
                                    )
                                    (list InsList NestList)
                                )
                                (member '(102 . "{BLKREFS") tempData)
                            )
                        )
                        XrefList
                    )
                )
            )
        )
    )
    XrefList
)

(foreach i (GetXrefs)
        (princ "\nXref name: ")
        (princ (cdr (assoc 2 (entget (car i)))))
        (princ "\n    Inserted amount: ")
        (princ (itoa (length (cadr i))))
        (if (caddr i)
            (progn
                (princ "\n    Nested xref names: ")
                (foreach j (caddr i)
                    (princ "\n        ")
                    (princ (cdr (assoc 2 (entget j))))
                )
            )
        )
        (princ "\n")
    )

)
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

ronjonp

  • Needs a day job
  • Posts: 7526
Re: Nested Xref Counter in Tree Format
« Reply #4 on: December 09, 2011, 04:47:41 PM »
Perhaps add this?

    (if   (caddr i)
      (progn (princ "\n    Nested xref names: ")
        (princ "\n    Inserted amount: ")
        (princ (itoa (length (caddr i))))

        (foreach j (caddr i) (princ "\n        ") (princ (cdr (assoc 2 (entget j)))))
      )
    )

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Nested Xref Counter in Tree Format
« Reply #5 on: December 09, 2011, 04:57:58 PM »
You should try to incorporate counter into main code - I've modified it and checked and now filters work...

M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

GDF

  • Water Moccasin
  • Posts: 2081
Re: Nested Xref Counter in Tree Format
« Reply #6 on: December 09, 2011, 05:00:56 PM »
Thanks Ron
Xref name: BL-03a
    Inserted amount: 1
    Nested xref names:
    Inserted amount: 6
        UT-C1a_1331hc
        UTB-Gar2
        UT-C2b_1331
        UT-C1c_1331
        UT-C1b_1331
        UT-C1d_1331

Xref name: BL-04a
    Inserted amount: 1
    Nested xref names:
    Inserted amount: 16
        UT-A1a_760hc
        UT-B3d_985
        UT-B3c_985
        UT-B3b_985
        UT-B3a_985
        UT-B1c_985
        UT-B1b_985
        UT-B1d_985
        UT-A2c_760
        UT-A2b_760
        UT-A2d_760
        UT-A1d_760
        UT-A1c_760
        UT-A1b_760
        UT-A2a_760
        UTB-GAR
"\n"


But what I am looking for is the number for each individual unique nested xref.

For example "UT-A2d_760" maybe xrefed in 5 times and "UTB-GAR" only 2 times.




Xref name: BL-04a
    Inserted amount: 1
    Nested xref names:
    Inserted amount: 16  <--not needed
        UT-A1a_760hc  <--want count here
        UT-B3d_985   <--want count here
        UT-B3c_985   <--want count here

   
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

GDF

  • Water Moccasin
  • Posts: 2081
Re: Nested Xref Counter in Tree Format
« Reply #7 on: December 09, 2011, 05:23:18 PM »
You should try to incorporate counter into main code - I've modified it and checked and now filters work...

M.R.

Thanks
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

GDF

  • Water Moccasin
  • Posts: 2081
Re: Nested Xref Counter in Tree Format
« Reply #8 on: December 09, 2011, 09:31:42 PM »
We often load multiple copies of the same nested "unit plan" xrefs within the main "building plan" xref...therfore I need a count of how many times the "unit plans" are copied.

I hope this understandable:

Xref name: BL-04a
    Inserted amount: 1
    Nested xref names:
    Inserted amount: 16  <--not needed...this is the total of how many of unique files ther are
        UT-A1a_760hc  <--want count here...of total times the xrefs are copied
        UT-B3d_985   <--want count here...of total times the xrefs are copied
        UT-B3c_985   <--want count here...of total times the xrefs are copied

Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Nested Xref Counter in Tree Format
« Reply #9 on: December 10, 2011, 08:27:27 AM »
For main Xrefs, its easy to find number of insertions, but for nested I still don't know how... I've updated  code with filtering xrefs to include number of main Xrefs ( I added - no. after prompting its name)...
If only there is a way to check for (ssget "_X" '((0 . "INSERT") (2 . "nested xref name") (410 . "Model"))) inside of each main xref without opening it...??? :|

M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Nested Xref Counter in Tree Format
« Reply #10 on: December 10, 2011, 11:14:08 AM »
I've figured out... Only thing is that you'll have to multiply manually with number of parent xref, all to top most level - main xref to get total numbers of child nested xref... This number shows how many nested xrefs are per 1 parent xref... So here is code :

Code: [Select]
(defun c:PrintXrefNesting ( / mainfilter filter )
    ; Prints nested xref tree to command line, no matter how deep the nesting.
    (setq mainfilter (getstring T "\nInput prefix filter for Main Xrefs : "))
    (setq filter (getstring T "\nInput prefix filter for Nested Xrefs : "))

      (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     ((listp (cdr i)) (filternested (cdr i) filter))
                ((and (atom (cdr i)) (wcmatch (strcase (cdr (assoc 2 (entget (cdr i))))) (strcase filter))) () (setq ii 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
    )
    ;------------------------------------------------
    (defun PrintNestedList ( lst spc mainname )
        (foreach
            i
            (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)) (prompt (strcat "\n" spc " Nested xref: " (cdr (assoc 2 (entget (car i)))) " - " (itoa (nestedxrefcount mainname (cdr (assoc 2 (entget (car i)))))))) (prompt (strcat "\n" spc " Nested xref: nil" )) )
            (PrintNestedList (if (cdr i) (cdr i) nil) (strcat "  " spc) (cdr (assoc 2 (entget (car i)))))
            ;(PrintNestedList (cdr i) (strcat "  |" spc)) [color=red]; second option shown below[/color]
        )
    )
    ;-----------------------------------------------------
   
    (foreach
        i
        (vl-sort
            (FilterNestedXrefs (GetXrefNesting) mainfilter filter)
            (function
                (lambda ( a b )
                    (<
                        (strcase (cdr (assoc 2 (entget (car a)))))
                        (strcase (cdr (assoc 2 (entget (car b)))))
                    )
                )
            )
        )
        (prompt (strcat "\n Main xref: " (cdr (assoc 2 (entget (car i)))) " - " (itoa (sslength (ssget "_X" (list '(0 . "INSERT") (assoc 2 (entget (car i))) (cons 410 (getvar 'ctab)))))) ))
        (PrintNestedList (if (and (/= (cadr i) nil) (cdr i)) (vl-remove nil (cdr i)) nil) "  |-" (cdr (assoc 2 (entget (car i)))))
    )
    (princ)
)
(vl-load-com)
(princ)

Regards, M.R.
:)
« Last Edit: December 12, 2011, 08:51:15 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

GDF

  • Water Moccasin
  • Posts: 2081
Re: Nested Xref Counter in Tree Format
« Reply #11 on: December 10, 2011, 12:35:53 PM »
Marko

Saying thank you does not seem enough. Works perfectly. I tried as best I could to solve it, way out of my zip code of knowledge.

Late last night I was thinking it could only be done with objectdbx coding.




Results from your updated code:

Input prefix filter for Main Xrefs : BL*

Input prefix filter for Nested Xrefs : UT*

 Main xref: BL-01 - 2
  |- Nested xref: UTB2-1119 - 6
  |- Nested xref: UTB5-1048 - 2
 Main xref: BL-02 - 2
  |- Nested xref: UTA2-692 - 4
  |- Nested xref: UTA2-692-HC - 2
  |- Nested xref: UTA4-697 - 8
  |- Nested xref: UTA6-899 - 1
  |- Nested xref: UTA7-969 - 1
  |- Nested xref: UTA8-697 - 2
  |- Nested xref: UTA9-697 - 2
  |- Nested xref: UTB1-969 - 6
  |- Nested xref: UTB2a-1119 - 2
  |- Nested xref: UTB4-1258 - 4
 Main xref: BL-03 - 1
  |- Nested xref: UTA1-599a - 8
  |- Nested xref: UTA1-599b - 8
  |- Nested xref: UTA3-893 - 8
 Main xref: BL-04 - 1
  |- Nested xref: UTA5-899 - 8
  |- Nested xref: UTB3-936 - 12
 Main xref: BL-05 - 1
  |- Nested xref: UTA1-599a - 8
  |- Nested xref: UTA1-599b - 8
  |- Nested xref: UTA3-893 - 8


Thank you  Thank you
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

GDF

  • Water Moccasin
  • Posts: 2081
Re: Nested Xref Counter in Tree Format
« Reply #12 on: December 10, 2011, 02:24:23 PM »
Having trouble with printing to a file:

Code: [Select]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Print Xref Nesting ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;http://www.theswamp.org/index.php?topic=28062.msg337119#msg337119
;;;Tim Willey
;;;Marko Ribar

(defun PrintXrefNestingIT ( / mainfilter filter )
    ;;Prints nested xref tree to command line, no matter how deep the nesting.
    (setq mainfilter (getstring T "\n* Input prefix filter for Main Xrefs: [BL*] "))
    (if (= mainfilter "")(setq mainfilter "BL*"))
    (setq filter (getstring T "\n* Input prefix filter for Nested Xrefs: [UT*]"))
    (if (= filter "")(setq filter "UT*"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      (defun nestedxrefcount ( mainname nestedname / bl item )
        (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     ((listp (cdr i)) (filternested (cdr i) filter))
                ((and (atom (cdr i)) (wcmatch (strcase (cdr (assoc 2 (entget (cdr i))))) (strcase filter))) () (setq ii 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 FileName (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 4)))
    (startapp "notepad.exe" (strcat (getvar "dwgprefix") FileName " PrintXrefNesting.txt"))
    (setq Opened (open (strcat (getvar "dwgprefix") FileName " PrintXrefNesting.txt") "w")) 
 
    (defun PrintNestedList ( lst spc mainname )       
        (foreach
            i
            (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 "\n" spc " Nested xref: " (cdr (assoc 2 (entget (car i)))) " - " (itoa (nestedxrefcount mainname (cdr (assoc 2 (entget (car i))))) Opened)    ) )
            (write-line (strcat "\n" spc " Nested xref: nil") Opened))
            (PrintNestedList (if (cdr i) (cdr i) nil) (strcat "  " spc) (cdr (assoc 2 (entget (car i)))))           
        )
    )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;   
    (foreach
        i
        (vl-sort
            (FilterNestedXrefs (GetXrefNesting) mainfilter filter)
            (function
                (lambda ( a b )
                    (<
                        (strcase (cdr (assoc 2 (entget (car a)))))
                        (strcase (cdr (assoc 2 (entget (car b)))))
                    )
                )
            )
        )
        (write-line (strcat "\n\n[ ]  Main xref: " (cdr (assoc 2 (entget (car i)))) " - " (itoa (sslength (ssget "_X" (list '(0 . "INSERT") (assoc 2 (entget (car i))) (cons 410 (getvar 'ctab)))))) Opened))
        (PrintNestedList (if (cdr i) (cdr i) nil) "\t\t>" (cdr (assoc 2 (entget (car i)))))
    )

    ;;
    ;;(vl-filename-base (getvar "dwgname"))
    ;;(setq FileName (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 4)))
    ;;(startapp "notepad.exe" (strcat "\\Arch " ARCH#PROJ FileName " PrintXrefNesting.txt"))

    ;;(startapp "notepad.exe" (strcat (getvar "dwgprefix") FileName " PrintXrefNesting.txt"))
    (if Opened (close Opened))
    (princ)
)
(vl-load-com)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(princ)

Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

GDF

  • Water Moccasin
  • Posts: 2081
Re: Nested Xref Counter in Tree Format
« Reply #13 on: December 10, 2011, 08:18:54 PM »
Got it working...here is my final routine:
Special thanks to Tim Willey and Marko Ribar.

Code: [Select]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Print Xref Nesting ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;http://www.theswamp.org/index.php?topic=28062.msg337119#msg337119
;;; Tim Willey
;;; Marko Ribar
;;; Prints nested xref tree to command line, no matter how deep the nesting.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun PrintXrefNestingIT (/ mainfilter    filter
   opened projectDesc   projectName
   datestring
  )
  (defun ARCH:ProjectName ()
    (setq DirPath (getvar "dwgprefix"))
    (setq ProjectNum (substr DirPath 14 6))
    (setq ARCH#PROJ (substr DirPath 14 6))
    (cond ((/= (atoi ProjectNum) 0) (setvar "users1" ProjectNum)))
    (cond ((/= (getvar "users1") 0)
   (setq ProjectName
  (dos_getini
    "PROJECTS"
    (getvar "users1")
    (strcat ARCH#CUSF "FILE/ARCH_Projects.ini")
  )
   )
  )
    )
    (cond ((= ProjectName nil) (setq ProjectDesc ""))
  ((/= ProjectName nil)
   (setq projectDesc
  (strcat "        Project Name : [" ProjectName "]")
   )
  )
    )
    (princ)
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (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 datestring
   (strcat MON2
   " "
   DAY
   ", "
   YEAR
   " "
   NHRS
   ":"
   (substr DATST 12 2)
   " "
   XTR
   )
    )
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;   
  (setq mainfilter
(getstring
   T
   "\n* Input prefix filter for Main Xrefs: [BL*] "
)
  )
  (if (= mainfilter "")
    (setq mainfilter "BL*")
  )
  (setq filter
(getstring T
    "\n* Input prefix filter for Nested Xrefs: [UT*]"
)
  )
  (if (= filter "")
    (setq filter "UT*")
  )
  (prompt "* Please Wait while the Program is Running...")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun nestedxrefcount (mainname nestedname / bl item)
    (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 ((listp (cdr i)) (filternested (cdr i) filter))
    ((and (atom (cdr i))
  (wcmatch (strcase (cdr (assoc 2 (entget (cdr i)))))
   (strcase filter)
  )
     )
     ()
     (setq ii 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
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (ARCH:DATE2)
  (ARCH:ProjectName)
  (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 projectDesc opened)
  (write-line
    (strcat "        Directory is: ["
    (getvar "dwgprefix")
    FileName
    "]"
    )
    opened
  )
  (write-line (strcat "        " datestring) opened)

  (write-line
    "----------------------------------------------------------------------"
    opened
  )

  (defun PrintNestedList (lst spc mainname)
    (foreach
      i
       (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))))
      )
    )
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;   
  (foreach
    i
     (vl-sort
       (FilterNestedXrefs (GetXrefNesting) mainfilter filter)
       (function
(lambda (a b)
   (<
     (strcase (cdr (assoc 2 (entget (car a)))))
     (strcase (cdr (assoc 2 (entget (car b)))))
   )
)
       )
     )
    (write-line
      (strcat "\n\n [ ] Main xref: "
      (cdr (assoc 2 (entget (car i))))
      " - "
      (itoa (sslength (ssget "_X"
     (list '(0 . "INSERT")
   (assoc 2 (entget (car i)))
   (cons 410 (getvar 'ctab))
     )
      )
    )
      )
      )
      opened
    )
    (PrintNestedList
      (if (cdr i)
(cdr i)
nil
      )
      "     >"
      (cdr (assoc 2 (entget (car i))))
    )
  )

  ;;(vl-filename-base (getvar "dwgname"))
  ;;(setq FileName (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 4)))
  ;;(startapp "notepad.exe" (strcat "\\Arch " ARCH#PROJ FileName " PrintXrefNesting.txt"))
  ;;(startapp "notepad.exe" (strcat (getvar "dwgprefix") FileName " PrintXrefNesting.txt"))

  (if Opened
    (close Opened)
  )
  (startapp "notepad.exe"
    (strcat (getvar "dwgprefix")
    FileName
    " PrintXrefNesting.txt"
    )
  )
  (princ)
)
(vl-load-com)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(princ)
Example of output file:
Code: [Select]
----------------------------------------------------------------------
        Project Name : [Lakes @ University Park]
        Directory is: [F:\Jobs\2008\080331\acad\building\BL-Profile1]
        December 10, 2011 7:17 p.m.
----------------------------------------------------------------------


 [ ] Main xref: BL-01 - 2
     > Nested xref: UTB2-1119 - 6
     > Nested xref: UTB5-1048 - 2


 [ ] Main xref: BL-02 - 2
     > Nested xref: UTA2-692 - 4
     > Nested xref: UTA2-692-HC - 2
     > Nested xref: UTA4-697 - 8
     > Nested xref: UTA6-899 - 1
     > Nested xref: UTA7-969 - 1
     > Nested xref: UTA8-697 - 2
     > Nested xref: UTA9-697 - 2
     > Nested xref: UTB1-969 - 6
     > Nested xref: UTB2a-1119 - 2
     > Nested xref: UTB4-1258 - 4


 [ ] Main xref: BL-03 - 1
     > Nested xref: UTA1-599a - 8
     > Nested xref: UTA1-599b - 8
     > Nested xref: UTA3-893 - 8


 [ ] Main xref: BL-04 - 1
     > Nested xref: UTA5-899 - 8
     > Nested xref: UTB3-936 - 12


 [ ] Main xref: BL-05 - 1
     > Nested xref: UTA1-599a - 8
     > Nested xref: UTA1-599b - 8
     > Nested xref: UTA3-893 - 8
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

GDF

  • Water Moccasin
  • Posts: 2081
Re: Nested Xref Counter in Tree Format
« Reply #14 on: December 10, 2011, 09:01:07 PM »
Minor twicks

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 project header and routine progress bar
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun PrintXrefNestingIT (/ mainfilter    filter
   opened projectDesc   projectName
   datestring n
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun ARCH:ProjectName ()
    (setq DirPath (getvar "dwgprefix"))
    (setq ProjectNum (substr DirPath 14 6))
    (setq ARCH#PROJ (substr DirPath 14 6))
    (cond ((/= (atoi ProjectNum) 0) (setvar "users1" ProjectNum)))
    (cond ((/= (getvar "users1") 0)
   (setq ProjectName
  (dos_getini
    "PROJECTS"
    (getvar "users1")
    (strcat ARCH#CUSF "FILE/ARCH_Projects.ini")
  )
   )
  )
    )
    (cond ((= ProjectName nil) (setq ProjectDesc ""))
  ((/= ProjectName nil)
   (setq projectDesc
  (strcat "        Project Name : [" ProjectName "]")
   )
  )
    )
    (princ)
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (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 datestring
   (strcat MON2
   " "
   DAY
   ", "
   YEAR
   " "
   NHRS
   ":"
   (substr DATST 12 2)
   " "
   XTR
   )
    )
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;   
  (setq mainfilter
(getstring
   T
   "\n* Input prefix filter for Main Xrefs: [BL*] "
)
  )
  (if (= mainfilter "")
    (setq mainfilter "BL*")
  )
  (setq filter
(getstring T
    "\n* Input prefix filter for Nested Xrefs: [UT*]"
)
  )
  (if (= filter "")
    (setq filter "UT*")
  )
  (prompt "* Please Wait while the Program is Running...")
  (setq n 1)
  (ACET-UI-PROGRESS-INIT
    "Please Wait while the Program is Running"
    (length rtnList))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun nestedxrefcount (mainname nestedname / bl item)
    (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))
  )
)
      )
      (ACET-UI-PROGRESS-SAFE n)
      (setq n (+ n 1))
    )   
    (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 ((listp (cdr i)) (filternested (cdr i) filter))
    ((and (atom (cdr i))
  (wcmatch (strcase (cdr (assoc 2 (entget (cdr i)))))
   (strcase filter)
  )
     )
     ()
     (setq ii nil)
    )
    ((eq (cdr i) nil) nil)
      )
      (setq newlst (cons ii newlst))   
      (ACET-UI-PROGRESS-SAFE n)
      (setq n (+ n 1))   
    )
    (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
   )
    )
  )

        (ACET-UI-PROGRESS-SAFE n)
        (setq n (+ n 1))     
      )
      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))
      )
      (ACET-UI-PROGRESS-SAFE n)
      (setq n (+ n 1))
    )
    NonNestedXrefList
  ) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (ARCH:DATE2)
  (ARCH:ProjectName)
  (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 projectDesc opened)
  (write-line
    (strcat "        Directory is: ["
    (getvar "dwgprefix")
    FileName
    "]"
    )
    opened
  )
  (write-line (strcat "        " datestring) opened)
  (write-line
    "----------------------------------------------------------------------"
    opened
  )

  (defun PrintNestedList (lst spc mainname)
    (foreach
      i
       (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 (+ n 1))
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;   
  (foreach
    i
     (vl-sort
       (FilterNestedXrefs (GetXrefNesting) mainfilter filter)
       (function
(lambda (a b)
   (<
     (strcase (cdr (assoc 2 (entget (car a)))))
     (strcase (cdr (assoc 2 (entget (car b)))))
   )
)
       )
     )
    (write-line
      (strcat "\n\n [ ] Main xref: "
      (cdr (assoc 2 (entget (car i))))
      " - "
      (itoa (sslength (ssget "_X"
     (list '(0 . "INSERT")
   (assoc 2 (entget (car i)))
   (cons 410 (getvar 'ctab))
     )
      )
    )
      )
      )
      opened
    )
    (PrintNestedList
      (if (cdr i)
(cdr i)
nil
      )
      "     >"
      (cdr (assoc 2 (entget (car i))))
    )
  )

  ;;(vl-filename-base (getvar "dwgname"))
  ;;(setq FileName (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 4)))
  ;;(startapp "notepad.exe" (strcat "\\Arch " ARCH#PROJ FileName " PrintXrefNesting.txt"))
  ;;(startapp "notepad.exe" (strcat (getvar "dwgprefix") FileName " PrintXrefNesting.txt"))

  (if Opened
    (close Opened)
  )
  (startapp "notepad.exe"
    (strcat (getvar "dwgprefix")
    FileName
    " PrintXrefNesting.txt"
    )
  )
  (ACET-UI-PROGRESS-DONE)
  (princ)
)
(vl-load-com)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(princ)
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

GDF

  • Water Moccasin
  • Posts: 2081
Re: Nested Xref Counter in Tree Format
« Reply #15 on: December 10, 2011, 10:59:14 PM »
Updated code...I'm done.

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 PrintXrefNestingIT (/ mainfilter   filter
   opened projectDesc  projectName
   datestring n
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;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
;;;Mike Weaver
  (defun xrefs-list (/ rtlist)
    (vl-load-com)
    (ACET-UI-PROGRESS-SAFE n)
    (setq n (+ n 1))
    (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))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun ARCH:ProjectName ()
    (setq DirPath (getvar "dwgprefix"))
    (setq ProjectNum (substr DirPath 14 6))
    (setq ARCH#PROJ (substr DirPath 14 6))
    (cond ((/= (atoi ProjectNum) 0) (setvar "users1" ProjectNum)))
    (cond ((/= (getvar "users1") 0)
   (setq ProjectName
  (dos_getini
    "PROJECTS"
    (getvar "users1")
    (strcat ARCH#CUSF "FILE/ARCH_Projects.ini")
  )
   )
  )
    )
    (cond ((= ProjectName nil) (setq ProjectDesc ""))
  ((/= ProjectName nil)
   (setq projectDesc
  (strcat "        Project Name : [" ProjectName "]")
   )
  )
    )
    (princ)
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (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 datestring
   (strcat MON2
   " "
   DAY
   ", "
   YEAR
   " "
   NHRS
   ":"
   (substr DATST 12 2)
   " "
   XTR
   )
    )
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;   
  (setq mainfilter
(getstring
   T
   "\n* Input prefix filter for Main Xrefs: [BL*] "
)
  )
  (if (= mainfilter "")
    (setq mainfilter "BL*")
  )
  (setq filter
(getstring T
    "\n* Input prefix filter for Nested Xrefs: [UT*]"
)
  )
  (if (= filter "")
    (setq filter "UT*")
  )
  (prompt "* Please Wait while the Program is Running...")
  (setq n 1)
  (ACET-UI-PROGRESS-INIT
    "Please Wait while the Program is Running"
    (length rtnList)
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun nestedxrefcount (mainname nestedname / bl item)
    (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))
  )
)
      )
      (ACET-UI-PROGRESS-SAFE n)
      (setq n (+ n 1))
    )
    (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 ((listp (cdr i)) (filternested (cdr i) filter))
    ((and (atom (cdr i))
  (wcmatch (strcase (cdr (assoc 2 (entget (cdr i)))))
   (strcase filter)
  )
     )
     ()
     (setq ii nil)
    )
    ((eq (cdr i) nil) nil)
      )
      (setq newlst (cons ii newlst))
      (ACET-UI-PROGRESS-SAFE n)
      (setq n (+ n 1))
    )
    (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
   )
    )
  )
)
(ACET-UI-PROGRESS-SAFE n)
(setq n (+ n 1))
      )
      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))
      )
      (ACET-UI-PROGRESS-SAFE n)
      (setq n (+ n 1))
    )
    NonNestedXrefList
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (ARCH:DATE2)
  (ARCH:ProjectName)
  (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 projectDesc opened)
  (write-line
    (strcat "        Directory is: ["
    (getvar "dwgprefix")
    FileName
    "]"
    )
    opened
  )
  (write-line (strcat "        " datestring) opened)
  (write-line
    "----------------------------------------------------------------------"
    opened
  )

  (defun PrintNestedList (lst spc mainname)
    (foreach
      i
       (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 (+ n 1))
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;   
  (foreach
    i
     (vl-sort
       (FilterNestedXrefs (GetXrefNesting) mainfilter filter)
       (function
(lambda (a b)
   (<
     (strcase (cdr (assoc 2 (entget (car a)))))
     (strcase (cdr (assoc 2 (entget (car b)))))
   )
)
       )
     )
    (write-line
      (strcat "\n [ ] Main xref: "
      (cdr (assoc 2 (entget (car i))))
      " - "
      (itoa (sslength (ssget "_X"
     (list '(0 . "INSERT")
   (assoc 2 (entget (car i)))
   (cons 410 (getvar 'ctab))
     )
      )
    )
      )
      )
      opened
    )
    (PrintNestedList
      (if (cdr i)
(cdr i)
nil
      )
      "     >"
      (cdr (assoc 2 (entget (car i))))
    )
  )

  ;;(vl-filename-base (getvar "dwgname"))
  ;;(setq FileName (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 4)))
  ;;(startapp "notepad.exe" (strcat "\\Arch " ARCH#PROJ FileName " PrintXrefNesting.txt"))
  ;;(startapp "notepad.exe" (strcat (getvar "dwgprefix") FileName " PrintXrefNesting.txt"))

  (xrefs-list)

  (if Opened
    (close Opened)
  )
  (startapp "notepad.exe"
    (strcat (getvar "dwgprefix")
    FileName
    " PrintXrefNesting.txt"
    )
  )
  (ACET-UI-PROGRESS-DONE)
  (princ)
)
(vl-load-com)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(princ)
Output file:
Code: [Select]
----------------------------------------------------------------------
        Project Name : [Lakes @ University Park]
        Directory is: [F:\Jobs\2008\080331\acad\building\BL-Profile1]
        December 10, 2011 9:59 p.m.
----------------------------------------------------------------------

 [ ] Main xref: BL-01 - 2
     > Nested xref: UTB2-1119 - 6
     > Nested xref: UTB5-1048 - 2

 [ ] Main xref: BL-02 - 2
     > Nested xref: UTA2-692 - 4
     > Nested xref: UTA2-692-HC - 2
     > Nested xref: UTA4-697 - 8
     > Nested xref: UTA6-899 - 1
     > Nested xref: UTA7-969 - 1
     > Nested xref: UTA8-697 - 2
     > Nested xref: UTA9-697 - 2
     > Nested xref: UTB1-969 - 6
     > Nested xref: UTB2a-1119 - 2
     > Nested xref: UTB4-1258 - 4

 [ ] Main xref: BL-03 - 1
     > Nested xref: UTA1-599a - 8
     > Nested xref: UTA1-599b - 8
     > Nested xref: UTA3-893 - 8

 [ ] Main xref: BL-04 - 1
     > Nested xref: UTA5-899 - 8
     > Nested xref: UTB3-936 - 12

 [ ] Main xref: BL-05 - 1
     > Nested xref: UTA1-599a - 8
     > Nested xref: UTA1-599b - 8
     > Nested xref: UTA3-893 - 8

 List Of Saved Xref Paths:
----------------------------------------------------------------------
 F:\Jobs\2008\080331\ACAD\building\BL-01.dwg
 F:\Jobs\2008\080331\ACAD\building\BL-02.dwg
 F:\Jobs\2008\080331\ACAD\building\BL-04.dwg
 F:\Jobs\2008\080331\ACAD\building\BL-05.dwg
 F:\Jobs\2008\080331\ACAD\building\BL-03.dwg
 F:\Jobs\2008\080331\ACAD\units\UTB2-1119.dwg
 F:\Jobs\2008\080331\ACAD\units\UTB5-1048.dwg
 F:\Jobs\2008\080331\ACAD\units\UTA4-697.dwg
 F:\Jobs\2008\080331\ACAD\units\UTB1-969.dwg
 F:\Jobs\2008\080331\ACAD\units\UTB4-1258.dwg
 F:\Jobs\2008\080331\ACAD\units\UTA2-692-HC.dwg
 F:\Jobs\2008\080331\ACAD\units\UTA6-899.dwg
 F:\Jobs\2008\080331\ACAD\units\UTB2a-1119.dwg
 F:\Jobs\2008\080331\ACAD\units\UTA2-692.dwg
 F:\Jobs\2008\080331\ACAD\units\UTA9-697.dwg
 F:\Jobs\2008\080331\ACAD\units\UTA7-969.dwg
 F:\Jobs\2008\080331\ACAD\units\UTA8-697.dwg
 F:\Jobs\2008\080331\ACAD\units\UTA5-899.dwg
 F:\Jobs\2008\080331\ACAD\units\UTB3-936.dwg
 F:\Jobs\2008\080331\ACAD\units\UTA3-893.dwg
 F:\Jobs\2008\080331\ACAD\units\UTA1-599b.dwg
 F:\Jobs\2008\080331\ACAD\units\UTA1-599a.dwg
« Last Edit: December 10, 2011, 11:19:40 PM by GDF »
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Nested Xref Counter in Tree Format
« Reply #16 on: December 11, 2011, 01:50:40 AM »
I see that you didn't noticed that I forgot to localize n variable in :
(defun nestedxrefcount (mainname nestedname / bl item)

and seeing that you uses n later on in your bigger code I suggest that you modify :
(defun nestedxrefcount (mainname nestedname / bl item n)

also I don't know ab this line :
    "Please Wait while the Program is Running"
    (length rtnList)

variable rtnList is global and is called from your session...
maybe I am wrong, but I thought you wanted
    (length (xrefs-list))

and finally, I would consider showing in your report Nested from Nested Xrefs (notice space characters in between "" (strcat "   " spc)) :
Code: [Select]
      (PrintNestedList
(if (cdr i)
  (cdr i)
  nil
)
(strcat "  " spc)
(cdr (assoc 2 (entget (car i))))
      )
Regards, M.R.
« Last Edit: December 11, 2011, 04:23:43 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Nested Xref Counter in Tree Format
« Reply #17 on: December 11, 2011, 05:07:26 AM »
So this final version should give you no errors after execution on text screen... Still you should check for progress - does it ends at 100%... Test it once with ;(acet-ui-progress-done) and if it all OK (100% and no errors on text screen), then put it back without ;

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 (/ mainfilter   filter
   opened projectDesc  projectName
   datestring n
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;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
;;;Mike Weaver

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

  (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))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun ARCH:ProjectName ()
    (setq DirPath (getvar "dwgprefix"))
    (setq ProjectNum (substr DirPath 14 6))
    (setq ARCH#PROJ (substr DirPath 14 6))
    (cond ((/= (atoi ProjectNum) 0) (setvar "users1" ProjectNum)))
    (cond ((/= (getvar "users1") 0)
   (setq ProjectName
  (dos_getini
    "PROJECTS"
    (getvar "users1")
    (strcat ARCH#CUSF "FILE/ARCH_Projects.ini")
  )
   )
  )
    )
    (cond ((= ProjectName nil) (setq ProjectDesc ""))
  ((/= ProjectName nil)
   (setq projectDesc
  (strcat "        Project Name : [" ProjectName "]")
   )
  )
    )
    (princ)
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (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 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 (and (atom (car i))
       (wcmatch (strcase (cdr (assoc 2 (entget (car i)))))
(strcase filter)
       )
  )
()
(setq ii nil)
      )
      (cond ((listp (cdr i)) (filternested (cdr i) filter))
    ((and (atom (cdr i))
  (wcmatch (strcase (cdr (assoc 2 (entget (cdr i)))))
   (strcase filter)
  )
     )
     ()
     (setq ii 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 (FilterNestedXrefs (GetXrefNesting) mainfilter filter)))
  )
  (ARCH:DATE2)
  (ARCH:ProjectName)
  (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 projectDesc opened)
  (write-line
    (strcat "        Directory is: ["
    (getvar "dwgprefix")
    FileName
    "]"
    )
    opened
  )
  (write-line (strcat "        " datestring) opened)
  (write-line
    "----------------------------------------------------------------------"
    opened
  )

  (defun PrintNestedList (lst spc mainname)
    (foreach
      i
       (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 (+ n 1))
    )
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;   
  (foreach
    i
     (vl-sort
       (FilterNestedXrefs (GetXrefNesting) mainfilter filter)
       (function
(lambda (a b)
   (<
     (strcase (cdr (assoc 2 (entget (car a)))))
     (strcase (cdr (assoc 2 (entget (car b)))))
   )
)
       )
     )
    (write-line
      (strcat "\n [ ] Main xref: "
      (cdr (assoc 2 (entget (car i))))
      " - "
      (itoa (sslength (ssget "_X"
     (list '(0 . "INSERT")
   (assoc 2 (entget (car i)))
   (cons 410 (getvar 'ctab))
     )
      )
    )
      )
      )
      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))))
    )
  )

  ;;(vl-filename-base (getvar "dwgname"))
  ;;(setq FileName (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 4)))
  ;;(startapp "notepad.exe" (strcat "\\Arch " ARCH#PROJ FileName " PrintXrefNesting.txt"))
  ;;(startapp "notepad.exe" (strcat (getvar "dwgprefix") FileName " PrintXrefNesting.txt"))

  (xrefs-list)

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

Regards, M.R.
:)
« Last Edit: December 12, 2011, 08:49:08 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

GDF

  • Water Moccasin
  • Posts: 2081
Re: Nested Xref Counter in Tree Format
« Reply #18 on: December 11, 2011, 04:41:30 PM »
Marko

Thanks for the feedback, I still need to some error and var checking. It works smoothly with no errors. I'm sure to break it later on. Thanks for the corrections! I have since added the word "Total" after the count.

I like your YouTube videos.

Thanks again for your help.

Gary
« Last Edit: December 11, 2011, 04:49:35 PM by GDF »
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

GDF

  • Water Moccasin
  • Posts: 2081
Re: Nested Xref Counter in Tree Format
« Reply #19 on: December 11, 2011, 10:14:02 PM »
Marko, If your looking for another challenge, what about adding a total count per each of the Nested xrefs per each of the Main xrefs?
Will this require another function to count up the total of all Nested xrefs per each Main xref?

Modifing the "PrintNestedList" function to include this totaling up process?

Can you point me in the right direction.

----------------------------------------------------------------------
        Project Name : [Merritt Lakeside Sr Village]
        Directory is: [F:\Jobs\2009\091138\acad\building\BL-Profile2]
        December 11, 2011 8:18 p.m.
----------------------------------------------------------------------

 [ ] Main xref: BL-01 - 2 Total
     > Nested xref: UTA2 - 7 Total
     > Nested xref: UTA3 - 6 Total
     > Nested xref: UTA5 - 3 Total
     > Nested xref: UTB1 - 3 Total
     > Nested xref: UTB3b - 6 Total
     > Nested xref: UTB3c - 6 Total
     > Nested xref: UTB4a - 6 Total
     > Nested xref: UTB4b - 6 Total
        Total Count (2 x 37 = 74 Grand Total)  <-- new output

       (2 Main xrefs) x (Nested xref total) = Grand Total

 
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Nested Xref Counter in Tree Format
« Reply #20 on: December 12, 2011, 06:22:45 AM »
All I can do is to count Xrefs per branch, and in format like this :
----------------------------------------------------------------------
        Directory is: [C:\Documents and Settings\Marica\Desktop\xrefs\xrefss]
        December 12, 2011 2:28 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\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
 C:\Documents and Settings\Marica\Desktop\xrefs\xrefs2.dwg

You can see that firstly it counts last branch, and when needed to separate results it prints counts from previous branch... So if you have only 1 branch like in your case it will do fine, but you must multiply branch with number of main xref count manually...

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 (/ mainfilter   filter
   opened projectDesc  projectName
   datestring n
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;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
;;;Mike Weaver

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

  (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))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun ARCH:ProjectName ()
    (setq DirPath (getvar "dwgprefix"))
    (setq ProjectNum (substr DirPath 14 6))
    (setq ARCH#PROJ (substr DirPath 14 6))
    (cond ((/= (atoi ProjectNum) 0) (setvar "users1" ProjectNum)))
    (cond ((/= (getvar "users1") 0)
   (setq ProjectName
  (dos_getini
    "PROJECTS"
    (getvar "users1")
    (strcat ARCH#CUSF "FILE/ARCH_Projects.ini")
  )
   )
  )
    )
    (cond ((= ProjectName nil) (setq ProjectDesc ""))
  ((/= ProjectName nil)
   (setq projectDesc
  (strcat "        Project Name : [" ProjectName "]")
   )
  )
    )
    (princ)
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (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 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 (and (atom (car i))
       (wcmatch (strcase (cdr (assoc 2 (entget (car i)))))
(strcase filter)
       )
  )
()
(setq ii nil)
      )
      (cond ((listp (cdr i)) (filternested (cdr i) filter))
    ((and (atom (cdr i))
  (wcmatch (strcase (cdr (assoc 2 (entget (cdr i)))))
   (strcase filter)
  )
     )
     ()
     (setq ii 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 (FilterNestedXrefs (GetXrefNesting) mainfilter filter)))
  )
  (ARCH:DATE2)
  (ARCH:ProjectName)
  (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 projectDesc 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)
    (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 (+ n 1))
    )
(setq k 0)
(foreach i lstn
  (setq k (+ k (nestedxrefcount mainname (cdr (assoc 2 (entget (car i))))) ))
    )
(if lstn (write-line (strcat "---------- Total count per branch : " (itoa k) " ----------") opened))
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;   
  (foreach
    i
     (vl-sort
       (FilterNestedXrefs (GetXrefNesting) mainfilter filter)
       (function
(lambda (a b)
   (<
     (strcase (cdr (assoc 2 (entget (car a)))))
     (strcase (cdr (assoc 2 (entget (car b)))))
   )
)
       )
     )
    (write-line
      (strcat "\n [ ] Main xref: "
      (cdr (assoc 2 (entget (car i))))
      " - "
      (itoa (sslength (ssget "_X"
     (list '(0 . "INSERT")
   (assoc 2 (entget (car i)))
   (cons 410 (getvar 'ctab))
     )
      )
    )
      )
      )
      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))))
    )
  )

  ;;(vl-filename-base (getvar "dwgname"))
  ;;(setq FileName (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 4)))
  ;;(startapp "notepad.exe" (strcat "\\Arch " ARCH#PROJ FileName " PrintXrefNesting.txt"))
  ;;(startapp "notepad.exe" (strcat (getvar "dwgprefix") FileName " PrintXrefNesting.txt"))

  (xrefs-list)

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

M.R.
« Last Edit: December 12, 2011, 08:49:43 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Nested Xref Counter in Tree Format
« Reply #21 on: December 12, 2011, 08:55:21 AM »
I've changed to this :

Code: [Select]
    (PrintNestedList
      (if (and (/= (cadr i) nil) (cdr i))
(vl-remove nil (cdr i))
nil
      )
      "     >"
      (cdr (assoc 2 (entget (car i))))
    )

I think that only with this intervention filters work OK as they should...

Marko

Thanks for the feedback, I still need to some error and var checking. It works smoothly with no errors. I'm sure to break it later on. Thanks for the corrections! I have since added the word "Total" after the count.

I like your YouTube videos.

Thanks again for your help.

Gary

You're welcome...
M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

GDF

  • Water Moccasin
  • Posts: 2081
Re: Nested Xref Counter in Tree Format
« Reply #22 on: December 12, 2011, 11:17:40 AM »
Marko

Thanks again.

One last question. Had been working at home, so this in the office this morning, I ran the previous routine.
 
I get this error on some drawing files that has a nested xref that does not match the filter entered.
One of the nested xrefs starts with "E" for example. I think this is happening because of the filted counting of a nested xref that does not exist. Can't do the math with nil? I don't know.

* Input prefix filter for Main Xrefs:
  • BL*

* Input prefix filter for Nested Xrefs:
  • UT*

* Please Wait while the Program is Running...; error: bad argument type:
lentityp nil

Gary
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

GDF

  • Water Moccasin
  • Posts: 2081
Re: Nested Xref Counter in Tree Format
« Reply #23 on: December 12, 2011, 12:04:17 PM »
Marko

Thanks again.

One last question. Had been working at home, so this in the office this morning, I ran the previous routine.
 
I get this error on some drawing files that has a nested xref that does not match the filter entered.
One of the nested xrefs starts with "E" for example. I think this is happening because of the filted counting of a nested xref that does not exist. Can't do the math with nil? I don't know.

* Input prefix filter for Main Xrefs:
  • BL*

* Input prefix filter for Nested Xrefs:
  • UT*

* Please Wait while the Program is Running...; error: bad argument type:
lentityp nil

Gary


I disabled the acet progress abr and it fixed the error, but no nested xrefs were listed in the main xref that did not match the filter:

 [ ] Main xref: BL-01 - 1 Total

    Missing nested xrefs, because xref name was filtered out

 [ ] Main xref: BL-02 - 1 Total
     > Nested xref: UTA20750-HC - 3 Total
     > Nested xref: uta20781 - 9 Total
     > Nested xref: UTB10950-a - 3 Total
     > Nested xref: UTB10950-hc - 3 Total
     > Nested xref: utb31032 - 12 Total
       Total Count = 30





[ ] Main xref: BL-01 - 1 Total
     > Nested xref: ElevLobby1 - 1 Total   
     > Nested xref: UTA20750-HCa - 3 Total
     > Nested xref: uta20781 - 9 Total
     > Nested xref: UTA2a-MEN - 1 Total
     > Nested xref: UTA2a-STORAGE - 1 Total
     > Nested xref: UTA2a-WOMEN - 1 Total
     > Nested xref: utb31032 - 15 Total
       Total Count = 31

 
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Nested Xref Counter in Tree Format
« Reply #24 on: December 12, 2011, 12:12:32 PM »
* Please Wait while the Program is Running...; error: bad argument type:
lentityp nil

Gary

Gary, that's wright it doesn't show data for nested xrefs that do not match filter, and that means also for main xref filter...
Tell me is this error happening with my latest intervention on code?
M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

GDF

  • Water Moccasin
  • Posts: 2081
Re: Nested Xref Counter in Tree Format
« Reply #25 on: December 12, 2011, 12:23:40 PM »
Marko

I tried it on both codes. Same problem with in the same drawing.

The nested xref starts with an E and is filtered out. This occurs here:
[ ] Main xref: BL-01 - 1 Total (here it does not work)

And again here: (but here it works and is filtered out)
[ ] Main xref: BL-02 - 1 Total
     > Nested xref: UTA20750-HC - 3 Total
     > Nested xref: uta20781 - 9 Total
     > Nested xref: UTB10950-a - 3 Total
     > Nested xref: UTB10950-hc - 3 Total
     > Nested xref: utb31032 - 12 Total
       Total Count = 30
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Nested Xref Counter in Tree Format
« Reply #26 on: December 12, 2011, 01:25:15 PM »
Gary, as far as I know, you don't have nested Xrefs that starts with E in all your main Xrefs, and this is why it don't shows any of them... You must have E* nested xrefs within all of your main Xrefs to recognize them and show them... Tell me though, does error occurs?

M.R.

Look, this filter I've made isn't really as expected, but this is as much near to what it should be. I would created real list from Tim's list of xrefs if that wasn't so complex, so I just excluded all possible next nested filter matches if not occur in all parent element associations of original list, and parent element association is referenced only on main xrefs and filter only on first nested branch of xrefs...
« Last Edit: December 12, 2011, 02:15:47 PM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

GDF

  • Water Moccasin
  • Posts: 2081
Re: Nested Xref Counter in Tree Format
« Reply #27 on: December 12, 2011, 03:30:00 PM »
Marko

I do have nested Xrefs that starts with "E" and "O" in some of Nested Xrefs, but not all. I can not get the filter input prefix to work, for any condition. I am just trying to understand what is wrong. You have been very nice to help me (even doing the work). My programming abilities are limited.


I can't even get this to work: testing --> (setq mainfilter "*" filter "UT*")
Result:
 [ ] Main xref: BL-01 = 2 Count

 [ ] Main xref: BL-02 = 2 Count

 [ ] Main xref: BL-CLUB = 1 Count





Testing ---> (setq mainfilter "*" filter "*")
Result:
 [ ] Main xref: BL-01 = 2 Count
     > Nested xref: ElevLobby1 = 1 Count    <--filter out
     > Nested xref: Outine = 5 Count   <-- filter out
     > Nested xref: UTA10780 = 5 Count
     > Nested xref: UTA10780r = 2 Count
     > Nested xref: UTA20780 = 1 Count
     > Nested xref: UTA20780-HC = 1 Count
     > Nested xref: UTA20780r = 1 Count
     > Nested xref: UTB21028 = 8 Count
     > Nested xref: UTB21028-HC = 2 Count
     > Nested xref: UTB21028r = 4 Count
     > Nested xref: UTB21028r-HC = 1 Count
       Total Count = 31/Main Xref

 [ ] Main xref: BL-02 = 2 Count
     > Nested xref: ElevLobby2 = 1 Count   <-- filter out
     > Nested xref: Outine = 5 Count   <-- filter out
     > Nested xref: UTA10780 = 4 Count
     > Nested xref: UTA10780r = 2 Count
     > Nested xref: UTA20780 = 2 Count
     > Nested xref: UTA20780r = 1 Count
     > Nested xref: UTB21028 = 8 Count
     > Nested xref: UTB21028r = 4 Count
     > Nested xref: UTB21028rx = 1 Count
     > Nested xref: UTB21028x = 2 Count
       Total Count = 30/Main Xref

 [ ] Main xref: BL-CLUB = 1 Count
     > Nested xref: BL-Dormer6 = 1 Count   <-- filter out
     > Nested xref: KeyPlan = 2 Count   <-- filter out
     > Nested xref: Outine = 5 Count   <-- filter out
     Total Count = 8/Main Xref


Anyway you have done WAY more than I could ever have expected. Thanks.

Gary



« Last Edit: December 12, 2011, 03:39:04 PM by GDF »
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Nested Xref Counter in Tree Format
« Reply #28 on: December 12, 2011, 07:17:47 PM »
Here I revised my code for the last time... Now filters work as they really expected... Still I am not sure why do you have wrong results with mainfilter * and filter *... But I fixed issue of showing nested xrefs if they exist in main xref (no matter if exist in all xrefs)... So here is code :

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 (/ mainfilter   filter
   opened projectDesc  projectName
   datestring n
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;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
;;;Mike Weaver

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

  (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))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun ARCH:ProjectName ()
    (setq DirPath (getvar "dwgprefix"))
    (setq ProjectNum (substr DirPath 14 6))
    (setq ARCH#PROJ (substr DirPath 14 6))
    (cond ((/= (atoi ProjectNum) 0) (setvar "users1" ProjectNum)))
    (cond ((/= (getvar "users1") 0)
   (setq ProjectName
  (dos_getini
    "PROJECTS"
    (getvar "users1")
    (strcat ARCH#CUSF "FILE/ARCH_Projects.ini")
  )
   )
  )
    )
    (cond ((= ProjectName nil) (setq ProjectDesc ""))
  ((/= ProjectName nil)
   (setq projectDesc
  (strcat "        Project Name : [" ProjectName "]")
   )
  )
    )
    (princ)
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (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 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 (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")
     FileName
     " PrintXrefNesting.txt"
     )
     "w"
       )
  )
  (write-line
    "----------------------------------------------------------------------"
    opened
  )
  (write-line projectDesc 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 (+ n 1))
    )
(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)))))
   )
)
       )
     )
    (write-line
      (strcat "\n [ ] Main xref: "
      (cdr (assoc 2 (entget (car i))))
      " - "
      (itoa (sslength (ssget "_X"
     (list '(0 . "INSERT")
   (assoc 2 (entget (car i)))
   (cons 410 (getvar 'ctab))
     )
      )
    )
      )
      )
      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))))
    )
  )

  ;;(vl-filename-base (getvar "dwgname"))
  ;;(setq FileName (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 4)))
  ;;(startapp "notepad.exe" (strcat "\\Arch " ARCH#PROJ FileName " PrintXrefNesting.txt"))
  ;;(startapp "notepad.exe" (strcat (getvar "dwgprefix") FileName " PrintXrefNesting.txt"))

  (xrefs-list)

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

Regards, M.R.
« Last Edit: December 14, 2011, 06:11:03 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

GDF

  • Water Moccasin
  • Posts: 2081
Re: Nested Xref Counter in Tree Format
« Reply #29 on: December 12, 2011, 10:53:55 PM »
Marko

Thanks again. Tried it here at home and your new code has solved the problem. Will try it at the office on more files tomorrow.

I see where you updated the code...I'm totally lost in how it works. Thanks again for you hard work and patience. This routine will be a great time saver in reviewing our project files with nested xrefs.

Gary

Updated Output File:

----------------------------------------------------------------------
        Project Name : [Merritt Lakeside Sr Village]
        Directory is: [F:\Jobs\2009\091138\acad\building\BL-Profile2]
        December 12, 2011 10:52 p.m.
----------------------------------------------------------------------

 [X] Parent Drawing: BL-Profile2

    [ ] Main Xref: BL-01 = 2 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 Count = 42 Nested/Main

    [ ] Main Xref: BL-02 = 2 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 Count = 30 Nested/Main

    [ ] 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







« Last Edit: December 12, 2011, 11:55:34 PM by GDF »
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

GDF

  • Water Moccasin
  • Posts: 2081
Re: Nested Xref Counter in Tree Format
« Reply #30 on: December 13, 2011, 08:27:17 PM »
Here is the final version. Special thanks to Marko!

Example of print out file:
Quote
======================================================================
        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)
« Last Edit: December 13, 2011, 08:34:19 PM by GDF »
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Nested Xref Counter in Tree Format
« Reply #31 on: December 14, 2011, 06:08:29 AM »
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.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

GDF

  • Water Moccasin
  • Posts: 2081
Re: Nested Xref Counter in Tree Format
« Reply #32 on: December 14, 2011, 09:02:41 AM »
Thanks again...it's almost beer Friday...
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

Koenig

  • Guest
Re: Nested Xref Counter in Tree Format
« Reply #33 on: December 23, 2011, 05:46:47 AM »
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

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Nested Xref Counter in Tree Format
« Reply #34 on: December 23, 2011, 07:42:21 AM »
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.
:wink:
« Last Edit: October 05, 2022, 04:34:18 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Koenig

  • Guest
Re: Nested Xref Counter in Tree Format
« Reply #35 on: December 27, 2011, 05:32:38 AM »
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

  • Water Moccasin
  • Posts: 2081
Re: Nested Xref Counter in Tree Format
« Reply #36 on: December 28, 2011, 11:13:09 AM »
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
« Last Edit: December 28, 2011, 11:17:37 AM by GDF »
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Nested Xref Counter in Tree Format
« Reply #37 on: May 31, 2018, 04:51:56 AM »
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.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube