Author Topic: Getting List of References without Opening Drawings  (Read 3814 times)

0 Members and 1 Guest are viewing this topic.

cmwade77

  • Swamp Rat
  • Posts: 1443
Getting List of References without Opening Drawings
« on: August 23, 2019, 01:46:07 PM »
Not sure which board to post this in, please move if the wrong one.

Does anyone know if it is possible to use the Windows Command Prompt to generate a list of all references and nested references in a drawing?

I would want the list to be a CSV file, but I need it from the command prompt, as I want to automate getting the list of references without opening AutoCAD.

Or is there some other way to get a list of all references (including nested ones) without opening drawings?

ronjonp

  • Needs a day job
  • Posts: 7526

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: Getting List of References without Opening Drawings
« Reply #2 on: August 23, 2019, 02:31:34 PM »
That might just be a good starting point for me, although I will need to make a lot of adjustments so it returns all references, like PDF underlays, PC3 files, etc. and make it work the way I need it to, but should be doable.

ronjonp

  • Needs a day job
  • Posts: 7526
Re: Getting List of References without Opening Drawings
« Reply #3 on: August 23, 2019, 02:35:53 PM »
That might just be a good starting point for me, although I will need to make a lot of adjustments so it returns all references, like PDF underlays, PC3 files, etc. and make it work the way I need it to, but should be doable.
PC3 files ? Those are part of preferences object which is static per profile ( I think ).

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: Getting List of References without Opening Drawings
« Reply #4 on: August 23, 2019, 02:38:25 PM »
Sorry, I mistyped, i meant CTB/STB files....too many things going on at once...LOL

But like I said, this will be a good starting point and shouldn't be too complicated to change, if it works, I will post what I come up with, as it may help others as well.

jbuzbee

  • Swamp Rat
  • Posts: 851
Re: Getting List of References without Opening Drawings
« Reply #5 on: August 23, 2019, 02:52:26 PM »
do a search for ObjectDBX
James Buzbee
Windows 8

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: Getting List of References without Opening Drawings
« Reply #6 on: August 23, 2019, 07:15:32 PM »
Ok, can someone explain to me why Images are not being returned with this? I am pretty sure the code is correct and should work.

Code: [Select]
;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
    ;----------------------------------------------------------
    (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-Name i))) (strcase str))
                        (= str "")
                    )
                )
                (setq tempList (cons tempName tempList))
            )
        )
        tempList
    )
    ;Find Images
        ;----------------------------------------------------------
    (defun FindImages (doc str / tempName tempList)
       
        (vlax-for i (vla-get-Blocks doc)
            (if
                (and
                    (= (vla-get-objectname i) "AcDbRasterImage")
                    (or
                        (wcmatch (strcase (setq tempName (vla-get-Name i))) (strcase str))
                        (= str "")
                    )
                )
                (setq tempList (cons tempName tempList))
            )
        )
        tempList
    )
    ;-------------------------------------------------
    (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)))
        )
        (if (setq tempList (cddr (vl-directory-files dir "*" -1)))
            (foreach i tempList
                (setq FileList (append FileList (GetAllFiles (strcat dir i) ext)))
            )
        )
        FileList
    )
    ;----------------------------------------------------------------
    (if
        (and
            ;(setq CkStr (getstring "\n Enter name to check for [*]: "))
            (setq CkStr "*")
            (setq DirPath (Directory-Dia "Select directory to search for xrefs."))
            (setq DwgList (GetAllFiles DirPath "*.dwg"))
            (setq Opened (open (setq tempFile (strcat Dirpath "XrefFindReport.txt")) "w"))
            (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 XrFound (FindXrefs dbxApp CkStr))
                        (progn
                            (write-line "XRefs:" Opened)
                            (write-line (strcat "- " i) Opened)
                            (foreach j XrFound
                                (write-line (strcat "    " j) Opened)
                            )
                            (write-line "\n" Opened)
                        )
                    )
                    (if (setq ImFound (FindImages dbxApp CkStr))
                        (progn
                            (write-line "Images:" Opened)
                            (write-line (strcat "- " i) Opened)
                            (foreach j ImFound
                                (write-line (strcat "    " j) Opened)
                            )
                            (write-line "\n" Opened)
                        )
                    )
                )
               
            )
        )
    )
    (prompt (strcat "\n Log file: " tempFile))
    (*error* nil)
    (princ)
)

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: Getting List of References without Opening Drawings
« Reply #7 on: August 23, 2019, 07:51:04 PM »
Actually, I was able to get a fair amount incorporated, the code below should find the following types of references:
  • x-Refs
  • PDFs
  • DGNs
  • DWFs
  • Images
  • BIM Definitions

