I'm pretty happy with how this turned out, for such little time spent.
The BatchFindSurface Command prompts the user to specify a directory to search, and if drawings are found, proceeds to open each drawing programmatically using ObjectDBX, searching ModelSpace for Surfaces, and writing each Surface's data to file. If Surfaces are found, the file is opened, otherwise a message is displayed at the command line.
Code:
(vl-load-com)
(defun c:BFindSurf () (c:BatchFindSurface))
(defun c:BatchFindSurface
(/ *error*
C3d-Get-Surfaces
RM:GetDate RM:GetTime
RM:WriteData
)
;; RenderMan, 2012, AUGI.com
(princ "\rBATCHFINDSURFACE ")
(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"))) ; <esc> or (quit)
((princ (strcat "\n** Error: " msg " ** ")))
) ; Fatal error, display it
(princ)
)
(defun C3d-Get-Surfaces (oDoc / objectName surfaces)
(vlax-for x (vla-get-block
(vla-get-layout (vla-get-modelspace oDoc))
)
(if (and (wcmatch
(setq objectName (vla-get-objectname x))
"AeccDbSurface*"
)
(not (vl-string-search "Label" objectName))
(= 0 (vlax-invoke x 'isreferenceobject))
)
(setq surfaces (cons x surfaces))
)
)
(if surfaces
(cons (length surfaces) (reverse surfaces))
)
)
(defun RM:GetDate (date)
(setq date (mapcar '(lambda (x) (itoa x)) date))
(strcat (nth 0 date) "-" (nth 1 date) "-" (nth 3 date))
)
(defun RM:GetTime (date / hr mn)
(setq hr (nth 4 date))
(setq mn (itoa (nth 5 date)))
(if (= 1 (strlen mn))
(setq mn (strcat "0" mn))
)
(cond ((> 12 hr) (strcat (itoa hr) ":" mn " AM"))
((strcat (itoa (- hr 12)) ":" mn " PM"))
)
)
(defun RM:WriteData (dbxDoc file surface / path date)
(write-line
(vl-string-right-trim
","
(apply
'strcat
(mapcar
'(lambda (x) (strcat x ","))
(list (setq path (vla-get-name dbxDoc))
(RM:GetDate (setq date (vl-file-systime path)))
(RM:GetTime date)
(vla-get-name surface)
(vla-get-description surface)
(vla-get-handle surface)
(vla-get-layer surface)
(vla-get-stylename surface)
(vla-get-objectname surface)
)
)
)
)
file
)
)
((lambda (acApp dwgName / oShell oFolder path
dwgs filePath dbxDoc file surfaces ok
)
(if (and (setq oShell
(vla-getinterfaceobject acApp "Shell.Application")
)
(setq oFolder
(vlax-invoke
oShell
'BrowseForFolder
(vla-get-hwnd acApp)
"Select folder to search:"
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))
"\\Batch Find Surface Report_"
(menucmd "M=$(edtime,$(getvar,date),YYYY-MO-DD)")
".csv"
)
)
(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 "Directory Searched:" file)
(write-line path file)
(write-line "" file)
(write-line
"Drawing:,Date:,Time:,Surface:,Description:,Handle:,Layer:,Style:,Type:"
file
)
(foreach dwg dwgs
(if (/= dwg dwgName)
(progn
(vl-catch-all-apply
'vla-open
(list dbxDoc (strcat path "\\" dwg))
)
(if (setq surfaces (C3d-Get-Surfaces dbxDoc))
(progn
(or ok (setq ok T))
(foreach surface (cdr surfaces)
(RM:WriteData dbxDoc file surface)
)
)
)
)
)
)
(princ "Done.")
(setq file (close file))
(if ok
(vlax-invoke oShell 'open filePath)
(prompt "\n** No surfaces found ** ")
)
(*error* nil)
)
(cond
(file
(*error*
"Unable to create \"ObjectDBX.AxDbDocument\" Object"
)
)
(oFolder (*error* "No drawings found"))
(oShell (*error* "No folder selected"))
(fso
(*error* "Unable to create \"Shell.Application\" Object")
)
((*error*
"Unable to create \"Scripting.FileSystemObject\" Object"
)
)
)
)
)
(vlax-get-acad-object)
(getvar 'dwgname)
)
)
To use this LISP routine, see Lee's excellent tutorial here.
Once you've tried the routine, please let me know how this works for you, cheers!