Here is a completely rewritten version:
Supply it with the directory to process, block name and attribute tag list.
;|
function to extract 2 attribute values from a specific block in the drawings of a specified folder
by Jeff Mishler Feb. 9, 2006
And kindly edited by Tim Willey to extract any number of attributes
Modified by Lee Mac to process open drawings
Modified by CAB forced Tags to match to Tags strings in all upper case
Rewritten by Lee Mac 14.11.2011 to process a directory supplied as an argument.
|;
(defun getindex ( directory blknme attlst / acapp acdocs dbx doc lst pair result tmp x )
(setq attlst (mapcar '(lambda ( x ) (cons (strcase x) "")) attlst)
blknme (strcase blknme)
)
(if
(and
(vl-file-directory-p
(setq directory
(vl-string-right-trim "\\" (vl-string-translate "/" "\\" directory))
)
)
(setq lst
(mapcar
(function
(lambda ( x ) (strcat directory "\\" x))
)
(vl-directory-files directory "*.dwg" 1)
)
)
)
(progn
(setq acapp (vlax-get-acad-object))
(vlax-for doc (vla-get-documents acapp)
(setq acdocs (cons (cons (strcase (vla-get-fullname doc)) doc) acdocs))
)
(setq dbx (LM:ObjectDBXDocument acapp))
(foreach dwg lst
(if
(and
(setq doc
(cond
( (cdr (assoc (strcase dwg) acdocs)))
( (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list dbx dwg)))) dbx)
)
)
(not
(vl-catch-all-error-p
(vl-catch-all-apply 'vla-item (list (vla-get-blocks doc) blknme))
)
)
)
(vlax-for layout (vla-get-layouts doc)
(if (not (eq "MODEL" (strcase (vla-get-name layout))))
(vlax-for obj (vla-get-block layout)
(if
(and
(eq "AcDbBlockReference" (vla-get-objectname obj))
(eq blknme
(if (vlax-property-available-p obj 'effectivename)
(strcase (vla-get-effectivename obj))
(strcase (vla-get-name obj))
)
)
(eq :vlax-true (vla-get-hasattributes obj))
)
(progn
(setq tmp attlst)
(foreach att (vlax-invoke obj 'getattributes)
(if (setq pair (assoc (strcase (vla-get-tagstring att)) tmp))
(setq tmp (subst (cons (car pair) (vla-get-textstring att)) pair tmp))
)
)
(setq result (cons (cons (vl-filename-base dwg) tmp) result))
)
)
)
)
)
)
)
(foreach obj (list doc dbx acapp)
(if (and obj (eq 'VLA-OBJECT (type obj)) (not (vlax-object-released-p obj)))
(vlax-release-object obj)
)
)
)
)
(reverse result)
)
(defun LM:ObjectDBXDocument ( acapp / acver )
(vla-GetInterfaceObject acapp
(if (< (setq acver (atoi (getvar "ACADVER"))) 16)
"ObjectDBX.AxDbDocument"
(strcat "ObjectDBX.AxDbDocument." (itoa acver))
)
)
)
Untested, so I hope I haven't missed anything...