Exporting Dimensions to Excel

[viswa]

I am trying to Export Dimensions from autocad file to excel using vba. My requirement is to select one dimension at a time and the value with the prefix and sufix needs to be exported to excel specific cell.

Example if there is a Dimension %%C180.00 Max need to Export the Diameter Symbol to Prefix Column Dimension ( 180.00 ) to DImension Column and Max to the Suffix Column.

 

Can anybody help me out with this

[PeterPan9720]

Could you share your code,

perhaps somebody can help you inserting some additional check on achieved text from dimension object

[BIGAL]

Start here your welcome to modify this. It asks for 2 dims. Hor & Ver. Start with no Excel open as it will open Excel.

 

; 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


; 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 xlnew ( / txt row)

(setq myxl (vlax-get-object "Excel.Application"))
(if (= myxl nil)
(progn 
(setq myxl (vlax-get-or-create-object "excel.Application"))
(setq add "Yes")
)
(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)
(if (= add "Yes")
(progn
(vlax-invoke-method (vlax-get-property myXL 'WorkBooks) 'Add)
(xlsetcelltext  1 1 "X")
(xlsetcelltext  1 2 "Y")
(setq row 2)
)
)
)

(defun c:dim2xl ( / row txt ent)

(if (= myxl nil) 
  (xlnew)
  (progn 
  (getrangexl)
  (setq row (car end))
  )
)


(while (setq ent (entsel "\nPick X dim Enter to exit "))
  (setq txt (vlax-get (vlax-ename->vla-object (car ent)) 'Measurement))
  (xlsetcelltext  row 1 txt)
  (setq ent (entsel "\nPick X dim Enter to exit "))
  (setq txt (vlax-get (vlax-ename->vla-object (car ent)) 'Measurement))
  (xlsetcelltext  row 2 txt)
  (setq row (1+ row))
)

(princ)
)