Topic: Extracting "Found at" path of XREF problem under A2018...

[ribarm]

Hi,
Happy New 2020 Year and all my blessing wishes to all of you...

I have small problem that is going on my mind already for a while... Although I don't quite need this task, I am wondering has anyone have some solution to give or advice...
The problem is as follows :
I have DWG with attached XREFS into that main DWG and when I type XREF command dialog box pops up with info about attached XREFS... When I click on one of them dialog box fills with info... Now I am using A2018 and as you all know functions like (vla-get-filedpendencies) has been removed from OOTB A2018 and I was wondering : Is there another way to extract info "Found at" path that is displayed in field marked red on XR01.PNG that I am attaching... I tried with looking into XREFS DXF entity data, DUMP VLA-OBJECT XREF data and (dumpallproperties XREF-ENAME) to see if there is such property from which I could be able to get that info... But there is nothing about "Found at"... Then I tried trick with -XREF command and changed Path Type option to "Full Path", but still there is some problem with nested XREFS as shown with red field marked on XR02.PNG also I am attaching... So all in all I am left with empty hands about this issue... I figured out that there were reasons why (vla-get-filedpendencies) was removed and I ended with just obtaining relative paths if there are some and if none then just info that files : xref1.dwg, xref2.dwg, ... are attached to main DWG which I can get info about path... I figured that that info is reasonably good, but still I felt that there must be a way to get and "Found at" info...

For xrefs for testing you can download *.zip attached to the first post of this topic :
http://www.theswamp.org/index.php?topic=55550.0

Many thanks for your insight and valuable advice, M.R.

[MP]

Hi MR, the following cobbled together code may provided some illumination ...

Code: [Select]

