Cad to Excel

[wimal]

Can I export the text of cad to a excel file as excel (text) entity.

Cad file attached.

sample1.dwg

[fixo]

Excel text entity something new for me

Try this code

excel_write.LSP

[pBe]

Generic Export Routine

 

(defun Ext2File (Typ Data FilEx / ss i e d Lst file ev Path)
 (if (and
       (= 1 (getvar 'DWGTITLED))
       (setq ss (ssget (list (cons 0 typ))))
       (repeat (setq i (sslength ss))
         (setq e (entget (ssname ss (setq i (1- i)))))
         (if (setq d (assoc data e))
           (setq lst (cons (cdr d) lst))
           )
         )
       )
   (progn  (setq file
        (open (setq path
             (strcat (getvar 'DwgPrefix)
               (cadr (fnsplitl (getvar 'Dwgname)))
               FilEx)) "w" )
       )
     (foreach itm lst
       (if (setq
             ev (assoc
                  (type itm)
                  '((LIST (vl-prin1-to-string itm))
                    (REAL (rtos itm 2 4))
                    (INT (itoa itm))
                    (STR itm)
                    )
                  )
             )
         (write-line (eval (cadr ev)) file)
         )
       )
     (close file)
     (startapp "Notepad" Path)
     )
   )
 Path
 )

 

(Ext2File "TEXT" 1 ".csv");

3T20-06(2.5m)

12T16-12(4m)

3T12-01

4T16-02(3m)

20T25-08(6m)

 

(Ext2File "INSERT" 10 ".csv");

(-3898.81 2436.34 0.0)

(-289.783 1903.24 0.0)

(-1606.28 610.185 0.0)

(-1867.31 133.796 0.0)

 

(Ext2File "INSERT" 2 ".csv");

Bllock1

Block2

Block3

Block4

[wimal]

Thanks both of you.

Fixo;s file is working nicely.

 

I am still studding to use pBe's file.

[wimal]

Excel text entity something new for me

Try this code

In my sample cad drawing I have shown only one text column.

If there were more columns (about 5 columns )

How can I modify your code to transfer text to excel columns.

[fixo]

Wimal, W8 till tomorrow

I'm busy now

[fixo]

Here is code partially skipped from working program

to export plain table to excel

See if this working with text columns

 

(defun C:ttx(/ *error* col data en fname i ip output p1 p2 row rowlist ss tmp txt
     xlapp xlbook xlbooks xlcells xlrange xlsheet xlsheets xlvariant ylist)

(defun *error* (msg)
 (if
   (vl-position
     msg
     '("console break"
"Function cancelled"
"quit / exit abort"
      )
   )
    (princ "Error!")
    (princ msg)
 )
 (princ)
)
;; local defuns:
;; remove duplicates
;; written by hutch
(defun rem-dups  (mylist / newlst)
 (foreach item  mylist
   (and (null (member item newlst))
 (setq newlst (cons item newlst))
 )
   )
 newlst
 )
 ;;;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) ))
 )
(setq output nil)
(princ "\nSelect plain text table by window selection")

(setq p1 (getpoint "\nSpecify a first corner of window : ")
     p2 (getcorner p1
     "\nSpecify opposite corner :  ")
     )

(setq ss (ssget "W" p1 p2 (list (cons 0 "TEXT")))
     i  -1
     )

(repeat (sslength ss)
 (setq en   (ssname ss (setq i (1+ i)))
ip   (cdr (assoc 10 (entget en)))
txt  (cdr (assoc 1 (entget en)))
tmp  (cons txt ip)
data (cons tmp data)
)
 )
(setq ylist (mapcar 'caddr data)
     ylist (rem-dups ylist)
     ylist (vl-sort ylist (function (lambda (a b) (> a b))))
     )
(repeat (length ylist)
 (setq rowlist (vl-remove-if-not
   (function (lambda (x)
        (equal (caddr x) (car ylist) 0.01)
        )
      )
   data
   )
rowlist (vl-sort rowlist
   (function (lambda (a b) (< (cadr a) (cadr b))))
   )
)
 (setq output (append output (list rowlist)))
 (setq ylist (cdr ylist))
 )
(setq output (mapcar (function (lambda (x)
    (mapcar 'car x)
    )
         )
      output
      )
     )

(setq xlvariant (vlax-safearray-fill
   (vlax-make-safearray
     vlax-vbstring
     (cons 0 (1- (length output)))
     (cons 0 (1- (length (car output))))
   )
   output
 )
)
 (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)
(vl-catch-all-apply 'vlax-put-property (list xlapp 'ScreenUpdating :vlax-false))
(setq row 1)
(foreach item output
 (setq col 1)
 (foreach a item
   (setcelltext xlcells row col a)
   (setq col (1+ col))
 )
 (setq row (1+ row))
)
(setq xlrange (vl-catch-all-apply 'vlax-get-property (list xlsheet 'usedrange)))
(vl-catch-all-apply 'vlax-invoke-method (list xlrange 'Select))
(setq xlrange (vl-catch-all-apply 'vlax-get-property (list xlapp 'selection)))
(vl-catch-all-apply 'vlax-invoke-method (list xlrange 'borderaround nil nil nil nil))
(vl-catch-all-apply 'vlax-put-property (list xlapp 'screenupdating :vlax-true))
 (vlax-invoke-method
  (vlax-get-property xlrange 'columns)
  'autoFit)

(setq fname (strcat (getvar "dwgprefix")(vl-string-right-trim ".dwg" (getvar "dwgname"))))
(vlax-invoke-method
   xlbook
   'SaveAs
   fname 
   -4143
   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 TTX\t***\n")
(princ)
(or (vl-load-com)
   (princ)     )

 

~'J'~

[stevesfr]

fixo, why do I get the following when trying to run the program?

Command: TTX

Select plain text table by window selection

Specify a first corner of window :

Specify opposite corner : bad argument type: lselsetp nil

do I have older version of Excel ? using AC2008

Steve

[wimal]

Thanks fixo

TTX command is working nicely with cad 2006 & excel 2007.

[fixo]

fixo, why do I get the following when trying to run the program?

Command: TTX

Select plain text table by window selection

Specify a first corner of window :

Specify opposite corner : bad argument type: lselsetp nil

do I have older version of Excel ? using AC2008

Steve

Hi Steve,

It will select plain text objects, kinda old fashioned text plain table,

that was drawn with lines

Pehaps, you have tried to select mtexts instead,

another possible solution is set osmode to 0 before

Sorry I could not generate same issue on my end

Cheers

 

~'J'~

[wimal]

fixo, why do I get the following when trying to run the program?

Command: TTX

Select plain text table by window selection

Specify a first corner of window :

Specify opposite corner : bad argument type: lselsetp nil

do I have older version of Excel ? using AC2008

Steve

Rows of columns shall be equivalent.

You cant allow blanks spaces in between rows.

[wimal]

Here is code partially skipped from working program

to export plain table to excel

See if this working with text columns

 

Please I need another help.

When I included 2/5 to cad it display in excel as Feb/5

and 005 display as 5.

I think if we format excel cells to TEXT.Before inserting cad data this can solve.

Please help me

[fixo]

I've added Text Number Format into the used range columns

(highlighted with colors within the code)

See if this is working for you:

(defun C:ttx(/ *error* col data en fname i ip output p1 p2 row rowlist ss tmp txt
     xlapp xlbook xlbooks xlcells xlrange xlsheet xlsheets xlvariant ylist)

(defun *error* (msg)
 (if
   (vl-position
     msg
     '("console break"
"Function cancelled"
"quit / exit abort"
      )
   )
    (princ "Error!")
    (princ msg)
 )
 (princ)
)
;; local defuns:
;; remove duplicates
;; written by hutch
(defun rem-dups  (mylist / newlst)
 (foreach item  mylist
   (and (null (member item newlst))
 (setq newlst (cons item newlst))
 )
   )
 newlst
 )
 ;;;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) ))
 )
