Table Export for multiple drawings to Excel

[Joe.Gio]

Hi All,

Does anyone happen to have a lisp that will batch export tables from multiple drawings into a single Excel file? I've used the 'tableexport' command and that works fine for one at a time but we'd like to be able to do it in a batch. On some drawings there could be up to 2 tables. I haven't been able to find much information online that talks about this.

Thanks for the help all.

Joe

[Sea-Haven]

I don't write CSV's rather write direct to excel. One of the things about writing to excel is that if you have Excel open and go to another dwg and run the lisp again it can add to the Excel new rows. I have a export table to excel.lsp, I will have a go at multiple tables in one dwg and in multiple dwgs. You can get current filled in range from CAD so if its blank start at A1, else say add a row and start.

Yours
(setq sh (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application" ))

mine looks for Excel does exist or not
(or (setq myxl (vlax-get-object "Excel.Application"))
    (setq myxl (vlax-get-or-create-object "excel.Application"))
)

[Sea-Haven]

Give this a try it has limited testing, you can start with Excel open or the code will open a new Excel. You just load the code into the current dwg and pick tables. The code expects a Title, a Header and Data, for tables the same type don't tick say Header. I have tested with excel open and open new dwg and select table. 

Make sure you save Multi toggles.lsp in a support path as its auto loaded or add full path to the (Load "Multi toggles.lsp")

Its a version one as I can see some improvements needed. Like dwg name added.

; simple table to excel
; expects Title header and data
; BY Alanh Jan  2025
; do not have excel open
; updated for multiple tables

(defun tab2excel ( /  x y z AH:putcell Ah:opennew number2alpha obj cols row)

; ColumnRow - Returns a list of the Column and Row number
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
;   Cell$ = Cell ID
; Syntax example: (ColumnRow "ABC987") = '(731 987)
;default to "A1" if there's a problem
;-------------------------------------------------------------------------------
(defun ColumnRow (Cell$ / Column$ Char$ Row#)
  (setq Column$ "")
  (while (< 64 (ascii (setq Char$ (strcase (substr Cell$ 1 1)))) 91)
    (setq Column$ (strcat Column$ Char$)
          Cell$ (substr Cell$ 2)
    )
  )
  (if (and (/= Column$ "") (numberp (setq Row# (read Cell$))))
    (list (Alpha2Number Column$) Row#)
    '(1 1)
  )
)

; Alpha2Number - Converts Alpha string into Number
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
;   Str$ = String to convert
; Syntax example: (Alpha2Number "ABC") = 731
;-------------------------------------------------------------------------------
(defun Alpha2Number (Str$ / Num#)
  (if (= 0 (setq Num# (strlen Str$)))
    0
    (+ (* (- (ascii (strcase (substr Str$ 1 1))) 64) (expt 26 (1- Num#)))
       (Alpha2Number (substr Str$ 2))
    )
  )
)

; get active range
(defun getrangexl ( / lst)
(setq lst '())
(setq myrange (vlax-get-property (vlax-get-property (vlax-get-property  myxl "ActiveSheet") 'UsedRange) 'address))
(setq lst (_csv->lst58 myrange))
(if (= (length lst) 2)
  (progn
   (setq st (vl-string-subst "" "$" (vl-string-subst "" "$" (nth 0 lst) )))
   (setq end (vl-string-subst "" "$" (vl-string-subst "" "$" (nth 1 lst) )))
   (setq row1 (cadr (columnrow st)))
   (setq rowx (+ (cadr (columnrow end)) 1))
   (setq lastcol (car (columnrow end)))
  )
  (setq row1 1 rowx 1)
)
)


; thanks to Lee-mac for this defun 
; www.lee-mac.com
; 44 is comma 9 is tab 34 is space 58 is colon
(defun _csv->lst58 ( str / pos )
	(if (setq pos (vl-string-position 58 str))
		(cons (substr str 1 pos) (_csv->lst58 (substr str (+ pos 2))))
		(list str)
    )
)

;;	Thanks to fixo			;;
;;   = Set Excel cell text =    ;;
;;				;;
(defun xlsetcelltext (cellrow cellcolumn celltext / xlcells)
(setq xlcells (vlax-get-property  (vlax-get-property myxl "ActiveSheet") "Cells"))
  (vl-catch-all-apply
    'vlax-put-property
    (list xlcells 'Item cellrow cellcolumn
	(vlax-make-variant (vl-princ-to-string celltext) vlax-vbstring)))
)

(setq myxl1 (vlax-get-object "Excel.Application"))
(if (= myxl1 nil)
  (progn
   (setq myxl (vlax-get-or-create-object "excel.Application"))
   (vla-put-visible myXL :vlax-true)
   (vlax-put-property myxl 'ScreenUpdating :vlax-true)
   (vlax-put-property myXL 'DisplayAlerts :vlax-true)
   (vlax-invoke-method (vlax-get-property myXL 'WorkBooks) 'Add)
   (setq rowx 1 col 1)
  )
  (progn
   (setq myxl myxl1)
   (vla-put-visible myXL :vlax-true)
   (vlax-put-property myxl 'ScreenUpdating :vlax-true)
   (vlax-put-property myXL 'DisplayAlerts :vlax-true)
  )
)


(while (setq tab (car  (entsel "Pick table or enter to exit ")))

(setq obj (vlax-ename->vla-object tab))
(setq cols (vla-get-columns obj))
(setq rows (vla-get-rows obj))
(alert (strcat (rtos rows 2 0) " rows " (rtos cols 2 0) " columns \n will now send to excel "))

(getrangexl)

(if (not AH:Toggs)(load "Multi toggles.lsp"))
(setq ans (reverse (ah:toggs   '("Please choose " "Title " "Heading " "Data"))))

(If (= "1" (nth 0 ans))
 (progn
  (xlsetcelltext rowx 1 (vla-getText Obj 0 0))
  (setq rowx (1+ rowx))
 )
 (princ "\nSkip Title")
)


(if (= "1" (nth 1 ans))
 (progn
  (setq col 0)
    (repeat cols
     (xlsetcelltext rowx (1+ col) (vla-getText Obj 1 col))
     (setq col (1+ col))
	)
    (setq rowx (1+ rowx))
  )
)

(if (= "1" (nth 2 ans))
(progn
(setq rowt 2)
(repeat (- rows 2)
  (setq col 0)
  (repeat cols
   (xlsetcelltext rowx (1+ col) (vla-getText Obj rowt col))
   (princ (vla-getText Obj rowt col))
   (setq col (1+ col))
  )
  (setq rowt (1+ rowt) rowx (1+ rowx))
)
)
)

(vlax-release-object obj)
(setq obj nil)
)

(vlax-release-object myXL)(setq myxl nil)

(princ)
)
(tab2excel)

type  

[bonehead_98]

Thanks Sea-haven

  I will give this a try as soon as I can and thanks for the earlier reply, I've been away from my office and will try to get back to it in a day or 2.

Thanks again.