Dimension values to Excel

[TwistedE]

Wow Fixo.....that was quick.

 

One minor quirk ..

 

Public Sub ExportDims()
Dim oEnt As AcadEntity
Dim oDim As AcadDimRotated
Dim oOle As AcadOle
Dim mea1 As Double
Dim mea2 As Double
Dim pickPt As Variant

 

The public sub ExportDims() is highlighted in yellow and gives a compile error: User-defined type not defined

 

Any idea why this is happening....this is one type of error that always bugs the crap out of me in vba as it's not direct enough I feel

[TwistedE]

Ignore the previous post. I loaded the Microsoft DOA library and it worked. The code asks me to pick a excel file but it's weird because the OLE file that is on the sample.dwg has no excel file of it's own. It opens up a temp like file when the table is double clicked. So what exactly am I supposed to select.

 

I created a dummy excel file and the program selected it and when I clicked open, the program ended with no error sign and it just came back to the vb code. Weird because the code sequence says to move on to the ExportDims program.

 

Can you shed some light on this. Once again, thanks a ton Fixo.

[fixo]

Sorry I have no ideas about

[TwistedE]

Anybody have any idea as to what library must be added for AcadOle to work in VB within Autocad 2002?

 

Thank you.

[malkasun]

Marek,

This one works with fractions for me

Let me know..

 

~'J'~

this lisp not working autocad 2010 & excel 2010. pls develop this for acad2010

[fixo]

Tested on A2010 Win7 Excel 12.0

working good for me

Change file name within the code to your suit

 

~'J'~

[malkasun]

Tested on A2010 Win7 Excel 12.0

working good for me

Change file name within the code to your suit

 

~'J'~

C:\\ImportDims.xls is this file auto create or manual create.

 

1.tools> load application

2.load successfully.

3. get linear dimension tool take a measurement.

4 but no *.xls file create in disk c

 

pls tel step by step how to work this lisp application.

[fixo]

Do you have a privileges to save this file on disk C:\ ?

Try to save it in another folder, and also you can change

file extension on ".xlsx" instead of ".xls"

Just an idea, sorry

 

~'J'~

[malkasun]

Do you have a privileges to save this file on disk C:\ ?

Try to save it in another folder, and also you can change

file extension on ".xlsx" instead of ".xls"

Just an idea, sorry

 

~'J'~

is this coding o.k brother?please help me.i haven't good English knowledge.

 

(defun C:dix (/ *error* abks aexc asht col data dim_data elist en i row row_data ss tmp xbks xcel xshs)

(vl-load-com)

(defun *error*    (msg)
 (if
   (vl-position
     msg
     '("console break"
   "Function cancelled"
   "quit / exit abort"
   )
     )
    (princ "Error!")
    (princ msg)
    )

 )
