- Home
- /
- Architecture, Engineering & Construction
- /
- AutoCAD Forums
- /
- Visual LISP, AutoLISP and General Customization Forum
- /
- Export Block Attributes in Layout Order (Batch Process)
Export Block Attributes in Layout Order (Batch Process)
Options
- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Mute
- Printer Friendly Page
Export Block Attributes in Layout Order (Batch Process)
Enthusiast
677 Views
7 Replies
Replies (7)
Message 2 of 8
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
I’ll get you started with lisp solutions to two of your three requests
get layout names in order as they appear
Batch process dwgs in folder
Lee Macs Script Writer
Message 3 of 8
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Accepted solution
Try the attached attv2csv.lsp
You can modify the following lines to match your needs for block name, csv file name and separator:
(setq blknam "TITLE_BLOCK-001" ; block name
csvnam (strcat (getvar"dwgprefix")(vl-filename-base (getvar"dwgname"))".CSV") ; csv file using current dwg file path and name
csvsep "|" ; csv separator character
)When I loaded & executed attv2csv the attached csv file is created & opens in Notepad:
Message 4 of 8
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Thanks. for some reason, the sheet values (fields referenced to the tab name) are not being retrieved correctly, unless the user cycles through the layouts in the current session, so i added a layout cycle before the lisp you provided. plus instead of creating a CSV, it now copies the values to the currently open Excel sheet. Now I need to figure out how to make the lisp ask for a list of drawings to process in a given order while including the drawing path and name in the exported list.
; OP:
; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/export-block-attributes-in-layout-order-batch-process/td-p/13705622
; modified answer from paullimapa:
; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/export-block-attributes-in-layout-order-batch-process/m-p/13706781/highlight/true#M164953
; getLayoutOrderList function returns lists of layout names based on current order position
; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/retrieve-layout-names-by-order-of-which-they-sit-to-populate-in/m-p/10117549/highlight/true#M63608
; Miljenko Hatlak
; https://www.lee-mac.com/unformatstring.html
;; ATT2E.lsp
;;
;; DESCRIPTION:
;; Exports Block Attributes to an open Microsoft Excel worksheet.
;; This script combines layout-ordered attribute extraction with direct Excel communication.
;;
;; VERSION 2.0 UPDATE:
;; Now includes the 'Unformat' function to clean MText formatting codes (e.g.,
;; line breaks, font changes) from attribute text before exporting to Excel.
;; This ensures clean, readable data in the spreadsheet.
;;
;; USAGE:
;; 1. Open an AutoCAD drawing with layouts containing the target block.
;; 2. Open Microsoft Excel with a blank worksheet. Select the cell where you want the data to start.
;; 3. In AutoCAD, load this LISP file (APPLOAD).
;; 4. Type the command ATT2E and press Enter.
;;
(vl-load-com)
;; --- MText Formatting Cleaner (from TXT2E / cccx) ---
;; This function removes MText formatting codes from a string.
(defun Unformat ( str AsMtext / _replace rx pair) ;;;AsMtext arg: T = mtext keep line breaks, 1 = make text single line
(defun _replace ( new old str )
(vlax-put-property rx 'pattern old)
(vlax-invoke rx 'replace str new)
)
(if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
(progn
(setq str
(vl-catch-all-apply
(function
(lambda ( )
(vlax-put-property rx 'global acTRue)
(vlax-put-property rx 'multiline acTRue)
(vlax-put-property rx 'ignorecase acFalse)
(foreach pair
(list
(cons "\032" "\\\\\\\\")
(if (= AsMtext 1) (cons " " "\\n") (cons "\n" "\\n"))
(if (= AsMtext 1) (cons " " "\\t") (cons "\t" "\\t"))
(if (= AsMtext 1) (cons " " "\\\\P") (cons "\n" "\\\\P"))
(cons "$1" "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
(cons "$1$2/$3" "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
(cons "$1$2" "\\\\(\\\\S)|[\\\\](})|}")
(cons "$1" "[\\\\]({)|{")
(cons "%" "%%%")
(cons (chr 176) "%%d")
(cons (chr 176) "%%D")
(cons (chr 177) "%%p")
(cons (chr 177) "%%P")
(cons (chr 216) "%%c")
(cons (chr 216) "%%C")
(cons "" "%%o")
(cons "" "%%O")
(cons "" "%%u")
(cons "" "%%U")
)
(if pair (setq str (_replace (car pair) (cdr pair) str)))
)
(if AsMtext
(_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
(_replace "\\\\" "\032" str)
)
)
)
)
)
(vlax-release-object rx)
(if (null (vl-catch-all-error-p str)) str str)
)
(progn (princ "\nError: Could not create VBScript.RegExp object.") str)
)
)
;; --- Main Command Definition ---
(defun c:ATT2E ( / *error* oldErr blknam excelApp initialActiveCell dataStartCell
attnamlst headerData layouts currentCell layout ss ent rowData i
original_layout layouts_to_cycle temp_blknam cellBelow)
;; --- Error Handling Setup ---
(defun *error* ( msg )
(if oldErr (setq *error* oldErr))
(cond
((not msg))
((member msg '("Function cancelled" "quit / exit abort")))
((princ (strcat "\nError: " msg)))
)
(princ)
)
(setq oldErr *error*)
;; --- Helper Functions from attv2csv.lsp ---
(defun getLayoutOrderList(/ lst mklist mappend flatten)
(defun mklist (x) (if (listp x) x (list x)))
(defun mappend (fn lst)(apply 'append (mapcar fn lst)))
(defun flatten (expr)(mappend 'mklist expr))
(vlax-for lay (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
(setq lst (cons (list (vla-get-taborder lay)(vla-get-name lay)) lst))
)
(cdr(flatten(mapcar 'cdr (vl-sort lst '(lambda (a b) (< (car a)(car b)))))))
)
(defun getblkattdefList (blk / ent enx lst)
(if (tblsearch "BLOCK" blk)
(progn
(setq ent (tblobjname "BLOCK" blk))
(while (setq ent (entnext ent))
(if (= "ATTDEF" (cdr (assoc 0 (setq enx (entget ent)))))
(setq lst (append (list (cdr (assoc 2 enx))) lst))
)
)
)
)
(reverse lst)
)
;; --- Helper Function for Excel Communication ---
(defun write_row_to_excel (startCell dataList / currentCell item result)
(setq currentCell startCell)
(foreach item dataList
(setq item (if (numberp item) (rtos item) (vl-princ-to-string item)))
(setq result (vl-catch-all-apply 'vlax-put-property (list currentCell 'Value2 item)))
(if (vl-catch-all-error-p result)
(princ (strcat "\n -> FAILED to write cell. Error: " (vl-catch-all-error-message result)))
(setq currentCell (vl-catch-all-apply 'vlax-get-property (list currentCell "Offset" 0 1)))
)
(if (vl-catch-all-error-p currentCell)
(progn
(princ "\nERROR: Could not get next cell. Stopping row write.")
(setq dataList nil)
)
)
)
)
;; --- Main Logic ---
;; 1. Get Block Name
(setq blknam "TITLE_BLOCK-001")
(if (setq temp_blknam (getstring (strcat "\nEnter block name to export <" blknam ">: ")))
(if (/= "" temp_blknam) (setq blknam temp_blknam))
)
(if (not (tblsearch "BLOCK" blknam))
(progn (alert (strcat "Block '" blknam "' not found in this drawing.")) (exit))
)
;; 2. Connect to Excel
(princ "\nAttempting to connect to running Excel application...")
(setq excelApp (vl-catch-all-apply 'vlax-get-object '("Excel.Application")))
(if (or (null excelApp) (vl-catch-all-error-p excelApp))
(alert "ERROR: Could not connect to Excel. Please ensure Excel is open.")
(progn ; Excel is Connected
(princ " Connected.")
(setq initialActiveCell (vl-catch-all-apply 'vlax-get-property (list excelApp 'ActiveCell)))
(if (or (null initialActiveCell) (vl-catch-all-error-p initialActiveCell))
(alert "ERROR: Could not get active cell. Please select a cell in Excel.")
(progn ; Active Cell Acquired
(princ "\nActive cell obtained.")
;; 3. Prepare AutoCAD Data
(prompt "\nRegenerating and cycling layouts to ensure data is current...")
(command "_.regenall")
(setq original_layout (getvar "ctab"))
(if (setq layouts_to_cycle (getLayoutOrderList))
(progn (foreach layout layouts_to_cycle (setvar 'ctab layout))
(setvar 'ctab original_layout)
)
)
(prompt " done.")
(princ "\nGathering attribute definitions...")
(setq attnamlst (getblkattdeflist blknam))
(if (not attnamlst)
(alert (strcat "Block '" blknam "' has no attributes to export."))
(progn ; Attributes found
(princ (strcat " Found " (itoa (length attnamlst)) " attributes."))
;; 4. Write Header Row
(princ "\nWriting header row to Excel...")
(setq headerData (append '("Layout") attnamlst))
(write_row_to_excel initialActiveCell headerData)
(princ " OK.")
;; 5. Process Each Layout and Write Data Rows
(setq dataStartCell (vl-catch-all-apply 'vlax-get-property (list initialActiveCell "Offset" 1 0)))
(setq currentCell dataStartCell)
(setq layouts (getLayoutOrderList))
(princ (strcat "\nProcessing " (itoa (length layouts)) " layouts..."))
(foreach layout layouts
(princ (strcat "\n- Checking layout: " layout))
(if (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 blknam) (cons 410 layout) '(66 . 1))))
(progn
(princ " -> Block found. Extracting attributes...")
(setq i 0)
(repeat (sslength ss)
(setq ent (ssname ss i))
(setq rowData (list layout)) ; Start with layout name
(foreach att_tag attnamlst
;; *** INTEGRATION POINT ***
;; Get the raw attribute value, clean it with Unformat, then add to list
(setq rowData (append rowData (list (Unformat (getpropertyvalue ent att_tag) 1))))
)
(write_row_to_excel currentCell rowData)
(princ " -> Data written to Excel.")
(setq currentCell (vl-catch-all-apply 'vlax-get-property (list currentCell "Offset" 1 0)))
(setq i (1+ i))
)
)
(princ " -> Block not found in this layout.")
)
) ; end foreach layout
;; 6. Finalize
(princ "\n\nExport complete.")
(princ "\nMoving selection down in Excel...")
(if (and currentCell (not (vl-catch-all-error-p currentCell)))
(vl-catch-all-apply 'vlax-invoke-method (list currentCell 'Select))
)
(princ " OK.")
)
)
)
)
)
)
(setq *error* oldErr)
(princ)
)
;; --- User Feedback ---
(princ "\nLISP routine 'ATT2E' (v2.0 with MText cleaning) loaded. Type ATT2E to run.")
(princ)
Message 5 of 8
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Looking really good. If you want to be able to apply on selection of multiple dwgs then consider AutoScript
Message 6 of 8
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
A couple of comments, this is under development for some one else, in that code used OBDX to read the layouts titleblock. as it uses OBDX it holds open the current Excel file and just keeps adding to that writing directly to Excel. No CSV. By not opening thew dwg's its much faster and a script is not needed rather a list is made of the dwg names.
This is cut from the code but gives you or others an idea of how to make a list of dwg names. The rest has all the write to Excel stuff.
;; Directory Files - Lee Mac
;; Retrieves all files of a specified filetype residing in a directory (and subdirectories)
;; dir - [str] Root directory for which to return filenames
;; typ - [str] Optional filetype filter (DOS pattern) *.dwg
;; sub - [bol] If T, subdirectories of the root directory are included
;; Returns: [lst] List of files matching the filetype criteria, else nil if none are found
(defun LM:directoryfiles ( dir typ sub )
(setq dir (vl-string-right-trim "\\" (vl-string-translate "/" "\\" dir)))
(append (mapcar '(lambda ( x ) (strcat dir "\\" x)) (vl-directory-files dir typ 1))
(if sub
(apply 'append
(mapcar
'(lambda ( x )
(if (not (wcmatch x "`.,`.`."))
(LM:directoryfiles (strcat dir "\\" x) typ sub)
)
)
(vl-directory-files dir nil -1)
)
)
)
)
)
(setq direc (VL-FILENAME-DIRECTORY (getfiled "Select dwg File for top directory " "" "dwg" 16)))
(initget 1 "Yes No")
(setq Yesno (getkword "\nDo you want subdirectories [Yes No] "))
(if (= yesno "Yes")
(setq files (LM:directoryfiles direc "*.dwg" T))
(setq files (LM:directoryfiles direc "*.dwg" nil))
)
Extracting block data to a report - Page 6 - AutoLISP, Visual LISP & DCL - AutoCAD Forums
I stopped for the moment as the Excel desired result was extremely complicated.
Can you provide a real sample dwg to see the title block values in the layouts. Including if any are blank.
Message 7 of 8
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Thanks. attached a real sample dwg.
Note that right now it's not a big deal to batch process multiple files. Doing them one by one is ok (for now).
I updated the lisp above to add (') prefix to all cells in excel to ensure all data is treated as text.
; OP:
; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/export-block-attributes-in-layout-order-batch-process/td-p/13705622
; modified answer from paullimapa:
; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/export-block-attributes-in-layout-order-batch-process/m-p/13706781/highlight/true#M164953
; getLayoutOrderList function returns lists of layout names based on current order position
; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/retrieve-layout-names-by-order-of-which-they-sit-to-populate-in/m-p/10117549/highlight/true#M63608
; Miljenko Hatlak
; https://www.lee-mac.com/unformatstring.html
;; ATT2E.lsp
;;
;; DESCRIPTION:
;; Exports Block Attributes (from layouts only) to an open Microsoft Excel worksheet.
;; The first two columns will be the drawing's file path and name.
;; This script combines layout-ordered attribute extraction with direct Excel communication.
;;
;; VERSION 2.2 UPDATE:
;; Now prefixes every value sent to Excel with an apostrophe (') to ensure
;; all data is treated as text, preventing automatic data conversion by Excel.
;; Includes drawing file path and file name in the export.
;; Includes the 'Unformat' function to clean MText formatting codes.
;;
;; USAGE:
;; 1. Open an AutoCAD drawing with layouts containing the target block.
;; 2. Open Microsoft Excel with a blank worksheet. Select the cell where you want the data to start.
;; 3. In AutoCAD, load this LISP file (APPLOAD).
;; 4. Type the command ATT2E and press Enter.
;;
(vl-load-com)
;; --- MText Formatting Cleaner (from TXT2E / cccx) ---
;; This function removes MText formatting codes from a string.
(defun Unformat ( str AsMtext / _replace rx pair) ;;;AsMtext arg: T = mtext keep line breaks, 1 = make text single line
(defun _replace ( new old str )
(vlax-put-property rx 'pattern old)
(vlax-invoke rx 'replace str new)
)
(if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
(progn
(setq str
(vl-catch-all-apply
(function
(lambda ( )
(vlax-put-property rx 'global acTRue)
(vlax-put-property rx 'multiline acTRue)
(vlax-put-property rx 'ignorecase acFalse)
(foreach pair
(list
(cons "\032" "\\\\\\\\")
(if (= AsMtext 1) (cons " " "\\n") (cons "\n" "\\n"))
(if (= AsMtext 1) (cons " " "\\t") (cons "\t" "\\t"))
(if (= AsMtext 1) (cons " " "\\\\P") (cons "\n" "\\\\P"))
(cons "$1" "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
(cons "$1$2/$3" "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
(cons "$1$2" "\\\\(\\\\S)|[\\\\](})|}")
(cons "$1" "[\\\\]({)|{")
(cons "%" "%%%")
(cons (chr 176) "%%d")
(cons (chr 176) "%%D")
(cons (chr 177) "%%p")
(cons (chr 177) "%%P")
(cons (chr 216) "%%c")
(cons (chr 216) "%%C")
(cons "" "%%o")
(cons "" "%%O")
(cons "" "%%u")
(cons "" "%%U")
)
(if pair (setq str (_replace (car pair) (cdr pair) str)))
)
(if AsMtext
(_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
(_replace "\\\\" "\032" str)
)
)
)
)
)
(vlax-release-object rx)
(if (null (vl-catch-all-error-p str)) str str)
)
(progn (princ "\nError: Could not create VBScript.RegExp object.") str)
)
)
;; --- Main Command Definition ---
(defun c:ATT2E ( / *error* oldErr blknam excelApp initialActiveCell dataStartCell
attnamlst headerData layouts currentCell layout ss ent rowData i
original_layout layouts_to_cycle cellBelow dwgPath dwgName sel obj)
;; --- Error Handling Setup ---
(defun *error* ( msg )
(if oldErr (setq *error* oldErr))
(cond
((not msg))
((member msg '("Function cancelled" "quit / exit abort")))
((princ (strcat "\nError: " msg)))
)
(princ)
)
(setq oldErr *error*)
;; --- Helper Functions from attv2csv.lsp ---
(defun getLayoutOrderList(/ lst mklist mappend flatten)
(defun mklist (x) (if (listp x) x (list x)))
(defun mappend (fn lst)(apply 'append (mapcar fn lst)))
(defun flatten (expr)(mappend 'mklist expr))
(vlax-for lay (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
(setq lst (cons (list (vla-get-taborder lay)(vla-get-name lay)) lst))
)
(cdr(flatten(mapcar 'cdr (vl-sort lst '(lambda (a b) (< (car a)(car b)))))))
)
(defun getblkattdefList (blk / ent enx lst)
(if (tblsearch "BLOCK" blk)
(progn
(setq ent (tblobjname "BLOCK" blk))
(while (setq ent (entnext ent))
(if (= "ATTDEF" (cdr (assoc 0 (setq enx (entget ent)))))
(setq lst (append (list (cdr (assoc 2 enx))) lst))
)
)
)
)
(reverse lst)
)
;; --- Helper Function for Excel Communication ---
(defun write_row_to_excel (startCell dataList / currentCell item result)
(setq currentCell startCell)
(foreach item dataList
(setq item (if (numberp item) (rtos item) (vl-princ-to-string item)))
(setq item (strcat "'" item)) ; Prepend an apostrophe to force Excel to treat the value as text
(setq result (vl-catch-all-apply 'vlax-put-property (list currentCell 'Value2 item)))
(if (vl-catch-all-error-p result)
(princ (strcat "\n -> FAILED to write cell. Error: " (vl-catch-all-error-message result)))
(setq currentCell (vl-catch-all-apply 'vlax-get-property (list currentCell "Offset" 0 1)))
)
(if (vl-catch-all-error-p currentCell)
(progn
(princ "\nERROR: Could not get next cell. Stopping row write.")
(setq dataList nil)
)
)
)
)
;; --- Main Logic ---
;; Get drawing path and name for export
(setq dwgPath (getvar "dwgprefix"))
(setq dwgName (getvar "dwgname"))
;; 1. Get Block Name
(setq blknam "TITLE_BLOCK-001") ; Set the default value
(setq sel (entsel (strcat "\nSelect a block to export [Enter for default '" blknam "']: ")))
(if sel
(progn
(setq obj (vl-catch-all-apply 'vlax-ename->vla-object (list (car sel))))
(if (and (not (vl-catch-all-error-p obj)) (= "AcDbBlockReference" (vla-get-objectname obj)))
(setq blknam
(if (vlax-property-available-p obj 'EffectiveName)
(vla-get-effectivename obj)
(vla-get-name obj)
)
)
(princ "\nSelected object was not a valid block reference.")
)
)
)
(princ (strcat "\nUsing block name: " blknam))
(if (not (tblsearch "BLOCK" blknam))
(progn (alert (strcat "Block '" blknam "' not found in this drawing.")) (exit))
)
;; 2. Connect to Excel
(princ "\nAttempting to connect to running Excel application...")
(setq excelApp (vl-catch-all-apply 'vlax-get-object '("Excel.Application")))
(if (or (null excelApp) (vl-catch-all-error-p excelApp))
(alert "ERROR: Could not connect to Excel. Please ensure Excel is open.")
(progn ; Excel is Connected
(princ " Connected.")
(setq initialActiveCell (vl-catch-all-apply 'vlax-get-property (list excelApp 'ActiveCell)))
(if (or (null initialActiveCell) (vl-catch-all-error-p initialActiveCell))
(alert "ERROR: Could not get active cell. Please select a cell in Excel.")
(progn ; Active Cell Acquired
(princ "\nActive cell obtained.")
;; 3. Prepare AutoCAD Data
(prompt "\nRegenerating and cycling layouts to ensure data is current...")
(command "_.regenall")
(setq original_layout (getvar "ctab"))
(if (setq layouts_to_cycle (getLayoutOrderList))
(progn (foreach layout layouts_to_cycle (setvar 'ctab layout))
(setvar 'ctab original_layout)
)
)
(prompt " done.")
(princ "\nGathering attribute definitions...")
(setq attnamlst (getblkattdeflist blknam))
(if (not attnamlst)
(alert (strcat "Block '" blknam "' has no attributes to export."))
(progn ; Attributes found
(princ (strcat " Found " (itoa (length attnamlst)) " attributes."))
;; 4. Write Header Row
(princ "\nWriting header row to Excel...")
(setq headerData (append '("File Path" "File Name" "Layout") attnamlst))
(write_row_to_excel initialActiveCell headerData)
(princ " OK.")
;; 5. Process Each Layout and Write Data Rows
(setq dataStartCell (vl-catch-all-apply 'vlax-get-property (list initialActiveCell "Offset" 1 0)))
(setq currentCell dataStartCell)
(setq layouts (getLayoutOrderList))
(princ (strcat "\nProcessing " (itoa (length layouts)) " layouts..."))
(foreach layout layouts
(princ (strcat "\n- Checking layout: " layout))
(if (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 blknam) (cons 410 layout) '(66 . 1))))
(progn
(princ " -> Block found. Extracting attributes...")
(setq i 0)
(repeat (sslength ss)
(setq ent (ssname ss i))
(setq rowData (list dwgPath dwgName layout)) ; Start with path, name, and layout
(foreach att_tag attnamlst
;; *** INTEGRATION POINT ***
;; Get the raw attribute value, clean it with Unformat, then add to list
(setq rowData (append rowData (list (Unformat (getpropertyvalue ent att_tag) 1))))
)
(write_row_to_excel currentCell rowData)
(princ " -> Data written to Excel.")
(setq currentCell (vl-catch-all-apply 'vlax-get-property (list currentCell "Offset" 1 0)))
(setq i (1+ i))
)
)
(princ " -> Block not found in this layout.")
)
) ; end foreach layout
;; 6. Finalize
(princ "\n\nExport complete.")
(princ "\nMoving selection down in Excel...")
(if (and currentCell (not (vl-catch-all-error-p currentCell)))
(vl-catch-all-apply 'vlax-invoke-method (list currentCell 'Select))
)
(princ " OK.")
)
)
)
)
)
)
(setq *error* oldErr)
(princ)
)
;; --- User Feedback ---
(princ "\nLISP routine 'ATT2E' v2.2 loaded. Type ATT2E to run.")
(princ)
Message 8 of 8
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Looks like you have it covered.
Select the cell where you want the data to start.You can get last cell address so no need to go to Excel and select. I use myxl for app name.
; 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))
)
)
)
; thanks to Lee-mac for this defun
; 58 is Colon
(defun csv->lst ( str del / pos )
(if (setq pos (vl-string-position del str))
(cons (substr str 1 pos) (csv->lst (substr str (+ pos 2))))
(list str)
)
)
; get active range by AlanH
(defun getrangexl ( / lst UR CR RADD )
(setq lst '())
(setq myrange (vlax-get-property (vlax-get-property (vlax-get-property myxl "ActiveSheet") 'UsedRange) 'address))
(setq lst (_csv->lst58 myrange))
(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 1astrow (cadr (columnrow end)))
(setq lastcol (car (columnrow end)))
)
(getrangexl)
