Wednesday, March 28, 2012

VLISP House Cleaning Project

I've said before that I'm pretty much retired from writing books about AutoCAD or AutoLISP/VisualLISP, but I still get e-mail from readers asking for help or to share some code.  So, since it's not exactly ideal to make use of the code in my ebooks, I've decided I will post some (not all) of the examples from "The Visual LISP Developer's Bible, 2011 Edition" on my blog over the coming weeks.  As time permits, anyway.

To kick this off, here's the example from Chapter 21, exporting a drawing layers table to an Excel spreadsheet using Visual LISP and the COM interface...

(vl-load-com)
(setq acad (vlax-get-acad-object)) 
(setq activeDoc (vla-get-ActiveDocument acad)) 
(setq layers (vla-get-Layers activeDoc))
(setq excel (vlax-create-object "Excel.Application"))
(setq workbooks (vlax-get-property excel 'Workbooks))

(princ "\nSetting visible to True")
(vlax-put-property excel 'Visible :vlax-true)

(princ "\nGetting active workbook...")
(vlax-invoke-method workbooks 'Add)
(setq workbook (vlax-get-property excel 'ActiveWorkbook))

(princ "\nGetting active worksheet...")
(setq sheet (vlax-get-property excel 'Activesheet))

(princ "\nRename active worksheet...")
(vlax-put-property sheet 'Name "Layers")

(princ "\nGetting cells...")
(setq cells (vlax-get-property sheet 'Cells))

(princ "\nPrinting column headings...")
(vlax-put-property cells 'Item 1 1 "LayerName")
(vlax-put-property cells 'Item 1 2 "Color")
(vlax-put-property cells 'Item 1 3 "Linetype")

(princ "\nPopulating cells...")
(setq row 2)
(vlax-for layer layers
 (vlax-put-property cells 'Item row 1 (vla-get-Name layer))
 (vlax-put-property cells 'Item row 2 (itoa (vla-get-Color layer)))
 (vlax-put-property cells 'Item row 3 (vla-get-Linetype layer))
 (setq row (1+ row))
)

(princ "\nSaving workbook...")
(vlax-invoke-method workbook 'Save)
(vlax-invoke-method workbooks 'Close)
(vlax-invoke-method excel 'Quit)
(foreach obj (list cells sheet workbook workbooks excel)
 (vlax-release-object obj)
)
(gc)
(prince "\nDone!")
Post a Comment