Autocad how get text to excel use visual lisp

Autocad how get text to excel use visual lisp

Anonymous
Not applicable
1,223 Views
1 Reply
Message 1 of 2

Autocad how get text to excel use visual lisp

Anonymous
Not applicable
I Find this code but no I need,

like this,how to Improve this code?

lines to excel too!
 
 



Autocad text to excel

Dear sir,

Would you like to help me.

How to modify the the command from listing lsp at below, cause every time I select the text always come up with new workbook xls. I want to change to be come still in the same workbook.

thank you

 

(defun c:ttx (/ ss xlApp xlCells row col i)
(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 0 col 1)
(vla-put-visible xlApp :vlax-true)
(foreach y
(mapcar '(lambda (x / iPt)
(setq iPt (vlax-get x 'InsertionPoint))
(list (vla-get-TextString x)
(rtos (car iPt) 2 2)
(rtos (cadr iPt) 2 2)
(rtos (caddr iPt) 2 2)))
(mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
(if (> row 65536) (setq col 5))
(setq i -1 row (1+ row))
(mapcar
(function
(lambda (x)
(vlax-put-property xlCells "Item" row
(+ col (setq i (1+ i))) x))) y))))
(mapcar 'vlax-release-object (list xlApp xlCells))
(princ))

0 Likes
1,224 Views
1 Reply
Reply (1)
Message 2 of 2

Sea-Haven
Mentor
Mentor

It needs a rewrite a reorder of the sequence of events the If ssget needs to be after the excel is opened, if you run again needs a check for is excel already open. 

 

Try this not tested.

(defun c:ttx (/ ss xlApp xlCells row col i)
(vl-load-com)

(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 0 col 1)
(vla-put-visible xlApp :vlax-true)

(if (setq ss (ssget '((0 . "*TEXT"))))
(progn

(foreach y
(mapcar '(lambda (x / iPt)
(setq iPt (vlax-get x 'InsertionPoint))
(list (vla-get-TextString x)
(rtos (car iPt) 2 2)
(rtos (cadr iPt) 2 2)
(rtos (caddr iPt) 2 2)))
(mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
(if (> row 65536) (setq col 5))
(setq i -1 row (1+ row))
(mapcar
(function
(lambda (x)
(vlax-put-property xlCells "Item" row
(+ col (setq i (1+ i))) x))) y))))
(mapcar 'vlax-release-object (list xlApp xlCells))
(princ))

 

0 Likes