LISP Program to Copy Dimensions to Clipboard and Paste in Excel

LISP Program to Copy Dimensions to Clipboard and Paste in Excel

Anonymous
Not applicable
7,479 Views
24 Replies
Message 1 of 25

LISP Program to Copy Dimensions to Clipboard and Paste in Excel

Anonymous
Not applicable

I am looking for a LISP program that will allow me to select multiple dimensions, copy them to the clipboard, and paste into Excel. The dimensions should paste into adjacent horizontal cells. I have attached photos with a sample AutoCAD drawing and the desired Excel format.

 

The command should have the following prompts:

 

1. Select dimension 1

     > I select dimension 1 with a window/crossing/click then hit the space bar

2. Select dimension 2

     > I select dimension 2 with a window/crossing/click then hit the space bar

3. Select dimension 3

     > I select dimension 3 with a window/crossing/click then hit the space bar

4. Select dimension 4

     > I select dimension 4 with a window/crossing/click then hit the space bar, and the command ends.

 

If there are fewer than four dimensions hitting the space bar with no selection should end the command.

Then I go over to an open excel file and CTRL+V to populate the fields.

 

Is this possible? If not could someone suggest an alternative such that I can easily transfer these dimensions to a preexisting excel file?

 

0 Likes
Accepted solutions (2)
7,480 Views
24 Replies
Replies (24)
Message 21 of 25

ancrayzy
Advocate
Advocate
Creating a new file and transferring data to it is the simplest way.
However, it will take us a little more time to copy that data into our main Excel file.
I think the simplest way is to avoid asking for the file name or the sheet name. Just open the "active sheet" and start with the cell where the user points to in the Excel sheet before switching to AutoCAD to execute the command.
0 Likes
Message 22 of 25

Sea-Haven
Mentor
Mentor

Ok can do, can get the last cell without user input. Bit busy at moment.

0 Likes
Message 23 of 25

Sea-Haven
Mentor
Mentor

Ok try this, either have a Excel open that you want to add to or don't have excel open at all. It should add on to last row in existing Excel. You should be able to stop and start.

 

0 Likes
Message 24 of 25

ancrayzy
Advocate
Advocate

It's got error after i type command

Command: DIM2XL ; error: too few actual parameters
0 Likes
Message 25 of 25

Sea-Haven
Mentor
Mentor

I updated the code in a very subtle way. If you appload it will auto run. to run again type dim2xl. 

 

 

 

; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-program-to-copy-dimensions-to-clipboard-and-paste-in-excel/td-p/8705507
; export dims to excel
; By AlanH June 2024
; needs version 2 add all the defuns to code

;;;--- Original program to demonstrate the usage for the getCellsFunction
;;;    By JefferyPSanders.com
;;;--- Function to retrieve values for a cell or a range of cell

; 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 
; www.lee-mac.com
; 44 is comma 9 is tab 34 is space 58 is colon
(defun _csv->lst58 ( str / pos )
	(if (setq pos (vl-string-position 58 str))
		(cons (substr str 1 pos) (_csv->lst58 (substr str (+ pos 2))))
		(list str)
    )
)

;;	Thanks to fixo			;;
(defun getcell2 (row column / )
(setq cells (vlax-get-property  (vlax-get-property myxl "ActiveSheet") "Cells"))
(setq cell (vlax-get (vlax-variant-value  (vlax-get-property cells "Item" row column)) 'value))
)

; get active range selected
(defun getrangexl ( / lst UR CR RADD )
(setq lst '())
(setq UR (vlax-get-property  (vlax-get-property myxl "ActiveSheet") "UsedRange"))
(setq CR (vlax-get-property UR "CurrentRegion"))
(setq RADD (vlax-get-property CR "Address"))
(setq cnt (vlax-get-property CR  "Count"))
(setq lst (_csv->lst58 radd))
(setq st (vl-string-subst "" "$" (vl-string-subst "" "$" (nth 0 lst) )))
(setq end (vl-string-subst "" "$" (vl-string-subst "" "$" (nth 1 lst) )))
(setq st (reverse (columnrow st)))
(setq end  (reverse (columnrow end)))
(princ st)
(princ "\n")
(princ end)
)



;;	Thanks to fixo			;;
;;   = Set Excel cell text =    ;;
;;				;;
(defun xlsetcelltext ( row column text)
(setq cells (vlax-get-property  (vlax-get-property myxl "ActiveSheet") "Cells"))
  (vl-catch-all-apply
    'vlax-put-property
    (list cells 'Item row column
	(vlax-make-variant (vl-princ-to-string text) vlax-vbstring)))
)


(defun dim2newxl ( / row txt ent)
(if (= myxl nil)
(setq myxl (vlax-get-object "Excel.Application"))
)
(if (= myxl nil)
  (progn 
  (setq myxl (vlax-get-or-create-object "excel.Application"))
  (vla-put-visible myXL :vlax-true)
  (vlax-put-property myxl 'ScreenUpdating :vlax-true)
  (vlax-put-property myXL 'DisplayAlerts :vlax-true)
  (setq row 2)
  (vlax-invoke-method (vlax-get-property myXL 'WorkBooks) 'Add)
  (xlsetcelltext  1 3 "X")
  (xlsetcelltext  1 4 "Y")
  )
  (progn
  (getrangexl)
  (setq row (+ (car end) 1))
  )
)
(princ)
)

(defun c:dim2xl ( / )
(dim2newxl)
(while (setq ent (entsel "\nPick X dim Enter to exit "))
  (setq txt (vlax-get (vlax-ename->vla-object (car ent)) 'Measurement))
  (xlsetcelltext  row 3 txt)
  (setq ent (entsel "\nPick Y dim Enter to exit "))
  (setq txt (vlax-get (vlax-ename->vla-object (car ent)) 'Measurement))
  (xlsetcelltext  row 4 txt)
  (setq row (+ row 1))
)
(if (not (vlax-object-released-p myXL))(progn (vlax-release-object myXL)(setq myXL nil)))
(princ)
)

(c:dim2xl)

 

 

 

0 Likes