can someone help with this lisp. i found this on one of the forums. i have modified for my use. I have 2 problems that i can't resolve. i have tried searching for the original lisp programmers without luck.
Here are the problems:
- My block is a dynamic block and lisp wont read it. if i remove the dynamic properties from the attribute, it works fine but this is not an option. can this be made to pick up both dynamic and regular attribute blocks?
- There is a column "A" that it's generated when information is transferred to XL (see picture) can this be remove?
(defun c:DATAX (/ a1 a2 a3 atts att_lst file i n n1 obj sel_lst ss tmp_lst x)
;; http://www.theswamp.org/index.php?action=post;quote=435739;topic=38450.15;last_msg=466989
;; by Gilles Chanteau
;;-------------------------------------------------------------------------------
;; gc:WriteExcel
;; Ecrit dans un fichier Excel
;;
;; Arguments : 4
;; filename : chemin complet du fichier
;; sheet : nom de la feuille (ou nil pour la feuille courante)
;; startRange : nom de la cellule de départ (ou nil pour "A1")
;; dataList : liste de sous-listes contenant les données (une sous liste par rangée)
;;-------------------------------------------------------------------------------
(defun gc:WriteExcel (filename sheet startRange dataList / *error* xlApp
wBook save sheets active start row col rng
n cell
)
(vl-load-com)
(defun *error* (msg)
(and msg
(/= msg "Fonction annulée")
(princ (strcat "\nErreur: " msg))
)
(and wBook (vlax-invoke-method wBook 'Close :vlax-False))
(and xlApp (vlax-invoke-method xlApp 'Quit))
(and reg (vlax-release-object reg))
(mapcar (function (lambda (obj) (and obj (vlax-release-object obj))))
(list cell rng wBook xlApp)
)
(gc)
)
(setq xlapp (vlax-get-or-create-object "Excel.Application"))
(if (findfile filename)
(setq wBook (vlax-invoke-method (vlax-get-property xlapp 'WorkBooks) 'Open filename)
save T
)
(setq wBook (vlax-invoke-method (vlax-get-property xlapp 'WorkBooks) 'Add))
)
(if sheet
(progn
(setq sheets (vlax-get-property xlApp 'Sheets))
(vlax-for s sheets
(if (= (strcase (vlax-get-property s 'Name)) (strcase sheet))
(progn
(vlax-invoke-method s 'Activate)
(setq active T)
)
)
)
(or active
(vlax-put-property (vlax-invoke-method sheets 'Add) 'Name sheet)
)
)
)
(if startRange
(setq start (gc:ColumnRow startRange)
col (car start)
row (cadr start)
)
(setq col 1
row 1
)
)
(setq rng (vlax-get-property xlApp 'Cells))
(vlax-invoke-method rng 'Clear)
(foreach sub dataList
(setq n col)
(foreach data sub
(setq cell (vlax-variant-value (vlax-get-property rng 'Item row n)))
(if (= (type data) 'STR)
(vlax-put-property cell 'NumberFormat "@")
)
(vlax-put-property cell 'Value2 data)
(setq n (1+ n))
)
(setq row (1+ row))
)
(vlax-invoke-method
(vlax-get-property
(vlax-get-property xlApp 'ActiveSheet)
'Columns
)
'AutoFit
)
(if save
(vlax-invoke-method wBook 'Save)
(if (and
(< "11.0" (vlax-get-property xlapp "Version"))
(= (strcase (vl-filename-extension filename) T) ".xlsx")
)
(vlax-invoke-method
wBook 'SaveAs filename 51 "" "" :vlax-false :vlax-false 1 1)
(vlax-invoke-method
wBook 'SaveAs filename -4143 "" "" :vlax-false :vlax-false 1 1)
)
)
(*error* nil)
)
;; gc:WriteExcel
(if (and (setq ss (ssget
(list '(0 . "INSERT")
'(2 . "TITLE INFO1")
'(66 . 1)
(cons 410 (getvar 'CTAB))
)
)
)
(setq file (getfiled "Output File" "" "xls;xlsx" 1))
)
(progn
(repeat (setq i (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq i (1- i))))
atts (vlax-invoke obj 'getattributes)
)
(foreach att atts
(cond ((wcmatch (vla-get-tagstring att) "PIECE_MATERIAL")
(if (and (setq n1 (vla-get-textstring att))
(>= (strlen n1) 3)
)
(setq n (substr n1 (- (strlen n1) 2)))
)
)
((wcmatch (vla-get-tagstring att) "PIECE_FINISH")
(setq a1 (vla-get-textstring att))
)
((wcmatch (vla-get-tagstring att) "PIECE_MARC")
(setq a2 (vla-get-textstring att))
)
((wcmatch (vla-get-tagstring att) "PIECE_QTY")
(setq a3 (vla-get-textstring att))
)
((wcmatch (vla-get-tagstring att) "PIECE_LENGTH")
(setq a4 (vla-get-textstring att))
)
((wcmatch (vla-get-tagstring att) "STRETCH_OUT_TO_1/16")
(setq a5 (vla-get-textstring att))
)
)
)
(if (and n n1 a1 a2 a3 a4 a5)
(progn
(setq att_lst (cons (list n n1 a1 a2 a3 a4 a5) att_lst))
(mapcar '(lambda (x) (set x nil)) '(n n1 a1 a2 a3 a4 a5))
)
)
)
(setq att_lst (vl-sort att_lst '(lambda (a b) (< (car a) (car b)))))
(setq i 0)
(foreach x att_lst
(setq tmp_lst (cons (subst (itoa (setq i (1+ i))) (car x) x) tmp_lst))
)
(setq tmp_lst (reverse tmp_lst))
(setq sel_lst (cons '("NO." "PIECE MATERIAL" "PIECE FINISH" "PIECE MARK" "PIECE QUANTITY" "PIECE LENGTH" "STRETCH OUT to 1/16") sel_lst))
(setq sel_lst (append sel_lst tmp_lst))
(gc:WriteExcel file nil nil sel_lst)
)
)
(princ)
)
