Copy Autocad Text to Excel using VBA

Hi,

This is Krishna....can any one help me how to Copy Autocad Text to Excel using VBA

Hi,

 

This is Krishna....can any one help me how to Copy Autocad Text to Excel using VBA

This one will be copy selected text to existing Excel file

Option Explicit
' Requires:
' Microsoft Excel Object Library
' go to Tools->Options->General Tab and check 'Break on Unhandled Errors'

Const xlFileName As String = "C:\TestFile.xls" '<--change existing file name here

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Public Sub ExportText()

Dim oSset As AcadSelectionSet
Dim oEnt As AcadEntity
Dim oText As AcadText
Dim i As Long

Dim ftype(0) As Integer
Dim fdata(0) As Variant
ftype(0) = 0: fdata(0) = "TEXT"

Dim dxftype As Variant
Dim dxfdata As Variant

dxftype = ftype
dxfdata = fdata
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Dim xlApp As Object
Dim xlBook As Workbook
Dim xlSheet As Worksheet
Dim lngRow As Long, lngCol As Long
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Err.Clear
Set xlApp = CreateObject("Excel.Application")
If Err <> 0 Then
MsgBox "Impossible to run Excel.", vbExclamation
End
End If
End If
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
On Error GoTo Err_Control

         With ThisDrawing.SelectionSets
              While .Count > 0
                   .Item(0).Delete
              Wend
         Set oSset = .Add("$Texts$")
         End With
oSset.SelectOnScreen dxftype, dxfdata
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Open(xlFileName)
Set xlSheet = xlBook.Sheets(1)
xlApp.ScreenUpdating = False
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
lngRow = 1: lngCol = 1
For Each oEnt In oSset
Set oText = oEnt
xlSheet.Cells(lngRow, lngCol).Value = oText.TextString
lngRow = lngRow + 1
Next oEnt
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
xlSheet.Columns.HorizontalAlignment = xlHAlignLeft
xlSheet.Columns.AutoFit

xlApp.ScreenUpdating = True

xlBook.Save
xlBook.Close
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
xlApp.Application.Quit
Set xlApp = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
MsgBox "Done"
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Err_Control:
If Err.Number <> 0 Then
MsgBox Err.Description
End If

End Sub
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'

~'J'~

Thanks for the code

Dear all,

sorry to start with root level. The code you mentioned was copied in tools>macro>macros in ACAD 2004. But it stops at "dim xlbook as workbook"

with the error as with the error message as under:

Compile Error:

User-Defined Type not defined

What is going wrong.

Is the macro you mentioned is to be copied in excel vba?

i have tried that too, same result

I have the Microsoft excel library checked. in excel

Dear all,

sorry to start with root level. The code you mentioned was copied in tools>macro>macros in ACAD 2004. But it stops at "dim xlbook as workbook"

with the error as with the error message as under:

Compile Error:

User-Defined Type not defined

What is going wrong.

 

Is the macro you mentioned is to be copied in excel vba?

i have tried that too, same result

I have the Microsoft excel library checked. in excel

This is a typo

Use these lines instead

Dim xlApp As Object

Dim xlBook As Object

Dim xlSheet As Object

~'J'~

Now it stops at xlSheet.Columns.HorizontalAlignment = xlHAlignLeft

I also tried with xlSheet.Columns.HorizontalAlignment = xlLeft

Next I tried by removing that line as a whole. It worked.

it ran as under:

Command: _vbarun

Select objects: Specify opposite corner: 137 found

137 were filtered out.After that message appeared as Done.

But nothing found in Testfile.xlsWhat's going wrong on my side?

it in fact know only dtext command, i realised

Now it stops at xlSheet.Columns.HorizontalAlignment = xlHAlignLeft

I also tried with xlSheet.Columns.HorizontalAlignment = xlLeft

Next I tried by removing that line as a whole. It worked.

it ran as under:

Command: _vbarun

Select objects: Specify opposite corner: 137 found

137 were filtered out.After that message appeared as Done.

But nothing found in Testfile.xlsWhat's going wrong on my side?

Change all Excel constants on numeric values

1. Open any Excel file

2. Go to VBA editor with Alt+F11

3. Open Immediate window

4. Type there excel constant you need with question

mark at front of

i.e.:

?xlleft

then press Enter

-4131

the same way for all xl-constants you used

HTH

~'J'~

Is there a way to get just the text of the Multiline text? I get all of the code that goes along with the text. Ex. Text. Text. Text.\P More Text. More Text. Also if the Text is Underlined etc it includes the code %%U. Can these be removed somehow?

Thanks!

jmitch

Is there a way to get just the text of the Multiline text? I get all of the code that goes along with the text. Ex. Text. Text. Text.\P More Text. More Text. Also if the Text is Underlined etc it includes the code %%U. Can these be removed somehow?

Thanks!

jmitch

Upload the sample drawing here (A2008 or earlier) in zipped form

Not clearly enough for me that you talking about formatted mtext

~'J'~