Text to excel sheet

[Commandobill]

Wow, i really need to learn to look over my code before posting.

 

Why do you need to add one to the row count, and take one from the column count? (is it just that the program returns one more column than needed and the number last row used? - if that makes sense...)

In this instance the column was going to return as an even number because we were adding one thing to two columns. I wanted it to go back one column before writing. Then i needed to add one to the row so that it didnt write over my last row. Understand?

 

As far as using file with vla-add. That was just a "rush" error. I was trying to get it out and didnt look. Same with getting the "usedrange" with the new file. I decided to add the option in last minute so i just copied the code above it and forgot to remove a few things.

[Commandobill]

And i dont mind you ripping apart my code. Hopefully ill learn something from it too. Lisp is my first programming language so my methods are still new.

[Lee Mac]

In this instance the column was going to return as an even number because we were adding one thing to two columns. I wanted it to go back one column before writing. Then i needed to add one to the row so that it didnt write over my last row. Understand?

 

So you are assuming that the existing file has data that spans two columns here :wink:

 

As far as using file with vla-add. That was just a "rush" error. I was trying to get it out and didnt look. Same with getting the "usedrange" with the new file. I decided to add the option in last minute so i just copied the code above it and forgot to remove a few things.

 

So what should it be instead of file?

[Commandobill]

So you are assuming that the existing file has data that spans two columns here :wink:

 

 

 

So what should it be instead of file?

 

 

Yes i am assuming that. (vla-add obj) is the same as (vlax-invoke-method obj "Add") no further description is necessary to make it run.

[Lee Mac]

Yes i am assuming that. (vla-add obj) is the same as (vlax-invoke-method obj "Add") no further description is necessary to make it run.

 

Ahh OK, I see - thanks mate

[SydneyCB]

I read in a early post that you can make it export text only from a certain layer or layers, could you to modify it so it does that, I'm not familiar with writing lisps but i'm trying to figure it out.

[Commandobill]

the selection set in the beginning tells it what to export so...

 

(setq ss (ssget "_X" (list (cons 0 "*TEXT, INSERT") (cons 8 "LAYERNAME"))))

 

if you change the layername in there you could then add a comma for extra layers....

[SydneyCB]

the selection set in the beginning tells it what to export so...

 

(setq ss (ssget "_X" (list (cons 0 "*TEXT, INSERT") (cons 8 "LAYERNAME"))))

 

if you change the layername in there you could then add a comma for extra layers....

 

k thanks, i'll try playing with it, the codes still all look greek to me but are startng to make sense

[SteveK]

If anyone's interested I have been modifying the code posted previously by CommandoBill and Lee Mac to take text that is in a table format in autocad (not an actual autocad table) with 4 columns and place it in roughly the same table format in excel.

 

EDIT: I had a minor problem with which row to start on but that is fixed up now thanks for Lee.

 

Here's the code:

