I use this routine for our revisions. It allows the engineers to enter the revision information into an excel file then places it in the title block based on attribute names. You will have to modify it for your use, as we only have 6 revisions in our title block. you might also have to revise how your title blocks are set up so they all have the same tags in the revisions.
Code:
(defun c:rxl2rt (/ Col1ndx Col2ndx Col3ndx Col4ndx
strFileName Sheetname strSheetName
rawlst itm lst itm2 lstln
counter ss Ent Entdata Att
tmpList nillist date6
)
;;=========================================================
;; Read the Excel File & Create the Table
;;=========================================================
;;*****************************
;;*** Table data needed ***
;;*****************************
(setq Col1ndx 1 ;Revision Number
Col2ndx 2 ;Revision Descrreviption
Col3ndx 3 ;Revision By
Col4ndx 4 ;Revision Date
strFileName (strcat (getvar "dwgprefix") "Revisions.xls")
Sheetname (getvar "ctab")
strSheetName "Sheet1"
nillist (list "" "" "" "")
) ;_ end of setq
(if (/= (getvar "ctab") "Model")
(if (/= (findfile strFileName) nil)
(progn
;;********************************************
;;*** Get the data fron the excel file ***
;;********************************************
(prompt "n >>>---> Reading Excel, Please wait.n")
(setq rawlst (GET_xl_sheet strFileName strSheetName))
(and (null rawlst)
(prompt "n*** Check Tab name in XL file ***")
) ;_ end of and
(if rawlst
(progn
(setq rawlst (cdr rawlst))
(foreach itm rawlst
(if (or (null (vl-position nil itm)) ; no nill is ok
(> (vl-position nil itm) 3)
) ; no more than 1 of none of the 4 items is allowed to be nil
(progn
(setq itm (reverse itm))
(if (and
(or (wcmatch (car itm)
(strcat "*" (getvar "ctab") "*")
) ;_ end of wcmatch
(= "ALL" (car itm))
(wcmatch (car itm) "*-X*")
) ;_ end of or
(not (wcmatch (car itm)
(strcat "*-" (getvar "ctab") "*")
) ;_ end of wcmatch
) ;_ end of not
) ;_ end of and
(setq lst (cons (list (nth Col4ndx itm)
(nth Col3ndx itm)
(nth Col2ndx itm)
(nth Col1ndx itm)
) ;end list
lst
) ;end cons
) ;end setq
) ;end if
) ;end progn
) ;end if
) ;end foreach
(setq lst (reverse lst))
(setq lstln (length lst))
(while (> lstln 6)
(setq lst (cdr lst)
lstln (length lst)
) ;_ end of setq
) ;end while
(setq lst (reverse lst))
(while (< lstln 6)
(setq lst (cons nillist lst)
lstln (length lst)
) ;_ end of setq
) ;_ end of while
(setq counter 1
ss (ssget "_X"
(list '(-4 . "<and")
(cons 410 (getvar "ctab"))
'(0 . "insert")
'(2 . "TBL12,TBL13,TBL14,TBL15")
(cons 10 '(0 0 0))
'(-4 . "and>")
) ;end list
) ;_ end of ssget
) ;_ end of setq
(if (/= ss nil)
(progn
(foreach itm2 (reverse lst)
(setq Ent (ssname ss 0)
EntData (entget Ent)
) ;_ end of setq
(if
(not
(foreach Att (vlax-invoke
(vlax-ename->vla-object Ent)
'GetAttributes
) ;_ end of vlax-invoke
(if (= (vla-get-TagString Att) (itoa counter))
(setq tmpList
(cons Att (vla-get-TextString Att))
) ;_ end of setq
) ;_ end of if
) ;end foreach
) ;END NOT
(vla-put-TextString (car tmpList) (nth 0 itm2))
(vla-Update (car tmpList))
) ;end if
(if
(not
(foreach Att (vlax-invoke
(vlax-ename->vla-object Ent)
'GetAttributes
) ;_ end of vlax-invoke
(if (= (vla-get-TagString Att)
(strcat "REVDESCRIPTION" (itoa counter))
) ;_ end of =
(setq tmpList
(cons Att (vla-get-TextString Att))
) ;_ end of setq
) ;_ end of if
) ;end foreach
) ;END NOT
(vla-put-TextString (car tmpList) (nth 1 itm2))
(vla-Update (car tmpList))
) ;end if
(if
(not
(foreach Att (vlax-invoke
(vlax-ename->vla-object Ent)
'GetAttributes
) ;_ end of vlax-invoke
(if
(= (vla-get-TagString Att)
(strcat "BY" (itoa counter))
) ;_ end of =
(setq tmpList
(cons Att (vla-get-TextString Att))
) ;_ end of setq
) ;_ end of if
) ;end foreach
) ;END NOT
(vla-put-TextString (car tmpList) (nth 2 itm2))
(vla-Update (car tmpList))
) ;end if
(if
(not
(foreach Att (vlax-invoke
(vlax-ename->vla-object Ent)
'GetAttributes
) ;_ end of vlax-invoke
(if (= (vla-get-TagString Att)
(strcat "DATE" (itoa counter))
) ;_ end of =
(setq tmpList
(cons Att (vla-get-TextString Att))
) ;_ end of setq
) ;_ end of if
) ;end foreach
) ;END NOT
(vla-put-TextString (car tmpList) (nth 3 itm2))
(vla-Update (car tmpList))
) ;end if
; ) ;end progn
; ) ;end if
(setq date6 (nth 3 itm2))
(setq counter (1+ counter))
) ;end foreach
(vla-put-TextString (car tmpList) date6)
) ;_ end of progn
) ;_ end of if
) ;end progn
) ;end if
) ;end progn
(prompt "nNo Revision Data")
) ;end if
(prompt "nCannot Be Run in Model Space")
) ;_ end of if
) ;end defun
;;; --+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
;;;
;;; FUNCTION GET_xl_sheet
;;; Retreaves Excel data from a specified file & sheet name
;;;
;;; ARGUMENTS
;;; File name & path
;;; Workbook sheet name
;;;
;;; USAGE (GET_xl_sheet FileSpec SheetName)
;;;
;;; PLATFORMS 2000+
;;;
;;; Author: Elpanov Evgeny elpanov@gmail.com
;;; Version: 1.0 Dec. 12, 2006
;;;
;;; No error recovery
;;; Can cause Excel to 'Not Finish' while ACAD is open if the
;;; Workbook accessed is open in Excel
;;; --+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
(defun GET_xl_sheet (tbl sheet / ADOCONNECT ADORECORDSET C I i1)
;; by Elpanov Evgeny
;; elpanov@gmail.com
;; The version works with empty rows and columns
(setq ADOConnect (vlax-get-or-create-object "ADODB.Connection")
ADORecordset (vlax-get-or-create-object "ADODB.Recordset")
) ;_ setq
(if
(not
(vl-catch-all-error-p
(vl-catch-all-apply
(function vlax-invoke-method)
(list ADOConnect
"Open"
(strcat "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
tbl
";Extended Properties=;Excel 8.0;HDR=No"
) ;_ strcat
"admin"
""
nil
) ;_ list
) ;_ vl-catch-all-apply
) ;_ vl-catch-all-error-p
) ;_ not
(progn
(if
(member
(strcat sheet "$")
(mapcar
(function (lambda (x)
(if (= (substr x 1 1) "'")
(substr x 2 (- (strlen x) 2))
x
) ;_ if
) ;_ lambda
) ;_ function
(caddr
(mapcar
(function (lambda (a)
(mapcar (function vlax-variant-value) a) ;_ mapcar
) ;_ lambda
) ;_ function
(vlax-safearray->list
(vlax-variant-value
(vlax-invoke-method
(vlax-invoke-method ADOConnect "OpenSchema" 4) ;_ vlax-invoke-method
"GetRows"
65535
) ;_ vlax-invoke-method
) ;_ vlax-variant-value
) ;_ vlax-safearray->list
) ;_ apply
) ;_ caddr
) ;_ mapcar
) ;_ member
(progn
(vlax-invoke-method
ADORecordset
"Open"
(strcat "SELECT * FROM [" sheet "$]")
ADOConnect
1
3
nil
) ;_ vlax-invoke-method
(if
(> (progn (setq
i (length
(car (vlax-safearray->list
(vlax-variant-value
(vlax-invoke-method
ADORecordset
"GetRows"
65536
) ;_ vlax-invoke-method
) ;_ vlax-variant-value
) ;_ vlax-safearray->list
) ;_ car
) ;_ length
) ;_ setq
(vlax-invoke-method ADORecordset "Close")
i
) ;_ progn
0
) ;_ >
(progn
(setq i1 1)
(while (vl-catch-all-error-p
(vl-catch-all-apply
(function vlax-invoke-method)
(list ADORecordset
"Open"
(strcat "SELECT * FROM ["
sheet
"$a"
(itoa i1)
":IV"
(itoa i1)
"]"
) ;_ end of strcat
ADOConnect
1
3
nil
) ;_ list
) ;_ vl-catch-all-apply
) ;_ vl-catch-all-error-p
(setq i1 (1+ i1))
) ;_ while
(vlax-invoke-method ADORecordset "Close")
(setq i (+ i i1))
(while (>= i i1)
(if
(not (vl-catch-all-error-p
(vl-catch-all-apply
(function vlax-invoke-method)
(list ADORecordset
"Open"
(strcat "SELECT * FROM ["
sheet
"$a"
(itoa i)
":IV"
(itoa i)
"]"
) ;_ end of strcat
ADOConnect
1
3
nil
) ;_ list
) ;_ vl-catch-all-apply
) ;_ vl-catch-all-error-p
) ;_ not
(progn (setq c (cons
(car
(apply
(function mapcar)
(cons
'list
(mapcar
(function
(lambda (a)
(mapcar (function
(lambda (b)
(vlax-variant-value b)
) ;_ lambda
) ;_ function
a
) ;_ mapcar
) ;_ lambda
) ;_ function
(vlax-safearray->list
(vlax-variant-value
(vlax-invoke-method
ADORecordset
"GetRows"
65535
) ;_ vlax-invoke-method
) ;_ vlax-variant-value
) ;_ vlax-safearray->list
) ;_ mapcar
) ;_ cons
) ;_ apply
) ;_ car
c
) ;_ cons
i (1- i)
) ;_ setq
(vlax-invoke-method ADORecordset "Close")
) ;_ progn
(setq i (1- i))
) ;_ if
) ;_ while
;;; (setq c (if (equal c '((nil) (nil)))
;;; (list sheet)
;;; (cons sheet c)
;;; ) ;_ if
;;; ) ;_ setq
) ;_ progn
) ;_ if
) ;_ progn
) ;_ if
(vlax-invoke-method ADOConnect "Close")
(vlax-release-object ADORecordset)
(vlax-release-object ADOConnect)
(setq ADORecordset nil
ADOConnect nil
) ;_ setq
c
) ;_ progn
(progn (vl-catch-all-apply
'vlax-invoke-method
(list ADOConnect "Close")
) ;_ vl-catch-all-apply
(vlax-release-object ADORecordset)
(vlax-release-object ADOConnect)
(setq ADORecordset nil
ADOConnect nil
) ;_ setq
nil
) ;_ progn
) ;_ if
) ;_ defun
;;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++