(if (setq ss (ssget (list (cons 0 "dimension"))))

 (progn
   (setq i -1)
   (repeat (sslength ss)
     (setq en      (ssname ss (setq i (1+ i)))
       elist (entget en)
       tmp      (cons (cdr (assoc 11 elist)) (cdr (assoc 42 elist)))
       data  (cons tmp data))
     )

   (setq dim_data (vl-sort data
               (function (lambda (e1 e2) (< (caar e1) (caar e2))))))
   (alert "Close Excel File Only")
   (setq aexc (vlax-get-or-create-object "Excel.Application")
     xbks (vlax-get-property aexc "Workbooks")
     abks (vlax-invoke-method xbks "Add")
     xshs (vlax-get-property abks "Sheets")
     asht (vlax-get-property xshs "Item" 1)
     xcel (vlax-get-property asht "Cells")
     )
   (vla-put-visible aexc :vlax-true)
   (vlax-put-property aexc "UseSystemSeparators" :vlax-false) 
   (vlax-put-property aexc "DecimalSeparator" (vlax-make-variant "." )            
   (setq row 0
     col 1)

   (vlax-put-property xcel  "NumberFormat"
     (vlax-make-variant "0.00" 
     )

   (repeat (length dim_data)
     (setq row_data (car dim_data))
     (setq row (1+ row))
     (vlax-put-property
   xcel
   "Item"
   row
   col
;;;    (vl-princ-to-string (cdr row_data))
   (rtos (cdr row_data) 4 2)
   )
     (setq dim_data (cdr dim_data))
     )

   (vlax-invoke-method
     abks
     'SaveAs
     "D:\\ImportDims.xls"
     -4143
     nil
     nil
     :vlax-false
     :vlax-false
     1
     2
     )

   (vlax-release-object xcel)
   (vlax-release-object asht)
   (vlax-release-object xshs)
   (vlax-release-object abks)
   (vlax-release-object xbks)
   (vlax-release-object aexc)
   (setq aexc nil)
   (gc)
   (gc)
   )
 (*error* nil)
 )
 (princ)
 )
(prompt "\n\t\t>>>\tType DiX to execute\t<<<\n")
 (princ)

Edited August 15, 2012 by SLW210

[fixo]

You got me with this lisp indeed,

better you copy this code from an attachment

 

~'J'~

cadtutor.LSP

[malkasun]

dear fixo,

how to convert pdf file autocad file....

[Fordy]

Useful lisp routine

 

If I have a set of dimensions on a cad drawing that the dimension value is a description. Is there a way to extract the description and dim length to excel?

[fixo]

Sorry I don't know this at all,

perhaps search for freeware program on Google,

I have never worked with Adobe this way

 

~'J'~

[fixo]

Useful lisp routine

 

If I have a set of dimensions on a cad drawing that the dimension value is a description. Is there a way to extract the description and dim length to excel?

 

Welcome on board, Fordy

Can you upload this drawing or small part of them in attachments,

press 'Go advanced' button then press 'Manage attachments' button below,

and upload your sample,

 

 

~'J'~

[Fordy]

Hello

 

dwg is attached.

 

So in the excel it will list the product and product length. Then I can convert to number of bays. It would have to be a lisp.

 

many thanks for your help!

Drawing Example.dwg

[fixo]

Fordy,

I see the blocks named Bay_1631H

doy you want to write text from this blocks, e.g 1631x300?

Or you want to get real dimensions of these blocks, say

Ribbon = real dimension of included blocks, etc

Please, explain a little more

 

~'J'~

[Fordy]

Its purely dimension text and the length the text is. Dont need to worry about the blocks

[Fordy]

so ribbon=1325 for example

[fixo]

Give this a whirl, not tested enough, sorry

I added filter to select dimension on layer "Merchandize"

Change command name on whatever you need

Let me know what to change in there after

 

 
;;----------------------------DESCDIMTXL.LSP-------------------------------;;
 ;; fixo ()2012 * all rights released
 ;; 8/15/12
(defun C:DESCDIMTXL  (/ *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))
 )
     
   (alert "Wait...")
   (setq xlapp    (vlax-get-or-create-object "Excel.Application")
  xlbooks  (vlax-get-property xlapp 'Workbooks)
  xlbook   (vlax-invoke-method xlbooks 'Add)
  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)
   (setq row 1)
   (setq col 1)

   (foreach dim summ
     (setcelltext xlcells row col (car dim))
     (setcelltext xlcells row (+ col 1) (cdr dim))
     (setq row (1+ row)
     )
   )

(vlax-invoke-method
  (vlax-get-property xlsheet 'Columns)
  'AutoFit)
 
(setq fname (strcat (getvar "dwgprefix")(vl-string-right-trim ".dwg" (getvar "dwgname")) ".xlsx"))
(vlax-invoke-method
   xlbook
   'SaveAs
   fname 
   nil
   nil
   nil
   :vlax-false
   :vlax-false
   1
   2
 )
(vlax-invoke-method
   xlbook 'Close)
(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 DESCDIMTXL\t---\n")
(princ)
(vl-load-com)
(princ)
;;----------------------------code end-------------------------------;;

 

~'J'~

[Fordy]

that works a treat fixo. Top Man!

 

Im wondering if it can populate a column on an existing spreadsheet if i tell it where to look and the file name?