; Select TEXT and program will output Text into one of five columns in Excel
; Works reasonably ok however if there are meant to be cell gaps it will not pick them up.
(defun c:t2xl  (/ ss xlApp xlCells row col
       Txt_Str x_coord
       ens_unsorted ens_y_sorted
       Col1_x Col2_x Col3_x Col4_x
       col_prev)
 (vl-load-com)
 (if (setq ss (ssget '((0 . "*TEXT"))))
   (progn
           (setq xlApp   (vlax-get-or-create-object "Excel.Application")
                 xlCells (vlax-get-property
                           (vlax-get-property
                             (vlax-get-property
                               (vlax-invoke-method
                                 (vlax-get-property xlApp "Workbooks")
                                 "Add") "Sheets") "Item" 1) "Cells") row 1 col 1)
           (vla-put-visible xlApp :vlax-true)
     
     (setq list1 (list)
       list2 (list)
       list3 (list)
       list4 (list)
       list5 (list))

     ; Sort selection set by y co-ord: The problem is if the y co-ord is the same it will delete the entity.
     (setq ens_unsorted (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
     (setq ens_y_sorted (vl-sort
              ens_unsorted
              '(lambda (e1 e2)
                 (> (cadr (vlax-get e1 'InsertionPoint))
                (cadr (vlax-get e2 'InsertionPoint))))))
     ;(princ ens_y_sorted)
     
     (foreach y ens_y_sorted
   
   (setq Txt_Str (vlax-get y 'TextString)
         x_coord (car (vlax-get y 'InsertionPoint)))
         ;y_coord (cadr (vlax-get y 'InsertionPoint)))

   (Cond ((Not Col1_x)
          (setq Col1_x x_coord
            list1 (append list1 (List Txt_Str))))
         
         ((EQUAL x_coord Col1_x 5.) ; Fuzz factors is 5
          (setq list1 (append list1 (List Txt_Str))))
         
         ((OR (Not Col2_x)
          (= Col1_x Col2_x))
          (setq Col2_x x_coord
            list2 (append list2 (List Txt_Str))))
         
         ((EQUAL  x_coord Col2_x 5.)
          (setq list2 (append list2 (List Txt_Str))))
         
         ((OR (Not Col3_x)
          (= Col2_x Col3_x))
          (setq Col3_x x_coord
            list3 (append list3 (List Txt_Str))))
         
         ((EQUAL  x_coord Col3_x 5.)
          (setq list3 (append list3 (List Txt_Str))))
         
         ((OR (Not Col4_x)
          (= Col3_x Col4_x))
          (setq Col4_x x_coord
            list4 (append list4 (List Txt_Str))))
         
         ((EQUAL  x_coord Col4_x 5.)
          (setq list4 (append list4 (List Txt_Str))))
         
         (T ; Else put it in col 5
          (setq list5 (append list5 (List Txt_Str)))
          ))
   
   
   ) ; End For
     
     
;;;      (princ "\n1\n")
;;;      (princ list1)
;;;      (princ "\n2\n")
;;;      (princ list2)
;;;      (princ "\n3\n")
;;;      (princ list3)
;;;      (princ "\n4\n")
;;;      (princ list4)
;;;      (princ "\n5\n")
;;;      (princ list5)

     (foreach item list1
   (vlax-put-property xlCells "Item" row col item)
   (setq col 1
         row (1+ row))
   )

     (setq row 1)
     (foreach item list2
   (vlax-put-property xlCells "Item" row col item)
   (setq col 2
         row (1+ row))
   )

     (setq row 1)
     (foreach item list3
   (vlax-put-property xlCells "Item" row col item)
   (setq col 3
         row (1+ row))
   )

     (setq row 1)
     (foreach item list4
   (vlax-put-property xlCells "Item" row col item)
   (setq col 4
         row (1+ row))
   )

     (setq row 1)
     (foreach item list5
   (vlax-put-property xlCells "Item" row col item)
   (setq col 5
         row (1+ row))
   )
     
     
     
     
           (mapcar 'vlax-release-object (list xlApp xlCells))
     
     )(Princ "Nothing Selected"))
 
 (princ))

[Lee Mac]

I believe it starts from row 1

[SteveK]

Ofcourse! Sorry and thanks.

 

I'll re-update my post.

[Lee Mac]

Glad I could help

[PRABHAKARAN]

Hi,

 

this is prabha.

 

One help,

 

i want to export autocad text to excel in the same column and row without image.....

I need the lisp for that option.

Can you please help for that?

 

Thanks,

prabha...

[fixo]

Try this code to solve your issue,

I can be more help

;;---------------------------- code start 
-------------------------------;;
(defun C:CTXL(/ *error* colnum en i ncol nrow path sheetname ss txt x xcells
      
xlapp xlbook xlbooks xlcells xlcolrange xldata xllastcell xlsheet 
xlsheets)
 (vl-load-com)
 
(defun 
*error* (msg)
 (if
   
(vl-position
     
msg
     '("console break"
"Function 
cancelled"
"quit / exit 
abort"
)
     
)
    (princ "Error!")
    
(princ msg)
    )
 (and 
xlapp
      
(vl-catch-all-apply
       
'vlax-release-object (list xlapp)))
 (princ)
 )
 ;; 
helpers: 
 (defun lastcell_in_column(excelapp colrange / colcells 
colnum lastcell rowcount)
;;; author: fixo () 2011 * all rights 
released
(vl-catch-all-apply     
 
'vlax-invoke-method (list excelapp '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
)
 
 
)
(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 ss 
(ssget '((0 . "TEXT"))))


(progn
(repeat (setq i (sslength 
ss))
           (setq 
en     (ssname ss (setq i (1- 
i)))
                 
txt   (cdr (assoc 1 (entget en)))
   xldata (cons 
txt xldata)))


 (setq xldata (reverse xldata))
     (setq 
path (getfiled "Select Excel file to write :"
  (getvar 
"dwgprefix")
  "xls;xlsx"
  16
      
)
 )
 (initget 7)
 (setq sheetname (getint "\nSpecify 
sheet name : "))


 
   (setq colnum (getstring "\nColumn letter: 
"))
  (alert "Confirm \"Save\" Excel File on 
Request")
   (setq xlapp (vlax-get-or-create-object 
"Excel.Application")
  xlbooks (vlax-get-property xlapp 
'Workbooks)
  xlbook (vl-catch-all-apply 
'vla-open
      (list xlbooks 
path))
  xlsheets (vlax-get-property xlbook 
'Sheets)
  xlsheet (vlax-get-property xlsheets 'Item 
sheetname)
  xcells (vlax-get-property xlsheet 
'Cells)
  )
    (vla-put-visible xlapp 
:vlax-true)
   (vlax-invoke-method xlsheet 
'Activate)
   (setq xlcolrange (vlax-get-property xcells 
'range (strcat colnum ":" colnum)))
   (setq xllastcell 
(lastcell_in_column xlapp xlcolrange))
   (setq nrow 
(vlax-get-property xllastcell 'row) ncol (vlax-get-property xllastcell 
'column))
   (foreach txt xldata
   
(setcelltext xlcolrange nrow ncol txt)
   (setq nrow (1+ 
nrow)))


 
(vl-catch-all-apply 'vlax-invoke-method
  
(list (vlax-get-property xlsheet 'Columns)'AutoFit)
  )
 



(vlax-invoke-method
   xlbook
   
'SaveAs
   path 
   
nil
   nil
   nil
   
:vlax-false
   :vlax-false
   
1
   2
 
)
(vlax-invoke-method
   xlbook 'Close 
:vlax-true)
 (gc)  
(vlax-invoke-method
   
xlapp 'Quit)
 (mapcar '(lambda (x)
     
(vl-catch-all-apply
       
'vlax-release-object (list x))
 )
 
  (list 
xlcells xlsheet xlsheets xlbook xlbooks xlapp)
 )
 (setq  
xlapp nil)
 (gc)
 (alert (strcat "File saved as:\n" 
path))
 )
)


 (*error* nil)
 (princ)
 )
(prompt 
"\n\t\t---\tStart command with CTXL\t---\n")
(princ)
(or 
(vl-load-com)(princ))
;;---------------------------- code end 
-------------------------------;;

[pegasus]

CAN WE ADD LIMITATIONS TO TEXT AND MTEXT IN SPECIAL LAYER HERE?

 

On 6/3/2009 at 5:05 PM, Commandobill said:

Well if all of the text objects were on model space and you wanted to use Lee's trick of getting all the objects from all open dwgs you could go with this

 

 

(defun c:txt2csv (/ fPath fName ofile docs mdlspc drac mdl)
 (vl-load-com)

 (setq fPath "C:\\")
 (setq fName "test.csv")

 (if (vl-file-directory-p fPath)
   (progn
     (setq ofile (open (strcat fPath fName) "a"))
     (vlax-for docs (vla-get-documents (vlax-get-acad-object))
   (setq mdlspc (vla-get-modelspace docs))
   (setq drac 0)
   (vlax-for mdl mdlspc
     (if (or (= (vla-get-objectname mdl) "AcDbMText")
         (= (vla-get-objectname mdl) "AcDbText"))
       (write-line (vla-get-textstring mdl) ofile)
       )
     (setq drac (1+ drac))
     )
   )
     )
   )
 (close ofile)
 (princ))

 

 

 

 

edit: 100th post.... sweet...

 

[ronjonp]

@pegasus

Sure

(setq fpath "C:\\")
(setq fname "test.csv")

(if (vl-file-directory-p fpath)
  (progn (setq ofile (open (strcat fpath fname) "a"))
	 (vlax-for docs	(vla-get-documents (vlax-get-acad-object))
	   (setq mdlspc (vla-get-modelspace docs))
	   (setq drac 0)
	   (vlax-for mdl mdlspc
	     (if (and (wcmatch (vla-get-objectname mdl) "AcDbMText,AcDbText")
		      (wcmatch (strcase (vla-get-layer mdl)) "LAYER1,LAYER2,LAYER3")
		 )
	       (write-line (vla-get-textstring mdl) ofile)
	     )
	     (setq drac (1+ drac))
	   )
	 )
  )
)
(close ofile)
(princ)

 

[Steven P]

58 minutes ago, ronjonp said:

@pegasus

 

	     (if (and (wcmatch (vla-get-objectname mdl) "AcDbMText,AcDbText")
		      (wcmatch (strcase (vla-get-layer mdl)) "LAYER1,LAYER2,LAYER3")
		 )

 

 

Will that work with a wildcard too? For example:

 

(wcmatch (vla-get-objectname mdl) "*Text")

 

(though this will also pick up rtext? - Yet to see that in a drawing though)

 

Should also work with a wildcard in the layer name?

[ronjonp]

5 minutes ago, Steven P said:

 

Will that work with a wildcard too? For example:

 

(wcmatch (vla-get-objectname mdl) "*Text")

 

(though this will also pick up rtext? - Yet to see that in a drawing though)

 

Should also work with a wildcard in the layer name?

Wildcards will definitely work ... look at the reference HERE.