(setq output nil)
(princ "\nSelect plain text table by window selection")

(setq p1 (getpoint "\nSpecify a first corner of window : ")
     p2 (getcorner p1
     "\nSpecify opposite corner :  ")
     )

(setq ss (ssget "W" p1 p2 (list (cons 0 "TEXT")))
     i  -1
     )

(repeat (sslength ss)
 (setq en   (ssname ss (setq i (1+ i)))
ip   (cdr (assoc 10 (entget en)))
txt  (cdr (assoc 1 (entget en)))
tmp  (cons txt ip)
data (cons tmp data)
)
 )
(setq ylist (mapcar 'caddr data)
     ylist (rem-dups ylist)
     ylist (vl-sort ylist (function (lambda (a b) (> a b))))
     )
(repeat (length ylist)
 (setq rowlist (vl-remove-if-not
   (function (lambda (x)
        (equal (caddr x) (car ylist) 0.01)
        )
      )
   data
   )
rowlist (vl-sort rowlist
   (function (lambda (a b) (< (cadr a) (cadr b))))
   )
)
 (setq output (append output (list rowlist)))
 (setq ylist (cdr ylist))
 )
(setq output (mapcar (function (lambda (x)
    (mapcar 'car x)
    )
         )
      output
      )
     )

(setq xlvariant (vlax-safearray-fill
   (vlax-make-safearray
     vlax-vbstring
     (cons 0 (1- (length output)))
     (cons 0 (1- (length (car output))))
   )
   output
 )
)
 (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)
(vl-catch-all-apply 'vlax-put-property (list xlapp 'ScreenUpdating :vlax-false))
(setq row 1)
(foreach item output
 (setq col 1)
 (foreach a item
   (setcelltext xlcells row col a)
   (setq col (1+ col))
 )
 (setq row (1+ row))
)
(setq xlrange (vl-catch-all-apply 'vlax-get-property (list xlsheet 'usedrange)))
(vl-catch-all-apply 'vlax-invoke-method (list xlrange 'Select))
(setq xlrange (vl-catch-all-apply 'vlax-get-property (list xlapp 'selection)))
(vl-catch-all-apply 'vlax-invoke-method (list xlrange 'borderaround nil nil nil nil))
(vl-catch-all-apply 'vlax-put-property (list xlapp 'screenupdating :vlax-true))
( vl-catch-all-apply 'vlax-put-property (list
  (vlax-get-property xlrange 'columns)
  '[color=blue]numberformat[/color] [b][color=red]"@"[/color][/b]))
 (vlax-invoke-method
  (vlax-get-property xlrange 'columns)
  'autofit)

(setq fname (strcat (getvar "dwgprefix")(vl-string-right-trim ".dwg" (getvar "dwgname"))))
(vlax-invoke-method
   xlbook
   'SaveAs
   fname 
   -4143
   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 TTX\t***\n")
(princ)
(or (vl-load-com)
   (princ)     )

 

~'J'~

[wimal]

I've added Text Number Format into the used range columns

(highlighted with colors within the code)

See if this is working for you:

 

~'J'~

Not yet solved. now it display

When I included 2/5 to cad it display in excel as 40947

and 005 display as 5.

[fixo]

Not sure about, probaly this was occured by local Excel settings,

attach this excel file for the test on my end

I'm using Excel 2007 (student release)

 

possible solution may be to combine values with the

single quote at the front of them, e.g.:

(setq row 1)
(foreach item output
 (setq col 1)
 (foreach a item
   (setcelltext xlcells row col ([color=red]strcat "'" a[/color]))
   (setq col (1+ col))
 )
 (setq row (1+ row))
)

[Mobain]

I am using autoCAD 2011 and have loaded "excel_write.LSP‎" but I cant seem to get it to work maybe I'm not using the right command... I type "excel_write" and i get Unknown command. I'm not sure if this lisp routine does it by drawing or by several at a time, or if it works with 2011

 

Does anyone know of a lisp routine to export the text from several .dwg files to an excel file

[ReMark]

You should have opened up the lisp routine if it wasn't made obvious what you have to type to run the routine.

 

It's......TEXTXL not excel_write.

[Mobain]

Thanks for the help ReMark, it works as expected.

I need to do this for about 500 .dwg files so if could find a lisp routine to export the all the text from several .dwg files to an excel file that would save a lot of time

[ReMark]

Use the lisp routine provided and run it through a script to batch process all the drawings.

[Mobain]

I'm a bit of a newbe with lisp routines and scripts.

how do i run a lisp routine through a script?