(defun mpx-split-folders ( path )
    (   (lambda ( lst / apart parts )
            (foreach x (reverse lst)
                (if (eq 92 x)
                    (setq parts (cons apart parts) apart nil)
                    (setq apart (cons x apart))
                )
            )
            (mapcar 'vl-list->string (cons apart parts))
        )
        (vl-string->list (vl-string-trim "\\" (vl-string-translate "/" "\\" path)))
    )
)

Code: [Select]

(defun mpx-join-folders ( parts )
    (if parts
        (apply 'strcat
            (cons
                (car parts)
                (mapcar (function (lambda (p) (strcat "\\" p))) (cdr parts))
            )
        )
        ""
    )
)

Code: [Select]

(defun mpx-absolute-path ( parent-path relative-path / parent relative )
   (cond
        (   (wcmatch relative-path "~*\\*")
            (strcat
                (vl-string-right-trim "/\\" parent-path)
                "\\"
                relative-path
            )
        )
        (   (wcmatch relative-path "`.\\*")
            (strcat
                (vl-string-right-trim "/\\" parent-path)
                (substr relative-path 2)
            )
        )
        (   (wcmatch relative-path "`.`.\\*")
            (setq
                parent   (cdr (reverse (mpx-split-folders parent-path)))
                relative (cdr (mpx-split-folders relative-path))
            )
            (while (eq ".." (car relative))
                (setq
                    parent   (cdr parent)
                    relative (cdr relative)
                )
            )
            (strcat
                (mpx-join-folders (reverse parent))
                "\\"
                (mpx-join-folders relative)
            )
        )
        ("")
    )
)

Code: [Select]

(defun mpx-get-xref-names ( blocks / result )
    (vlax-for b blocks
        (if (eq :vlax-true (vla-get-isxref b))
            (setq result (cons (vla-get-name b) result))
        )       
    )
    (reverse result)
)

Code: [Select]

(defun mpx-get-nested-block-parentage ( blocks / xref-names name! result )
    (foreach name (setq xref-names (mpx-get-xref-names blocks))
        (vlax-for x (vla-item blocks name)
            (and
                (eq "AcDbBlockReference" (vla-get-objectname x))
                (member (setq name! (vl-catch-all-apply 'vla-get-name (list x))) xref-names)
                (setq result (cons (list name! name (vla-get-handle x)) result))
            )
        )
    )
    (reverse result)
)

Code: [Select]

(defun mpx-strings-to-csv ( strings )
    (apply 'strcat
        (cons
            (car strings)
            (mapcar (function (lambda (s) (strcat "," s))) (cdr strings))
        )
    )
)

Code: [Select]

(defun mpx-get-xref-props ( xref / doc blocks data1 data2 name name! correct-name path path-parent path-legal state refs ref-handles hosts xref-type path-type path-absolute found ref-count ref-data nested circular nested )

    (setq
        doc    (vla-get-document xref)
        blocks (vla-get-blocks doc)
    )

    (vl-catch-all-apply 'eval
      '((setq data2
            (entget
                (cdr
                    (assoc 360
                        (setq data1
                            (entget
                                (vlax-vla-object->ename xref)
                            )
                        )
                    )
                )
            )
        ))
    )
   
    (setq nested
        (if (member '(102 . "{BLKREFS") data1)
            "FALSE"
            "TRUE"
        )
    )

    (setq path-parent
        (cond
            ((/= 'vla-object (type doc)) "")
            ((vlax-property-available-p doc 'path) (vla-get-path doc))
            ((vlax-property-available-p doc 'name) (vl-filename-directory (vla-get-name doc)))
            ("")
        )
    )

    (setq
        name (cdr (assoc 2 data2))
        path (cdr (assoc 1 data2))
    )

    (setq state
        (cond
            ((member '(71 . 1) data2)                   "UNLOADED")
            ((eq 32 (logand 32 (cdr (assoc 70 data2)))) "RESOLVED")
            (                                           "UNRESOLVED")
        )
    )

    (setq xref-type
        (if (eq 8 (logand 8 (cdr (assoc 70 data2))))
            "OVERLAY"
            "ATTACH"
        )
    )

    (setq path-type
        (if (wcmatch path "*`.\\*,~*\\*")
            "RELATIVE"
            "ABSOLUTE"
        )
    )

    (setq found
        (cond
            ((eq "ABSOLUTE" path-type) (if (findfile (setq path-absolute path)) "TRUE" "FALSE"))
            ((findfile (setq path-absolute (mpx-absolute-path path-parent path))) "TRUE")
            ("FALSE")
        )
    )
   
    (cond
        (   (eq "FALSE" nested)
            (setq ref-count
                (length
                    (setq refs
                        (mapcar 'cdr
                            (vl-remove-if-not
                                (function
                                    (lambda (p)
                                        (and
                                            (eq 331 (car p))
                                            (null (vlax-erased-p (cdr p)))
                                        )
                                    )
                                )
                                data1
                            )
                        )
                    )
                )
            )
            (setq hosts
                (if refs
                    (progn
                        (setq hosts
                            (mapcar
                                (function
                                    (lambda (r)
                                        (cdr
                                            (assoc 2
                                                (entget
                                                    (cdr
                                                        (assoc
                                                            330
                                                            (reverse (entget r))
                                                        )
                                                    )
                                                )
                                            )
                                        )
                                    )
                                )
                                refs
                            )
                        )
                        (mpx-strings-to-csv hosts)
                    )
                    ""
                )
            )       
            (setq ref-handles
                (if refs
                    (progn
                        (setq ref-handles
                            (mapcar
                                (function (lambda (r) (cdr (assoc 5 (entget r)))))
                                refs
                            )
                        )
                        (mpx-strings-to-csv ref-handles)
                    )
                    ""
                )
            )
        )
        (   t
            (setq ref-count
                (length
                    (setq ref-data
                        (vl-remove-if-not
                            (function (lambda (l) (eq name (car l))))
                            (mpx-get-nested-block-parentage blocks)
                        )
                    )       
                )
            )                           
            (setq
                hosts       (mpx-strings-to-csv (mapcar 'cadr ref-data))
                ref-handles (mpx-strings-to-csv (mapcar 'caddr ref-data))
            )
        )
    )
   
    (setq
        name!        (strcase name)
        correct-name (if (eq name! (strcase (vl-filename-base path))) "TRUE" "FALSE")
    )

    (list
        (cons "Name:" name)
        (cons "CorrectName:" correct-name)
        (cons "SavedPath:" path)
        (cons "AbsolutePath:" path-absolute)
        (cons "FileExists:" found)
        (cons "LoadState:" state)
        (cons "XRefType:" xref-type)
        (cons "PathType:" path-type)
        (cons "RefCount:" ref-count)
        (cons "RefHandle(s):" ref-handles)
        (cons "Host(s):" hosts)
        (cons "Nested:" nested)
    )
)
;;  test on current dwg

(vlax-for b (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
    (if (eq :vlax-true (vla-get-isxref b))
        (progn
            (mapcar 'print (mpx-get-xref-props b))
            (princ "\n")
        )           
    )
    (princ)
)

Active drawing: "xrefs.dwg"

("Name:" . "1")
("CorrectName:" . "TRUE")
("SavedPath:" . "1.dwg")
("AbsolutePath:" . "H:\\RIBARM\\xrefs - problem with findclosestpointto\\1.dwg")
("FileExists:" . "TRUE")
("LoadState:" . "RESOLVED")
("XRefType:" . "ATTACH")
("PathType:" . "RELATIVE")
("RefCount:" . 2)
("RefHandle(s):" . "207,212")
("Host(s):" . "*Model_Space,*Model_Space")
("Nested:" . "FALSE")

("Name:" . "blocks")
("CorrectName:" . "TRUE")
("SavedPath:" . "blocks.dwg")
("AbsolutePath:" . "H:\\RIBARM\\xrefs - problem with findclosestpointto\\blocks.dwg")
("FileExists:" . "TRUE")
("LoadState:" . "RESOLVED")
("XRefType:" . "ATTACH")
("PathType:" . "RELATIVE")
("RefCount:" . 3)
("RefHandle(s):" . "204,205,206")
("Host(s):" . "1,1,1")
("Nested:" . "TRUE")

("Name:" . "xx")
("CorrectName:" . "TRUE")
("SavedPath:" . "xx.dwg")
("AbsolutePath:" . "H:\\RIBARM\\xrefs - problem with findclosestpointto\\xx.dwg")
("FileExists:" . "TRUE")
("LoadState:" . "RESOLVED")
("XRefType:" . "ATTACH")
("PathType:" . "RELATIVE")
("RefCount:" . 4)
("RefHandle(s):" . "20E,20F,210,211")
("Host(s):" . "*Model_Space,*Model_Space,*Model_Space,*Model_Space")
("Nested:" . "FALSE")

("Name:" . "x")
("CorrectName:" . "TRUE")
("SavedPath:" . "x.dwg")
("AbsolutePath:" . "H:\\RIBARM\\xrefs - problem with findclosestpointto\\x.dwg")
("FileExists:" . "TRUE")
("LoadState:" . "RESOLVED")
("XRefType:" . "ATTACH")
("PathType:" . "RELATIVE")
("RefCount:" . 1)
("RefHandle(s):" . "204")
("Host(s):" . "xx")
("Nested:" . "TRUE")

("Name:" . "_x")
("CorrectName:" . "TRUE")
("SavedPath:" . "_x.dwg")
("AbsolutePath:" . "H:\\RIBARM\\xrefs - problem with findclosestpointto\\_x.dwg")
("FileExists:" . "TRUE")
("LoadState:" . "RESOLVED")
("XRefType:" . "ATTACH")
("PathType:" . "RELATIVE")
("RefCount:" . 4)
("RefHandle(s):" . "259,25A,25B,25C")
("Host(s):" . "*Model_Space,*Model_Space,*Model_Space,*Model_Space")
("Nested:" . "FALSE")

Cheers & Happy New Year.

[ribarm]

Awaysome, thank you very much MP... It looks I took you some time from your holidays... That was not my intention, so it's hihgly appreciated... Thanks to your subs, I've upgraded my versions with tree branching... All info is present even more than it was expected... Take a rest and take care MP... I hope you are enjoying New Year holiday, wish you good health and joy and money in 2020...

Cheers...

[MP]

My pleasure MR - thank you for the kind wishes - back at you tenfold. If you flag any issues with the code let me know - was pounded out quick before my wife kicked me off my pc - "you're supposed to be on holidays!" - "yeah but this stuff is fun!".

[Marc'Antonio Alessi]

... "yeah but this stuff is fun!".

Grazie per quello che fai per gli altri e Buon Anno.   
Marco

[MP]

Grazie per quello che fai per gli altri e Buon Anno.   
Marco

Grazie per le belle parole amico mio. Possa tu e la tua famiglia essere benedetti con grande gioia, felicità e fortuna per tutto l'anno. Spero che questo si traduca bene. 

[Marc'Antonio Alessi]

Grazie per quello che fai per gli altri e Buon Anno.   
Marco

Grazie per le belle parole amico mio. Possa tu e la tua famiglia essere benedetti con grande gioia, felicità e fortuna per tutto l'anno. Spero che questo si traduca bene. 

Perfect translation!
I take this opportunity to extend my wishes and thanks to everyone who reads and collaborates in this group.