Hi MR, the following cobbled together code may provided some illumination ...
(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)))
)
)
(defun mpx-join-folders ( parts )
(if parts
(apply 'strcat
(cons
(car parts)
(mapcar (function (lambda (p) (strcat "\\" p))) (cdr parts))
)
)
""
)
)
(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)
)
)
("")
)
)
(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)
)
(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)
)
(defun mpx-strings-to-csv ( strings )
(apply 'strcat
(cons
(car strings)
(mapcar (function (lambda (s) (strcat "," s))) (cdr strings))
)
)
)
(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.