- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello!
I'm looking for some help on a LISP I've been editing. I'm trying to add information from AutoCAD to an Excel file to track data. I came across some useful sub functions by Terry Miller (Thank you!) that have helped get me started. However, on one of the sub functions the LISP ends up crashing, specifically the line:
(if (Cell-p StartCell$) ;;;<--- there is a crash at this location!!!
I'm not sure what Cell-p is or what it is doing, so I was hoping to get some insight on this error as I'm kind of lost.
The code I have so far is attached below.
(defun c:TEST ( )
(defun cb:MakeTDirectory (mainDir subFolder / )
(if (not (vl-file-directory-p (strcat mainDir "/" subFolder)))
(vl-mkdir (vl-string-translate "/" "\\" (strcat mainDir "/" subFolder)))
)
)
(defun cb:makeMDirectory (tNumber pNumber customerName / maindir)
(setq mainDir "C:/_Vault/temp/")
(cb:MakeTDirectory maindir "M")
(cb:MakeTDirectory (setq maindir (strcat maindir "/" "M")) tNumber)
(cb:MakeTDirectory (setq maindir (strcat maindir "/" tNumber)) (strcat pNumber "-" customerName))
(cb:MakeTDirectory (setq maindir (strcat maindir "/" "Data")) tNumber))
;(findfile "C:\\ntuser.dat")
(setq date (substr (rtos (getvar "CDATE") 2 6) 1 8)
DwgProps (vla-Get-SummaryInfo (vla-Get-ActiveDocument (vlax-Get-Acad-Object))))
(vla-GetCustomByKey DwgProps "Drawn By" 'designer)
(vla-GetCustomByKey DwgProps "Type" 'ttype)
(vla-GetCustomByKey DwgProps "REV Level" 'rev)
(vla-GetCustomByKey DwgProps "Site Number" 'tNumber)
(vla-GetCustomByKey DwgProps "Customer" 'customerName)
(vla-GetCustomByKey DwgProps "Project Number" 'pNumber)
(if customerName
(setq customerName (vl-string-right-trim " " customerName)))
(if (not (findfile (setq saveFileLocation (strcat (setq saveLocation (strcat "C:\\_Vault\\temp\\" "M\\" tNumber "\\" pNumber "-" customerName "\\")) tNumber "-MP-" date "-0" rev ".dwg"))))
(progn
(cb:makeMDirectory tNumber pNumber customerName)
(vla-saveas (vla-get-activedocument (vlax-get-acad-object)) saveFileLocation)
)
(princ "\nFile Already Exists! Please Change REV Level Or Check Existing Drawing.")
)
;-------------------------------------------------------------------------------
; OpenExcel - Opens an Excel spreadsheet
; Arguments: 3
; ExcelFile$ = Excel filename or nil for new spreadsheet
; SheetName$ = Sheet name or nil for not specified
; Visible = t for visible or nil for hidden
; Syntax examples:
; (OpenExcel "C:\\Temp\\Temp.xls" "Sheet2" t) = Opens C:\Temp\Temp.xls on Sheet2 as visible session
; (OpenExcel "C:\\Temp\\Temp.xls" nil nil) = Opens C:\Temp\Temp.xls on current sheet as hidden session
; (OpenExcel nil "Parts List" nil) = Opens a new spreadsheet and creates a Part List sheet as hidden session
;-------------------------------------------------------------------------------
(defun OpenExcel (ExcelFile$ SheetName$ Visible / Sheet$ Worksheet)
(if (= (type ExcelFile$) 'STR)
(if (findfile ExcelFile$)
(setq *ExcelFile$ ExcelFile$)
(progn
(alert (strcat "Excel file " ExcelFile$ " not found."))
(exit)
);progn
);if
(setq *ExcelFile$ "")
);if
(gc)
(if (setq *ExcelApp% (vlax-get-object "Excel.Application"))
(progn
; (alert "Close all Excel spreadsheets to continue!")
(vlax-release-object *ExcelApp%)(gc)
);progn
);if
(setq *ExcelApp% (vlax-get-or-create-object "Excel.Application"))
(if ExcelFile$
(if (findfile ExcelFile$)
(vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Open ExcelFile$)
(vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Add)
);if
(vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Add)
);if
(if Visible
(vla-put-visible *ExcelApp% :vlax-true)
);if
(if (= (type SheetName$) 'STR)
(progn
(vlax-for Sheet$ (vlax-get-property *ExcelApp% "Sheets")
(setq Sheets@ (append Sheets@ (list (vlax-get-property Sheet$ "Name"))))
);vlax-for
(if (member SheetName$ Sheets@)
(vlax-for Worksheet (vlax-get-property *ExcelApp% "Sheets")
(if (= (vlax-get-property Worksheet "Name") SheetName$)
(vlax-invoke-method Worksheet "Activate")
);if
);vlax-for
(vlax-put-property (vlax-invoke-method (vlax-get-property *ExcelApp% "Sheets") "Add") "Name" SheetName$)
);if
);progn
);if
(princ)
);defun OpenExcel
;-------------------------------------------------------------------------------
; PutCell - Put values into Excel cells
; Arguments: 2
; StartCell$ = Starting Cell ID
; Data@ = Value or list of values
; Syntax examples:
; (PutCell "A1" "PART NUMBER") = Puts PART NUMBER in cell A1
; (PutCell "B3" '("Dim" 7.5 "9.75")) = Starting with cell B3 put Dim, 7.5, and 9.75 across
;-------------------------------------------------------------------------------
(defun PutCell (StartCell$ Data@ / Cell$ Column# ExcelRange Row#)
(if (= (type Data@) 'STR)
(setq Data@ (list Data@))
)
(setq ExcelRange (vlax-get-property *ExcelApp% "Cells"))
(if (Cell-p StartCell$) ;;;<---;;; there is a crash at this location!!!
(setq Column# (car (ColumnRow StartCell$))
Row# (cadr (ColumnRow StartCell$))
);setq
(if (vl-catch-all-error-p
(setq Cell$ (vl-catch-all-apply 'vlax-get-property
(list (vlax-get-property *ExcelApp% "ActiveSheet") "Range" StartCell$))
);setq
);vl-catch-all-error-p
(alert (strcat "The cell ID \"" StartCell$ "\" is invalid."))
(setq Column# (vlax-get-property Cell$ "Column")
Row# (vlax-get-property Cell$ "Row")
);setq
);if
);if
(if (and Column# Row#)
(foreach Item Data@
(vlax-put-property ExcelRange "Item" Row# Column# (vl-princ-to-string Item))
(setq Column# (1+ Column#))
);foreach
);if
(princ)
);defun PutCell
(alert "Grabbing Excel Doc, this may take a minute.")
(OpenExcel "C:\\Users\\Michael.S\\Desktop\\TEST DOC.xlsx" "Sheet 1" t)
(PutCell "A2" "TEST DATA!!")
(princ)
)
I am using AutoCAD 2018 and Excel 2012 if this helps at all.
I'm also looking to add a few lines of code to be able to search the same Excel doc for an empty cell in the "A" column so that the "PutCell" function will start at that location. For example: if cells "A1" "A2" and "A3" have data in them, I would like to start the PutCell function at "A4" since it is empty. Any help on this would be a bonus! Thanks in advance!
Solved! Go to Solution.