Export text from acad to excel

[mehrdad]

I need a lisp which open a cad file and copy texts from a specific area to an excel sheet then save the excel file with the name of the cad file, and go to the next acad file. These texts are in a fixed area in all acad files. It is important to keep the order of rows and columns in excel. In fact these acad files are isometric drawings exported from pdms and i need bom of each sheet in an excel.

 

Thanks alot

[fixo]

Here you go

 
 ;;----------------------------TOXL.LSP-------------------------------;;
 ;; fixo ()2013 * all rights released
 ;; 03/11/13
 ;; edited 5/13/13
(defun c:TOXL(/ *error* as col cp data elist en fname gkw newpath nextaddress
         p1 p2 path rad row rownum setcelltext sheetname sset tmp
        xlapp xlbook xlbooks xlcell xlcells xlrange xlsheet xlsheets)
(vl-load-com)
 (defun *error* (msg)
 (if
   (vl-position
     msg
     '("console break"
"Function cancelled"
"quit / exit abort"
      )
   )
    (princ "Error!")
    (princ msg)
 )
 (princ)
)
(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) ))
 )
 
(if (and (setq p1 (getpoint "\nPick lower left point of area: "))
 (setq p2 (getcorner p1"\nOpposite corner: "))
 (setq sset (ssget "_W" p1 p2 (list (cons 0 "text");|(cons 8 "ANNO-TEXT")|)))
 
   (while (setq en (ssname sset 0))
     (setq elist (entget en))
     (setq cp (cdr (assoc 10 elist)))
     (setq txt (cdr (assoc 1 elist)))
     (setq tmp (list txt (rtos (cadr cp)3 2) (rtos (cadr cp) 3 2)  ))
     (setq data (cons tmp data))
     (ssdel en sset)))
(setq sheetname (getstring T "\nEnter the label of an area (like Area#1) : "))
 
 ;;; main part
(if data

(progn
(setq data (append (list (list "Text" "X" "Y")) (reverse data)))
 (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)
)
 (vlax-put-property xlsheet "Name" sheetname)
 
 (vla-put-visible xlapp :vlax-true)
 (setq row 1)
 

(foreach dim data
 (setq col 1)
(foreach i dim
(setcelltext xlcells row col (vl-princ-to-string i))
 (setq col (1+ col)
     )
 )
(setq row (1+ row)
     )
 )
 
(vlax-invoke-method
  (vlax-get-property xlsheet 'Columns)
  'AutoFit)
 
(setq fname (strcat (getvar "dwgprefix")(vl-filename-base (getvar "dwgname"))".xls"))
(vlax-invoke-method
   xlbook
   'SaveAs
   fname 
   nil
   nil
   nil
   :vlax-false
   :vlax-false
   1
   2
 )
(vlax-invoke-method
   xlbook 'Close)
 (gc)
(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)
 (alert (strcat "File saved as:\n" fname))
 )
)
 (*error* nil)
 (princ)
 )
(prompt "\n\t\t---\tStart command with TOXL\t---\n")
(prin1)
(or (vl-load-com)
   (princ))

[mehrdad]

Thanks a lot, this lisp was good but it changes the order of rows and columns, it is very important for me to keep the format like above in excel file. I really appreciate you if you could edit your lisp again. Thank you again

Drawing1.dwg

[fixo]

Sorry I can be more help, too difficult to solve it