Dimension values to Excel

[fixo]

I can do it later, now I'm a busy with my own

Temporarily, you could be able to copy-paste populated

range from created file to existing one

See you

 

~'J'~

[Fordy]

no worries, talk later

[fixo]

Ok I have a few minutes, try this one instead

 

 
 ;;----------------------------DIMXL.LSP-------------------------------;;
 ;; fixo ()2012 * all rights released
 ;; 8/16/12
(defun C:DIMXL  (/ *error*  col data dm dtxt elist en extmp fname i parts row
       sset summ tmp uniq x xlapp xlbook xlbooks xlcells xlsheet xlsheets)
 (defun *error* (msg)
 (if
   (vl-position
     msg
     '("console break"
"Function cancelled"
"quit / exit abort"
      )
   )
    (princ "Error!")
    (princ msg)
 )
 (princ)
)
 ;;;local defun
(defun setcelltext(cells row column value)
 (vl-catch-all-apply
   'vlax-put-property
   (list cells 'Item row column
 (vlax-make-variant
   (vl-princ-to-string value) ))
 )

 ;;; main part
(if (setq sset (ssget  (list (cons 0 "dimension")(cons 8 "Merchandise")(cons 62 256))))
 (progn
 (setq data nil)
   (while (setq en (ssname sset 0))
     (setq elist (entget en))

  (if (not (eq "" (cdr (assoc 1 elist))))
            (progn
    (setq dm (rtos (cdr (assoc 42 elist)) 2 (getvar "dimdec")))
    (setq dtxt (cdr (assoc 1 elist)))

  (setq data (cons (cons dtxt dm) data))
    )
    )
     (ssdel en sset)
   )
  )
 )
     (setq parts (mapcar 'car data))
   (setq uniq (list (car parts)))
   ;; get unique parts
   (foreach i parts (if (not (member (car (assoc i data)) uniq))(setq uniq (cons i uniq))))
(setq summ nil)
(while uniq
      (setq i (car uniq))
      (foreach n data (if (eq i (car n))(setq temp (cons n temp)))) 
        (setq tmp (cons i (apply '+ (mapcar 'atof (mapcar 'cdr temp)))))
 (setq summ (append temp summ))
           (setq data (vl-remove-if '(lambda (x)(member x temp ))data ))
 (setq temp nil)
 (setq uniq (cdr uniq))
 )
   (setq fname (getfiled "\nSelect Excel file" "" "xlsx;xls" 4))
   (alert "Wait...")
   (setq xlapp    (vlax-get-or-create-object "Excel.Application")
  xlbooks  (vlax-get-property xlapp 'Workbooks)
  ;; open existing file as write enabled:

  xlbook   (vlax-invoke-method xlbooks 'Open fname :vlax-false)
  xlsheets (vlax-get-property xlbook 'Sheets)
  xlsheet  (vlax-get-property xlsheets 'Item 1)
  xlcells  (vlax-get-property xlsheet 'Cells)
   )

   (vla-put-visible xlapp :vlax-true)
     (vlax-invoke-method xlsheet 'Activate)
     (setq xlrange (vlax-get-property xlsheet 'UsedRange))

     (vlax-invoke-method xlrange 'Select)

     (setq xlrows (vlax-get-property xlrange 'Rows))
            (setq rownum (vlax-get-property xlrows 'Count))

   (setq row (1+ rownum))
   (setq col 1)

   (foreach dim summ
     (setcelltext xlcells row col (car dim))
     (setcelltext xlcells row (+ col 1) (cdr dim))
     (setq row (1+ row)
     )
   )
(setq xlrange (vlax-get-property xlsheet 'UsedRange))

(vlax-invoke-method xlrange 'Select)

(vlax-invoke-method
  (vlax-get-property xlsheet 'Columns)
  'AutoFit)
(vlax-put-property xlapp 'DisplayAlerts :vlax-false)
(vlax-invoke-method
   xlbook
   'SaveAs
   fname 
   nil
   nil
   nil
   :vlax-false
   :vlax-false
   1
   2
 )
(vlax-invoke-method
   xlbook 'Close)
 (vlax-put-property xlapp 'DisplayAlerts :vlax-true)
(vlax-invoke-method
   xlapp 'Quit)
 (mapcar '(lambda (x)
     (vl-catch-all-apply
       '(lambda ()
   (vlax-release-object x)
 )
     )
   )
  (list xlcells xlsheet xlsheets xlbook xlbooks xlapp)
 )
 (setq  xlapp nil)
 (gc)(gc)(gc)
 (alert (strcat "File saved as:\n" fname))
 (*error* nil)
 (princ)
 )
(prompt "\n\t\t---\tStart command with DIMXL\t---\n")
(princ)
(vl-load-com)
(princ)
;;----------------------------code end-------------------------------;;

 

~'J'~

[Fordy]

excellent. thanks for your time. It does work. However if i already have an excel sheet set up with formulas set up in column c onwards and columns a and b are left blank ready for the export from cad. I can run the routine, select the excel doc. When i open, column a and b are blank with no export data from cad.

[fixo]

excellent. thanks for your time. It does work. However if i already have an excel sheet set up with formulas set up in column c onwards and columns a and b are left blank ready for the export from cad. I can run the routine, select the excel doc. When i open, column a and b are blank with no export data from cad.

Fordy, it's to difficult to me to imagine all your things within the Excel file,

let you better upload this .xlsx file here (I'm usinq MS Office 2007 btw)

 

~'J'~

[Fordy]

thank you!

test2.xlsx

test2-2003.xls

[fixo]

Hmm, I have same problem my code is discards all formulas,

I will be back later,

 

~'J'~

[fixo]

Well, seems this code is did what you want, try again :

 ;;----------------------------DIMXL.LSP-------------------------------;;
 ;; fixo ()2012 * all rights released
 ;; 8/16/12
 ;; last edited 8/17/12
(defun C:DIMXL  (/ *error*  col data dm dtxt elist en extmp fname i parts row
       sset summ tmp uniq x xlapp xlbook xlbooks xlcells xlsheet xlsheets)
 (defun *error* (msg)
 (if
   (vl-position
     msg
     '("console break"
"Function cancelled"
"quit / exit abort"
      )
   )
    (princ "Error!")
    (princ msg)
 )
 (princ)
)
 ;;;local defun
(defun setcelltext(cells row column value)
 (vl-catch-all-apply
   'vlax-put-property
   (list cells 'Item row column
 (vlax-make-variant
   (vl-princ-to-string value) ))
 )
(defun xlcolumnlastcell(xlapp colrange / colcells colnum lastcell rowcount)
;;;(vl-catch-all-apply     
;;;  'vlax-invoke-method (list xlapp 'volatile))

 (setq rowcount
(vl-catch-all-apply
      'vlax-get-property
      (list (vlax-get-property colrange 'rows)
     'count)))

 (setq colcells
(vl-catch-all-apply
      'vlax-get-property
      (list (vlax-get-property colrange 'parent)
     'cells)))
 (setq colnum
 (vl-catch-all-apply
      'vlax-get-property
      (list colrange
     'column)))
 ;;return:
 (setq lastcell
 (vlax-get-property
   (vlax-variant-value
 (vlax-get-property
   colcells
   'item
   (vlax-make-variant rowcount 3)
   (vlax-make-variant colnum 3)))
   'end (vlax-make-variant -4162 3));<-- (-4162) xlUp
)

)

 ;;; main part
(if (setq sset (ssget  (list (cons 0 "dimension")(cons 8 "Merchandise")(cons 62 256))))
 (progn
 (setq data nil)
   (while (setq en (ssname sset 0))
     (setq elist (entget en))

  (if (not (eq "" (cdr (assoc 1 elist))))
            (progn
    (setq dm (rtos (cdr (assoc 42 elist)) 2 (getvar "dimdec")))
    (setq dtxt (cdr (assoc 1 elist)))

  (setq data (cons (cons dtxt dm) data))
    )
    )
     (ssdel en sset)
   )
  )
 )
     (setq parts (mapcar 'car data))
   (setq uniq (list (car parts)))
   ;; get unique parts
   (foreach i parts (if (not (member (car (assoc i data)) uniq))(setq uniq (cons i uniq))))
(setq summ nil)
(while uniq
      (setq i (car uniq))
      (foreach n data (if (eq i (car n))(setq temp (cons n temp)))) 
        (setq tmp (cons i (apply '+ (mapcar 'atof (mapcar 'cdr temp)))))
 (setq summ (append temp summ))
           (setq data (vl-remove-if '(lambda (x)(member x temp ))data ))
 (setq temp nil)
 (setq uniq (cdr uniq))
 )
   (setq fname (getfiled "\nSelect Excel file" "" "xlsx;xls" 4))
   (alert "Wait...")
   (setq xlapp    (vlax-get-or-create-object "Excel.Application")
  xlbooks  (vlax-get-property xlapp 'Workbooks)
  ;; open existing file as write enabled:

  xlbook   (vlax-invoke-method xlbooks 'Open fname :vlax-false)
  xlsheets (vlax-get-property xlbook 'Sheets)
  xlsheet  (vlax-get-property xlsheets 'Item 1)
  xlcells  (vlax-get-property xlsheet 'Cells)
   )

      (vla-put-visible xlapp :vlax-true)
      (vlax-put-property xlapp 'ScreenUpdating :vlax-false)
     (vlax-invoke-method xlsheet 'Activate)
     (setq xlrange (vlax-get-property xlsheet 'UsedRange))
            ;; get the first column in used diapzone : 
            (setq xlcolrange (vlax-get-property xlrange 'Range (vlax-make-variant "A:A")))
            ;; find last cell entire the column
              (setq xlcell( xlcolumnlastcell xlapp xlcolrange))
     (vlax-invoke-method xlcell 'Select)

     (setq rownum (vlax-get-property xlcell 'Row))
            (setq colnum (vlax-get-property xlcell 'Column))
            ;; get first formula cell "C2" : 
            (setq xlformulacell (vlax-get-property xlrange 'Range (vlax-make-variant "C2")))
            (setq formula (vlax-get-property xlformulacell 'Formula))
             ;; copy formula entire row "C" from cell "C2" and down : 
            (setq xlformulacolumn (vlax-get-property xlrange 'range (vlax-make-variant (strcat "C2:C" (itoa (+ rownum (length summ)))))))
            ;(setq xlentirecolumn (vlax-get-property xlformulacolumn 'entirecolumn))
            (vlax-put-property xlformulacolumn 'Formula formula)
   (setq row (1+ rownum))
   (setq col colnum)

   (foreach dim summ
     (setcelltext xlcells row col (car dim))
     (setcelltext xlcells row (+ col 1) (cdr dim))
     (setq row (1+ row)
     )
   )
(setq xlrange (vlax-get-property xlsheet 'UsedRange))

(vlax-invoke-method xlrange 'Select)

(vlax-invoke-method
  (vlax-get-property xlsheet 'Columns)
  'AutoFit)
   (vlax-put-property xlapp 'ScreenUpdating :vlax-true)
   (vlax-put-property xlapp 'DisplayAlerts :vlax-false)
(vlax-invoke-method
   xlbook
   'SaveAs
   fname 
   nil
   nil
   nil
   :vlax-false
   :vlax-false
   1
   2
 )
(vlax-invoke-method
   xlbook 'Close)
 (vlax-put-property xlapp 'DisplayAlerts :vlax-true)
(vlax-invoke-method
   xlapp 'Quit)
 (mapcar '(lambda (x)
     (vl-catch-all-apply
       '(lambda ()
   (vlax-release-object x)
 )
     )
   )
  (list xlcells xlsheet xlsheets xlbook xlbooks xlapp)
 )
 (setq  xlapp nil)
 (gc)(gc)(gc)
 (alert (strcat "File saved as:\n" fname "\nWait..."))
 (*error* nil)
 (princ)
 )
(prompt "\n\t\t---\tStart command with DIMXL\t---\n")
(princ)
(vl-load-com)
(princ)
;;----------------------------code end-------------------------------;;

 

~'J'~

[Funerall]

Dear Fixo

 

I want to thank you for your great effort on this lisp file. I can now get any dimension text I want from Autocad file.

 

I appreciate your super work. Thank you.

[Fordy]

Example tester.dwgHi Fixo,

 

Thanks for your help on this, sorry for the late reply. It has took me this long to use this routine.

 

When i extract the data. it populates below the pre formula cells.

 

Where i have edited the font size through textedit, it extracts the data rather weird. Is there any way around this rather than making all the text the same font size

 

I have uploaded the dwg and excel in question.

Tester.xls

[amilarr1st]

Or do you want to do it with Lisp?

 

PS This will not work in 2010 version

 

~'J'~

 

HI, FIXO,

 

I TRY THIS VB FILE. AFTER RUNNING THIS VB FILE THE ERROR SHOW LIKE THIS.

 

WHAT CAN I DO FOR THAT ERROR.

[fixo]

Check if Excel References missed,

see Tools|References in VBA Editor

and also make sure under "Tools|Options|General" you select

"Break on Unhandled Errors" checked

[amilarr1st]

Check if Excel References missed,

see Tools|References in VBA Editor

and also make sure under "Tools|Options|General" you select

"Break on Unhandled Errors" checked

yes. it's already checked. I'm using Autocad 2102 64 bit & Ms office 2010.

[fixo]

Sorry I don't know how to fix this error on your end,

I'm just on A2010 & MS Office 2007

[flyingjunkie]

So I started a thread early last week looking for assistance and was pointed to this thread. While nothing in this thread directly applies to what I'm looking for, it is getting extremely close. Here's what I'm trying to accomplish:

 

When our company designs panel layouts, we place upwards of 200 holes in a panel. The way that we are doing this task right now is EXTREMELY inefficient. Essentially, we are using Ordinate Dimensions on the drawing, then the guy at the panel punch has to go hole-by-hole and enter the X,Y measurement 1-by-1. So I came up with the great idea of taking those XY dimension and putting them on a spreadsheet so he can just go down the line and punch in the coordinates. Now, I'm the one who has to go hole-by-hole and take the XY dimension and put it in the spreadsheet. I want to know if there is a LISP out there to extract the measurements in import them into a .xls file. I've tried the data extraction, but that won't give me the measurement of the holes from my designated UCS, but instead just gives units measurements from the corner of the drawings (It has my distances from the 2000s). At this time, I don't have any kind of special Excel template set up. I'll worry about that at a later date. I just need a fast and easy way to get this data from AutoCAD to Excel.

 

Thanks in advance for any help that anyone can offer.

[fixo]

Wait till tomorrow I can try to help,

now is nap time in this place

And also upload sample drawing to do not create one

on my machine (I'm using A2010 btw)

[fixo]

Try this lisp

HolesToExcelCadTutor.LSP

[flyingjunkie]

First off, I want to say thanks for getting this to me so quick. I have no idea how you do it, but you're quite awesome at what you do.

 

I'm looking thru this lisp right now. I'm trying to understand everything that it's doing here. I do have a few questions if you can help with them.

 

First off, are the hole labels from TCL supposed to coincide with the line numbers from Excel? If so, I don't think they are...

 

Next, using HTOX, the numbers that are output. I see that column A is the radius. What line(s) do I have to change to make that a diameter? Also, it looks like the points are from the World UCS, but I'm not really sure... Is there a way that we can change it so the measurement is made from a selected point. I've attached my drawing and, as you can see, we do our measurements from the top right of the panel to the bottom left. It doesn't matter to me how the holes are numbered, but if we can have the measurements going from that point (and being positive real numbers) that would be great. If this can't be done, I'm sure that we can change how we show our measurements. Ultimately, either way it will be exponentially faster.

 

Also, can we make the measurement in inches from the selected point?

sample.dwg

[fixo]

Ok I understand, I will add the changes you need,

for quickly you can change value in sublist for diameter like

(rtos (* rad 2) 3 prec) were prec is number of digitals for precision,

same for X & Y coordintates (rtos x 3 prec) etc...

well, I will do the changes later, I'm metric though

not sure about inches perhaps I need pass, say : (rtos 4 10.0 2) or (rtos 3 10.0 2)

compare both (highlighted expressions) in the command line then let me know

which one is the best

One more question, do you need to sort then numbering holes in Excel?

Cheers

Edited March 19, 2013 by fixo

[flyingjunkie]

I'm not sure how to apply the suggestions you have there. I'm still extremely new at this and trying to learn as I go. I'm not sure what you mean by sort then numbering of holes in Excel. What would be easiest is if the numbering that is assigned when the TCL command is run coincides with the line numbers in Excel.