I’m creating a pricing sheet by pulling attribute IDs and their duplicate block count (block instances) from a CAD drawing and putting them into an existing excel file. I think I have most of the separate parts needed but can’t figure out how to put it all together so looking for some help.
These are the Steps I believe are needed in my routine:
Here is a mockup image of the end result when blocks with IDs “A002”, “A006”, “A009”, “A012” are found in the attached drawing. (whoops. Cant figure out how to attach a CAD file or excel file here. Sorry. Anyone know?)
What I know:
a) I have a set number of attribute ID names (1 through 200) that I will ever encounter so I know all the possible names and the rows it need to go to. (Ex: ID “A006” goes in row 10).
b) I can make a Putcell command ready for each of those ID names to cover all (1 through 200).
What I don’t know:
c) How to associate block ID name with a row.
d) How to find duplicate block count and associate it with block ID name/row.
e) How to add ID name and count to a putcell command associated by row like this: (PutCell "B10" '("A006" 3)). "A006" will always go with row 10. What Attribute ID names found and the count is the variable that changes for each drawing.
Routine from Getexcel: Credit Terry Miller
(defun c:MyPricing ()
(defun GetExcel (ExcelFile$ SheetName$ MaxRange$ / Cnt# Column# ColumnRow@ CreateLists:
CurRegion Data@ ExcelRange^ ExcelValue ExcelVariant^ Max_Range$ MaxColumn# MaxRow#
Range$ Row# Sheet_Name$ Worksheet)
;-----------------------------------------------------------------------------
; CreateLists: - Creates Lists of SheetName$ up to MaxRange$ of Excel data
;-----------------------------------------------------------------------------
(defun CreateLists: (Sheet_Name$ Max_Range$ / ReturnList@)
(if Sheet_Name$
(vlax-for Worksheet (vlax-get-property *ExcelApp% "Sheets")
(if (= (vlax-get-property Worksheet "Name") Sheet_Name$)
(vlax-invoke-method Worksheet "Activate")
);if
);vlax-for
);if
(if Max_Range$
(progn
(setq ColumnRow@ (ColumnRow Max_Range$))
(setq MaxColumn# (nth 0 ColumnRow@))
(setq MaxRow# (nth 1 ColumnRow@))
);progn
(progn
(setq CurRegion (vlax-get-property (vlax-get-property
(vlax-get-property *ExcelApp% "ActiveSheet") "Range" "A1") "CurrentRegion")
);setq
(setq MaxRow# (vlax-get-property (vlax-get-property CurRegion "Rows") "Count"))
(setq MaxColumn# (vlax-get-property (vlax-get-property CurRegion "Columns") "Count"))
);progn
);if
(setq Row# 1)
(repeat MaxRow#
(setq Data@ nil)
(setq Column# 1)
(repeat MaxColumn#
(setq Range$ (strcat (Number2Alpha Column#)(itoa Row#)))
(setq ExcelRange^ (vlax-get-property *ExcelApp% "Range" Range$))
(setq ExcelVariant^ (vlax-get-property ExcelRange^ 'Value))
(setq ExcelValue (vlax-variant-value ExcelVariant^))
(setq ExcelValue
(cond
((= (type ExcelValue) 'INT) (itoa ExcelValue))
((= (type ExcelValue) 'REAL) (rtosr ExcelValue))
((= (type ExcelValue) 'STR) (vl-string-trim " " ExcelValue))
((/= (type ExcelValue) 'STR) "")
);cond
);setq
(setq Data@ (append Data@ (list ExcelValue)))
(setq Column# (1+ Column#))
);repeat
(setq ReturnList@ (append ReturnList@ (list Data@)))
(setq Row# (1+ Row#))
);repeat
ReturnList@
);defun CreateLists:
;-----------------------------------------------------------------------------
(if (= (type ExcelFile$) 'STR)
(if (not (findfile ExcelFile$))
(progn
(alert (strcat "Excel file " ExcelFile$ " not found."))
(exit)
);progn
);if
(progn
(alert "Excel file not specified.")
(exit)
);progn
);if
(gc)
(if (setq *ExcelApp% (vlax-get-object "Excel.Application"))
(progn
(vlax-release-object *ExcelApp%)(gc)
);progn
);if
(setq ExcelFile$ (findfile ExcelFile$))
(setq *ExcelApp% (vlax-get-or-create-object "Excel.Application"))
(vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Open ExcelFile$)
(setq *ExcelData@ nil)
(if (= (type SheetName$) 'LIST)
(progn
(if (/= (type MaxRange$) 'LIST)
(setq MaxRange$ (list MaxRange$))
);if
(setq Cnt# 0)
(repeat (length SheetName$)
(setq Sheet_Name$ (nth Cnt# SheetName$))
(setq Max_Range$ (nth Cnt# MaxRange$))
(princ (strcat "\nImporting " (vl-filename-base ExcelFile$) " - " Sheet_Name$ " data..."))(princ)
(setq ReturnList@ (CreateLists: Sheet_Name$ Max_Range$))
(setq *ExcelData@ (append *ExcelData@ (list ReturnList@)))
(setq Cnt# (1+ Cnt#))
);repeat
);progn
(progn
(if SheetName$
(progn (princ (strcat "\nImporting " (vl-filename-base ExcelFile$) " - " SheetName$ " data..."))(princ))
);if
(setq *ExcelData@ (CreateLists: SheetName$ MaxRange$))
);progn
);if
(vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook") 'Close :vlax-False)
(vlax-invoke-method *ExcelApp% 'Quit)
(vlax-release-object *ExcelApp%)(gc)
(setq *ExcelApp% nil)
*ExcelData@
);defun GetExcel
;-------------------------------------------------------------------------------
; GetCell - Returns the cell value from the *ExcelData@ list
; Arguments: 1
; Cell$ = Cell ID
; Syntax example: (GetCell "E19") = value of cell E19
;-------------------------------------------------------------------------------
(defun GetCell (Cell$ / Column# ColumnRow@ Return Row#)
(setq ColumnRow@ (ColumnRow Cell$))
(setq Column# (1- (nth 0 ColumnRow@)))
(setq Row# (1- (nth 1 ColumnRow@)))
(setq Return "")
(if *ExcelData@
(if (and (>= (length *ExcelData@) Row#)(>= (length (nth 0 *ExcelData@)) Column#))
(setq Return (nth Column# (nth Row# *ExcelData@)))
);if
);if
Return
);defun GetCell
;-------------------------------------------------------------------------------
; 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.xlsx" "Sheet2" t) = Opens C:\Temp\Temp.xlsx on Sheet2 as visible session
; (OpenExcel "C:\\Temp\\Temp.xlsx" nil nil) = Opens C:\Temp\Temp.xlsx 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$ Sheets@ 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
(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$)
(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
;-------------------------------------------------------------------------------
; CloseExcel - Closes Excel spreadsheet
; Arguments: 1
; ExcelFile$ = Excel saveas filename or nil to close without saving
; Syntax examples:
; (CloseExcel "C:\\Temp\\Temp.xlsx") = Saveas C:\Temp\Temp.xlsx and close
; (CloseExcel nil) = Close without saving
;-------------------------------------------------------------------------------
(defun CloseExcel (ExcelFile$ / Saveas)
(if ExcelFile$
(if (= (strcase ExcelFile$) (strcase *ExcelFile$))
(if (findfile ExcelFile$)
(vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook") "Save")
(setq Saveas t)
);if
(if (findfile ExcelFile$)
(progn
(vl-file-delete (findfile ExcelFile$))
(setq Saveas t)
);progn
(setq Saveas t)
);if
);if
);if
(if Saveas
(vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook")
"SaveAs" ExcelFile$ -4143 "" "" :vlax-false :vlax-false nil
);vlax-invoke-method
);if
(vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook") 'Close :vlax-False)
(vlax-invoke-method *ExcelApp% 'Quit)
(vlax-release-object *ExcelApp%)(gc)
(setq *ExcelApp% nil *ExcelFile$ nil)
(princ)
);defun CloseExcel
;-------------------------------------------------------------------------------
; 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)
;-------------------------------------------------------------------------------
(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)
);setq
);while
(if (and (/= Column$ "") (numberp (setq Row# (read Cell$))))
(list (Alpha2Number Column$) Row#)
'(1 1);default to "A1" if there's a problem
);if
);defun ColumnRow
;-------------------------------------------------------------------------------
; 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))
);+
);if
);defun Alpha2Number
;-------------------------------------------------------------------------------
; Number2Alpha - Converts Number into Alpha string
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
; Num# = Number to convert
; Syntax example: (Number2Alpha 731) = "ABC"
;-------------------------------------------------------------------------------
(defun Number2Alpha (Num# / Val#)
(if (< Num# 27)
(chr (+ 64 Num#))
(if (= 0 (setq Val# (rem Num# 26)))
(strcat (Number2Alpha (1- (/ Num# 26))) "Z")
(strcat (Number2Alpha (/ Num# 26)) (chr (+ 64 Val#)))
);if
);if
);defun Number2Alpha
;-------------------------------------------------------------------------------
; Cell-p - Evaluates if the argument Cell$ is a valid cell ID
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
; Cell$ = String of the cell ID to evaluate
; Syntax examples: (Cell-p "B12") = t, (Cell-p "BT") = nil
;-------------------------------------------------------------------------------
(defun Cell-p (Cell$)
(and (= (type Cell$) 'STR)
(or (= (strcase Cell$) "A1")
(not (equal (ColumnRow Cell$) '(1 1)))
);or
);and
);defun Cell-p
;-------------------------------------------------------------------------------
; Row+n - Returns the cell ID located a number of rows from cell
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 2
; Cell$ = Starting cell ID
; Num# = Number of rows from cell
; Syntax examples: (Row+n "B12" 3) = "B15", (Row+n "B12" -3) = "B9"
;-------------------------------------------------------------------------------
(defun Row+n (Cell$ Num#)
(setq Cell$ (ColumnRow Cell$))
(strcat (Number2Alpha (car Cell$)) (itoa (max 1 (+ (cadr Cell$) Num#))))
);defun Row+n
;-------------------------------------------------------------------------------
; Column+n - Returns the cell ID located a number of columns from cell
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 2
; Cell$ = Starting cell ID
; Num# = Number of columns from cell
; Syntax examples: (Column+n "B12" 3) = "E12", (Column+n "B12" -1) = "A12"
;-------------------------------------------------------------------------------
(defun Column+n (Cell$ Num#)
(setq Cell$ (ColumnRow Cell$))
(strcat (Number2Alpha (max 1 (+ (car Cell$) Num#))) (itoa (cadr Cell$)))
);defun Column+n
;-------------------------------------------------------------------------------
; rtosr - Used to change a real number into a short real number string
; stripping off all trailing 0's.
; Arguments: 1
; RealNum~ = Real number to convert to a short string real number
; Returns: ShortReal$ the short string real number value of the real number.
;-------------------------------------------------------------------------------
(defun rtosr (RealNum~ / DimZin# ShortReal$)
(setq DimZin# (getvar "DIMZIN"))
(setvar "DIMZIN" 8)
(setq ShortReal$ (rtos RealNum~ 2 8))
(setvar "DIMZIN" DimZin#)
ShortReal$
);defun rtosr
;-------------------------------------------------------------------------------
(princ);End of GetExcel.lsp
(OpenExcel "C:\\TEMP\\MyBlock_Att_Test.xlsx" "MainSheet" nil);Open Excel file
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; This is where I need help finding block info and adding to Putcell command
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;Example of putting in info from CAD to excel;;;;;
(PutCell "B10" '("A006" 3))
;;;;Example;;;;;
(CloseExcel "C:\\TEMP\\MyBlock_Att_Test.xlsx");Close Excel
);End MyPricing
Here are some routines I was looking at in order to grab the block info needed.
Block attribute ID name:
Here is one from Lee Mac that finds Attribute IDs and saves to variable “data”. I took out the excel export part since that can be handled by Getexcel.lsp routine.
;; Text 2 CSV - Lee Mac
;; Writes all Text, MText & Attribute content from all layouts and within
;; all blocks and nested blocks to a selected CSV file.
(defun c:txt2csv ( / data file )
(cond
( (not
(progn
(vlax-for block (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
(if (eq :vlax-false (vla-get-isxref block))
(vlax-for obj block
(cond
( (wcmatch (vla-get-objectname obj) "AcDb*Text")
(setq data (cons (vla-get-textstring obj) data))
)
( (and
(eq "AcDbBlockReference" (vla-get-objectname obj))
(eq :vlax-true (vla-get-hasattributes obj))
)
(foreach att (vlax-invoke obj 'getattributes)
(setq data (cons (vla-get-textstring att) data))
)
)
)
)
)
)
data
)
)
(princ "\nNo Text, MText or Attributes found.")
)
( (not (setq file (getfiled "Create CSV file" "" "csv" 1)))
(princ "\n*Cancel*")
)
( (setq file (open file "w"))
(foreach x data (write-line x file))
(setq file (close file))
(princ (strcat "\n" (itoa (length data)) " strings written to file."))
)
( (princ "\nUnable to open CSV file for writing."))
)
(princ)
)
(vl-load-com) (princ)
Block count.
Here is another one from Lee Mac that list the count by its block name (but not attribute ID). Block Name will already be listed in correct row under column A in spreadsheet. Just need to add corresponding ID name ex: “A006” in Column B/row 10 and count “3” in Column C/row 10 through the Putcell command. EX: (PutCell "B10" '("A006" 3)). I guess I could associate Block name to Block Attribute ID and also to row. The count would be the only variable really thats unknown for each.
(defun c:myblockcounter ( / blk idx itm lst sel )
(if (setq sel (ssget '((0 . "INSERT"))))
(repeat (setq idx (sslength sel))
(setq blk (cdr (assoc 2 (entget (ssname sel (setq idx (1- idx)))))))
(if (setq itm (assoc blk lst))
(setq lst (subst (cons blk (1+ (cdr itm))) itm lst))
(setq lst (cons (cons blk 1) lst))
)
)
)
(foreach itm lst (princ (strcat "\n" (car itm) ": " (itoa (cdr itm)))))
(princ)
)
Any help is greatly appreciated!
Issue resolved here by pbejse: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/autolisp-to-pass-block-attribute-id-name-and-block-count-of-a/td-p/10545894