Ok, I have my basic code, although not all relative paths seem to fully resolve correctly, other than that, this does the trick. I also modified the code to make a CSV file instead of a text file, that way it will be easier to read.
;Original Code by T-Willey from: http://www.theswamp.org/index.php?topic=24406.msg295012#msg295012
(defun c:GetRefs (/ *error* FindXrefs GetAllFiles CkStr DirPath DwgList DiaRtn Opened dbxApp oVer tempFile ImFound)
; This will search the directory selected, and all subdirectories to find the xref name entered.
; The xref name is not case sensitive, and can be entered as a partial string; ie *-a-*
; will work.
; The text file will be placed in the directory selected, and it will only list drawings that had
; xref names match the string, or had an error upon opening.
(defun *error* (msg)
(if dbxApp (vlax-release-object dbxApp))
(setq dbxApp nil)
(if Opened (close Opened))
(if msg
(prompt (strcat "\n Error --> " msg))
)
)
;Find xrefs
;----------------------------------------------------------
;; Returns a filename based on the resolved path
;; Usage: (ResolveRelativePath "..\\grid.dwg" (getvar "dwgprefix"))
(defun ResolveRelativePath (fileNamePath dwgPath / )
; Check for relative paths and attempt to resolve the path to the xref
(cond
; Relative path, should resolve multiple levels of relative folders; DWG file must be saved
((and (= (substr fileNamePath 1 2) "..")(/= (getvar "dwgprefix") ""))
(while (= (substr fileNamePath 1 2) "..")
(setq fileNamePath (substr fileNamePath 4)
dwgPath (substr dwgPath 1 (vl-string-position (ascii "\\") dwgPath 0 T))
)
)
(setq fileNamePath (strcat dwgPath "\\" fileNamePath))
)
; Absolute paths, resolves only the top level folder; DWG file must be saved
((and (= (substr fileNamePath 1 1) ".")(/= (getvar "dwgprefix") ""))
(setq fileNamePath (substr fileNamePath 3)
fileNamePath (strcat dwgPath "\\" fileNamePath)
)
)
)
; Check to see if the fileNamePath is valid, if not then attempt to locate the file in the working support path
(if (not (findfile fileNamePath))
(setq fileNamePath (findfile (strcat (vl-filename-base fileNamePath) (vl-filename-extension fileNamePath))))
(if (= (vl-filename-directory fileNamePath) "")
(setq fileNamePath (findfile fileNamePath))
)
)
; Returns the resolved path with filename, if the path couldn't be resolved
; then the original fileNamePath is returned
fileNamePath
)
(defun FindXrefs (doc str / tempName tempList)
(vlax-for i (vla-get-Blocks doc)
(if
(and
(= (vla-get-IsXref i) :vlax-true)
(or
(wcmatch (strcase (setq tempName (vla-get-Path i))) (strcase str))
(= str "")
)
)
(setq tempList (cons tempName tempList))
)
)
tempList
)
;Find Images
;----------------------------------------------------------
(defun _GetItems ( collection / items )
(vl-catch-all-apply
(function
(lambda ( )
(vlax-for item collection
(setq items (cons item items))
)
)
)
)
(reverse items)
)
(defun _GetItem ( collection key / item )
(vl-catch-all-apply
(function
(lambda ( )
(setq item (vla-item collection key))
)
)
)
item
)
;Find PDFs
;-------------------------------------------------
(defun FindPDFs ( doc )
(mapcar
(function (lambda ( x ) (cdr (assoc 1 (entget (vlax-vla-object->ename x))))))
(_GetItems (_GetItem (vla-get-dictionaries doc) "ACAD_PDFDEFINITIONS"))
)
)
;-------------------------------------------------
;Find Images
;-------------------------------------------------
(defun FindImages ( doc )
(mapcar
(function (lambda ( x ) (cdr (assoc 1 (entget (vlax-vla-object->ename x))))))
(_GetItems (_GetItem (vla-get-dictionaries doc) "ACAD_IMAGE_DICT"))
)
)
;-------------------------------------------------
;Find DWFs
;-------------------------------------------------
(defun FindDWFs ( doc )
(mapcar
(function (lambda ( x ) (cdr (assoc 1 (entget (vlax-vla-object->ename x))))))
(_GetItems (_GetItem (vla-get-dictionaries doc) "ACAD_DWFDEFINITIONS"))
)
)
;-------------------------------------------------
;Find DGNs
;-------------------------------------------------
(defun FindDGNs ( doc )
(mapcar
(function (lambda ( x ) (cdr (assoc 1 (entget (vlax-vla-object->ename x))))))
(_GetItems (_GetItem (vla-get-dictionaries doc) "ACAD_DGNDEFINITIONS"))
)
)
;-------------------------------------------------
;Find Clouds
;-------------------------------------------------
(defun FindClouds ( doc )
(mapcar
(function (lambda ( x ) (cdr (assoc 1 (entget (vlax-vla-object->ename x))))))
(_GetItems (_GetItem (vla-get-dictionaries doc) "ACAD_POINTCLOUD_EX_DICT"))
)
)
;-------------------------------------------------
;Find BIM
;-------------------------------------------------
(defun FindBIM ( doc )
(mapcar
(function (lambda ( x ) (cdr (assoc 1 (entget (vlax-vla-object->ename x))))))
(_GetItems (_GetItem (vla-get-dictionaries doc) "ACAD_BIM_DEFINITIONS"))
)
)
;-------------------------------------------------
;Find Material
;-------------------------------------------------
(defun FindMaterial ( doc )
(mapcar
(function (lambda ( x ) (cdr (assoc 1 (entget (vlax-vla-object->ename x))))))
(_GetItems (_GetItem (vla-get-dictionaries doc) "ACAD_MATERIAL"))
)
)
;-------------------------------------------------
;Find WebLights
;-------------------------------------------------
(defun FindWebLights ( doc )
(mapcar
(function (lambda ( x ) (cdr (assoc 1 (entget (vlax-vla-object->ename x))))))
(_GetItems (_GetItem (vla-get-dictionaries doc) "ADSK_XREC_PHOTOMETRICLIGHTINFO"))
)
)
;-------------------------------------------------
;Find DST
;-------------------------------------------------
(defun FindDST ( doc / result )
(vl-catch-all-apply
'(lambda ( )
(setq result
(entget
(vlax-vla-object->ename
(vla-item
(vla-item
(vla-get-dictionaries doc)
"AcSheetSetData"
)
"ShSetFileName"
)
)
)
)
)
)
result
)
;-------------------------------------------------
;Find Fonts
;-------------------------------------------------
(defun FindFonts (doc)
(RemoveStringDubs (mapcar 'vla-get-fontfile (_GetItems (vla-get-textstyles doc))))
)
;-------------------------------------------------
;Find Plot Styles
;-------------------------------------------------
(defun FindStyleSheets (doc) ; *.stb or *.ctb.
(RemoveStringDubs
(vl-remove
""
(mapcar
'vla-get-stylesheet
(append
(_GetItems (vla-get-layouts doc))
(_GetItems (vla-get-plotconfigurations doc))
)
)
)
)
)
;-------------------------------------------------
;Find Configs
;-------------------------------------------------
(defun FindConfigNames (doc) ; *.pc3
(RemoveStringDubs
(vl-remove
"None"
(mapcar
'vla-get-configname
(append
(_GetItems (vla-get-layouts doc))
(_GetItems (vla-get-plotconfigurations doc))
)
)
)
)
)
; (RemoveStringDubs '("aa" "bb" "AA" "Cc" "DD" "dd"))
(defun RemoveStringDubs (strLst / done ret)
(foreach str strLst
(if (not (vl-position (strcase str) done))
(progn
(setq done (cons (strcase str) done))
(setq ret (cons str ret))
)
)
)
(reverse ret)
)
;-------------------------------------------------
(defun Directory-Dia ( Message / sh folder folderobject result)
;; By Tony Tanzillo
;; Modified by Tim Willey
;; 16 Will let you type in the path
;; 64 Will let you create a new folder
(vl-load-com)
(setq sh
(vla-getInterfaceObject
(vlax-get-acad-object)
"Shell.Application"
)
)
(setq folder
(vlax-invoke-method
sh
'BrowseForFolder
(vla-get-HWND (vlax-get-Acad-Object))
Message
16 ; This is the bit number to change.
)
)
(vlax-release-object sh)
(if folder
(progn
(setq folderobject
(vlax-get-property folder 'Self)
)
(setq result
(vlax-get-property FolderObject 'Path)
)
(vlax-release-object folder)
(vlax-release-object FolderObject)
(if (/= (substr result (strlen result)) "\\")
(setq result (strcat result "\\"))
result
)
)
)
)
;----------------------------------------------------------------
(defun GetAllFiles (dir ext / FileList)
(if (/= (substr dir (strlen dir)) "\\")
(setq dir (strcat dir "\\"))
)
(if (setq tempList (vl-directory-files dir ext 1))
(setq FileList (append FileList (mapcar '(lambda (x) (strcat dir x)) tempList)))
)
FileList
)
;----------------------------------------------------------------
(if
(and
;(setq CkStr (getstring "\n Enter name to check for [*]: "))
(setq CkStr "*");This only affects x-Refs
(setq DirPath (Directory-Dia "Select directory to search for xrefs."))
(setq DwgList (GetAllFiles DirPath "*.dwg"))
(setq Opened (open (setq tempFile (strcat Dirpath "XrefFindReport.csv")) "w"))
(write-line "\"Reference Type\",\"Reference Name\",\"Host Drawing\"" Opened)
(setq dbxApp
(if (< (atoi (setq oVer (substr (getvar "acadver") 1 2))) 16)
(vla-GetInterfaceObject (vlax-get-acad-object) "ObjectDBX.AxDbDocument")
(vla-GetInterfaceObject (vlax-get-acad-object) (strcat "ObjectDBX.AxDbDocument." oVer))
)
)
)
(foreach i DwgList
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-Open (list dbxApp i)))
(write-line (strcat "++ Error opening file: " i "\n") Opened)
(progn
(if (setq DSTFound (FindDST dbxApp))
(progn
(write-line (strcat "\"Sheet Set Manager File (.DST)\",\"" (cdr (Assoc 1 DSTFound)) "\",\"" i "\"") Opened)
)
)
(if (setq XrFound (FindXrefs dbxApp CkStr))
(progn
(foreach j XrFound
(setq fPath (ResolveRelativePath j DirPath))
(if (= fPath nil)
(write-line (strcat "\"X-Ref\",\"" j "\",\"" i "\"") Opened)
(write-line (strcat "\"X-Ref\",\"" fPath "\",\"" i "\"") Opened)
)
)
)
)
(if (setq ImFound (FindImages dbxApp))
(progn
(foreach j ImFound
(write-line (strcat "\"Image\",\"" j "\",\"" i "\"") Opened)
)
)
)
(if (setq PDFsFound (FindPDFs dbxApp))
(progn
(foreach j PDFsFound
(write-line (strcat "\"PDF\",\"" j "\",\"" i "\"") Opened)
)
)
)
(if (setq DWFsFound (FindDWFs dbxApp))
(progn
(foreach j DWFsFound
(write-line (strcat "\"DWF\",\"" j "\",\"" i "\"") Opened)
)
)
)
(if (setq DGNsFound (FindDGNs dbxApp))
(progn
(foreach j DGNsFound
(write-line (strcat "\"DGN\",\"" j "\",\"" i "\"") Opened)
)
)
)
(if (setq CloudsFound (FindClouds dbxApp))
(progn
(foreach j CloudsFound
(write-line (strcat "\"Point Cloud\",\"" j "\",\"" i "\"") Opened)
)
)
)
(if (setq BIMFound (FindBIM dbxApp))
(progn
(foreach j BIMFound
(write-line (strcat "\"BIM Definition\",\"" j "\",\"" i "\"") Opened)
)
)
)
(if (setq MaterialFound (FindMaterial dbxApp))
(progn
(foreach j MaterialFound
(write-line (strcat "\"Material\",\"" j "\",\"" i "\"") Opened)
)
)
)
(if (setq WebLightsFound (FindWebLights dbxApp))
(progn
(foreach j WebLightsFound
(write-line (strcat "\"Web Light\",\"" j "\",\"" i "\"") Opened)
)
)
)
(if (setq FontsFound (FindFonts dbxApp))
(progn
(foreach j FontsFound
(setq FullName j)
(if (/= FullName nil)
(progn
; Determine the current OS: Windows or Mac
(if (wcmatch (strcase (getvar "platform")) "*WINDOWS*")
(if (findfile (strcat (getenv "WINDIR") "\\fonts\\" FullName))
(setq FullName (strcat (getenv "WINDIR") "\\fonts\\" FullName))
(setq FullName (findfile FullName))
)
; Mac OS currently not supported - (wcmatch (strcase (getvar "platform")) "*MAC*")
(setq FullName "")
)
)
)
(if (/= FullName nil)
(if (/= FullName "")
(write-line (strcat "\"Font\",\"" FullName "\",\"" i "\"") Opened)
(write-line (strcat "\"Font\",\"" j "\",\"" i "\"") Opened)
)
(write-line (strcat "\"Font\",\"" j "\",\"" i "\"") Opened)
)
)
)
)
(if (setq PlotStylesFound (FindStyleSheets dbxApp))
(progn
(foreach j PlotStylesFound
(write-line (strcat "\"Plot Style\",\"" j "\",\"" i "\"") Opened)
)
)
)
(if (setq PlotConfigsFound (FindConfigNames dbxApp))
(progn
(foreach j PlotConfigsFound
(write-line (strcat "\"Plot Config\",\"" j "\",\"" i "\"") Opened)
)
)
)
)
)
)
)
(prompt (strcat "\n Log file: " tempFile))
(*error* nil)
(princ)
)