;;; Print Report for all files and it's xrefs in a folder
;;; Published by BlackBox.
;;; Saved from: http://forums.augi.com/showthread.php?152990-Listing-all-xrefs-attached-to-a-group-of-(unopened)-drawings-to-xls-file

(vl-load-com)

(defun c:xrf (/ *error* _WriteXrefData acApp acDocs oShell oFolder path dwgs
filePath dbxDoc file doc ok
)
(princ "\rPrint report for all files and it's xrefs in a folder")

(defun *error* (msg)
(if file
(close file)
)
(if oShell
(vlax-release-object oShell)
)
(if dbxDoc
(vlax-release-object dbxDoc)
)
(cond ((not msg)) ; Normal exit
((member msg '("Function cancelled" "quit / exit abort"))) ; or (quit)
((princ (strcat "\n** Error: " msg " ** "))) ; Fatal error, display it
)
(princ)
)

(defun _WriteXrefData (doc)
(vlax-for x (vla-get-blocks doc)
(if (= :vlax-true (vla-get-isxref x))
(progn
(or ok (setq ok T))
(write-line
(strcat dwg
","
(vla-get-name x)
".dwg,"
(vla-get-path x)
)
file
)
)
)
)
)

(if
(and
(setq acApp (vlax-get-acad-object))
(setq acDocs (vla-get-documents acApp))
(setq oShell (vla-getinterfaceobject acApp "Shell.Application"))
(setq oFolder (vlax-invoke
oShell
'BrowseForFolder
(vla-get-hwnd acApp)
"Select Project files folder:"
0
(+ 1 64 256)
)
)
(setq path (vlax-get-property
(vlax-get-property oFolder 'Self)
'Path
)
)
(setq dwgs (vl-directory-files path "*.dwg" 1))
(setq filePath
(strcat
(vl-filename-directory
(vl-filename-mktemp)
)
"\\Folder Xref Report_"
(menucmd
"M=$(edtime,$(getvar,date),DD-MO-YYYY)"
)
".txt"
)
)
(princ "\nWorking, please wait...")
(princ)
(setq dbxDoc (vla-getinterfaceobject
acApp
(strcat "ObjectDBX.AxDbDocument."
(substr (getvar 'acadver) 1 2)
)
)
)
)
(progn
(setq file (open filePath "w"))
(write-line "Project Directory:" file)
(write-line path file)
(write-line "" file)
(write-line "Main Drawing: Reference Name: Saved Path:" file)
(foreach dwg dwgs
(cond
((not
(vl-catch-all-error-p
(setq doc
(vl-catch-all-apply
'vla-item
(list (vla-get-documents acApp) dwg)
)
)
)
)
(_WriteXrefData doc)
)
((not
(vl-catch-all-error-p
(vl-catch-all-apply
'vla-open
(list dbxDoc (strcat path "\\" dwg))
)
)
)
(_WriteXrefData dbxDoc)
)
((write-line
(strcat dwg ",Unable to open drawing. ")
file
)
)
)
)
(princ "Done.")
(if ok
(vlax-invoke oShell 'open filePath)
(prompt "\n** No references found ** ")
)
)
(cond
(filePath
(prompt
"\n** Unable to create \"ObjectDBX.AxDbDocument\" Object ** "
)
)
(path (prompt "\n** No drawings found ** "))
(oShell (prompt "\n** No folder selected ** "))
(acDocs
(prompt
"\n** Unable to create \"Shell.Application\" Object ** "
)
)
)
)
(*error* nil)
)
(c:xrf)

Advertisements