The follow still need to be implemented:
  • Fonts
  • WebLights
  • Materials
  • Plot Styles
  • PC3 Files (I did find out these should be included as they can be assigned to drawings)
  • DST Files

Additionally, the code quite often returns a relative path and this should be resolved to a full path to make it easier to know where the files are saved.

Code: [Select]
;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
    ;----------------------------------------------------------
    (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-Name 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"))
        )
    )
    ;-------------------------------------------------
    (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)))
        )
        (if (setq tempList (cddr (vl-directory-files dir "*" -1)))
            (foreach i tempList
                (setq FileList (append FileList (GetAllFiles (strcat dir i) ext)))
            )
        )
        FileList
    )
    ;----------------------------------------------------------------
    (if
        (and
            ;(setq CkStr (getstring "\n Enter name to check for [*]: "))
            (setq CkStr "*")
            (setq DirPath (Directory-Dia "Select directory to search for xrefs."))
            (setq DwgList (GetAllFiles DirPath "*.dwg"))
            (setq Opened (open (setq tempFile (strcat Dirpath "XrefFindReport.txt")) "w"))
            (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 XrFound (FindXrefs dbxApp CkStr))
                        (progn
                            (write-line "XRefs:" Opened)
                            (write-line (strcat "- " i) Opened)
                            (foreach j XrFound
                                (write-line (strcat "    " j) Opened)
                            )
                            (write-line "\n" Opened)
                        )
                    )
                    (if (setq ImFound (FindImages dbxApp))
                        (progn
                            (write-line "Images:" Opened)
                            (write-line (strcat "- " i) Opened)
                            (foreach j ImFound
                                (write-line (strcat "    " j) Opened)
                            )
                            (write-line "\n" Opened)
                        )
                    )
                    (if (setq PDFsFound (FindPDFs dbxApp))
                        (progn
                            (write-line "PDFs:" Opened)
                            (write-line (strcat "- " i) Opened)
                            (foreach j PDFsFound
                                (write-line (strcat "    " j) Opened)
                            )
                            (write-line "\n" Opened)
                        )
                    )
                    (if (setq DWFsFound (FindDWFs dbxApp))
                        (progn
                            (write-line "DWFs:" Opened)
                            (write-line (strcat "- " i) Opened)
                            (foreach j DWFsFound
                                (write-line (strcat "    " j) Opened)
                            )
                            (write-line "\n" Opened)
                        )
                    )
                    (if (setq DGNsFound (FindDGNs dbxApp))
                        (progn
                            (write-line "DGNs:" Opened)
                            (write-line (strcat "- " i) Opened)
                            (foreach j DGNsFound
                                (write-line (strcat "    " j) Opened)
                            )
                            (write-line "\n" Opened)
                        )
                    )
                    (if (setq CloudsFound (FindClouds dbxApp))
                        (progn
                            (write-line "Point Clouds:" Opened)
                            (write-line (strcat "- " i) Opened)
                            (foreach j CloudsFound
                                (write-line (strcat "    " j) Opened)
                            )
                            (write-line "\n" Opened)
                        )
                    )
                    (if (setq BIMFound (FindBIM dbxApp))
                        (progn
                            (write-line "BIM Definitions:" Opened)
                            (write-line (strcat "- " i) Opened)
                            (foreach j BIMFound
                                (write-line (strcat "    " j) Opened)
                            )
                            (write-line "\n" Opened)
                        )
                    )
                )
               
            )
        )
    )
    (prompt (strcat "\n Log file: " tempFile))
    (*error* nil)
    (princ)
)

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: Getting List of References without Opening Drawings
« Reply #8 on: August 23, 2019, 11:08:38 PM »
I would prefer the paths, but names will do, but as I said in my more recent post, I got the images.

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: Getting List of References without Opening Drawings
« Reply #9 on: August 24, 2019, 08:06:29 AM »
AFAIK materials are stored in the DWG and therefore are not external dependencies.

For some external dependencies only the base name is stored. The full path will depend on the search path and/or the OS. So your preference does not always make sense.

Code - Auto/Visual Lisp: [Select]
  1. (defun FindFonts (doc)
  2.   (RemoveStringDubs (mapcar 'vla-get-fontfile (_GetItems (vla-get-textstyles doc))))
  3. )
  4.  
  5. (defun FindStyleSheets (doc) ; *.stb or *.ctb.
  6.   (RemoveStringDubs
  7.     (vl-remove
  8.       ""
  9.       (mapcar
  10.         'vla-get-stylesheet
  11.         (append
  12.           (_GetItems (vla-get-layouts doc))
  13.           (_GetItems (vla-get-plotconfigurations doc))
  14.         )
  15.       )
  16.     )
  17.   )
  18. )
  19.  
  20. (defun FindConfigNames (doc) ; *.pc3
  21.   (RemoveStringDubs
  22.     (vl-remove
  23.       "None"
  24.       (mapcar
  25.         'vla-get-configname
  26.         (append
  27.           (_GetItems (vla-get-layouts doc))
  28.           (_GetItems (vla-get-plotconfigurations doc))
  29.         )
  30.       )
  31.     )
  32.   )
  33. )
  34.  
  35. ; (RemoveStringDubs '("aa" "bb" "AA" "Cc" "DD" "dd"))
  36. (defun RemoveStringDubs (strLst / done  ret)
  37.   (foreach str strLst
  38.     (if (not (vl-position (strcase str) done))
  39.       (progn
  40.         (setq done (cons (strcase str) done))
  41.         (setq ret (cons str ret))
  42.       )
  43.     )
  44.   )
  45.   (reverse ret)
  46. )

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: Getting List of References without Opening Drawings
« Reply #10 on: August 24, 2019, 11:23:05 AM »
In newer versions of AutoCAD, materials are external dependencies. The list of types dependencies are something I got from Autodesk directly, I am parsing the code to get what is needed and you are right, some are stored as names only, but there are usually related settings that tells us where those items are stored, some are application wide settings, so those will be easy. Thank you for your code, I would have eventually got both of those, but this helps, the hard one is the DST file at the moment for some reason.

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: Getting List of References without Opening Drawings
« Reply #11 on: August 24, 2019, 01:41:26 PM »
... the hard one is the DST file at the moment for some reason.

Not sure what aspect you’re struggling with. If it’s deciphering DST contents perhaps this will help.
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: Getting List of References without Opening Drawings
« Reply #12 on: August 24, 2019, 01:53:04 PM »
No, getting the associated DST file

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: Getting List of References without Opening Drawings
« Reply #13 on: August 24, 2019, 03:36:33 PM »
May work:

Code: [Select]
(defun _Get-Sheetset-Filename ( doc / result )   
   (vl-catch-all-apply
      '(lambda ( )
            (setq result
                (cdr
                    (assoc 1
                        (entget
                            (vlax-vla-object->ename
                                (vla-item
                                    (vla-item
                                        (vla-get-dictionaries doc) 
                                        "AcSheetSetData"
                                    )                                       
                                    "ShSetFileName"
                                )
                            )
                        )
                    )
                )
            )
        )                                               
   )   
   result
)
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: Getting List of References without Opening Drawings
« Reply #14 on: August 27, 2019, 03:27:39 PM »
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.
Code: [Select]
;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)
)