[VBA] Writing a data from excel to autocad without openning autocad manuelly

[Nicolas.L]

Hello,

I have trouble in my task. I am trying to write the data of an excel cell into autocad ( string data ).

The following code is almost right but it doesn't write the text in autocad.

(open autocad and add drawing only)

If anyone has an idea on the problem.

Regards

Nicolas

Code VBA:

Public ThisDrawing As AcadObject

Sub test()

Dim xAP As Excel.Application
Dim xWB As Excel.Workbook
Dim xWS As Excel.Worksheet
Dim Height As Double
Dim P(0 To 2) As Double
Dim TxtObj As AcadText
Dim TxtStr As String
Dim AcadObj As AcadApplication
Dim AcadDoc As AcadDocument

Set xAP = Excel.Application
Set xWB = xAP.Workbooks.Open("C:\Path\Name.xls")
Set xWS = xWB.Worksheets("Sheet1")
MsgBox "Excel says: """ & Cells(1, 1) & """"

 
On Error Resume Next
Set AcadObj = GetObject(, "AutoCAD.Application")
If Err.Number <> 0 Then
    Set AcadObj = CreateObject("AutoCAD.Application")
    NombreDessinAutocad = 2
End If
AcadObj.Visible = True
 
    MsgBox "Step_1"
       
Set AcadDoc = AcadObj.Application.Documents.Add
MsgBox AcadObj.name & " version " & AcadObj.Version & _
" is running."
Set AcadUtil = AcadDoc.Utility
Set AcadEspaceObj = AcadDoc.ModelSpace
  
    MsgBox "Step_2"

Height = 10
P(0) = 1: P(1) = 1: P(2) = 0
TxtStr = Cells(1, 1)
   
    MsgBox TxtStr
   
Set TxtObj = AcadObj.ModelSpace.AddText(TxtStr, P, Height)    <------doesn't work
Set TxtObj = ThisDrawing.ModelSpace.AddText(TxtStr, P, Height)      <------doesn't work

    MsgBox "End"
 

End Sub

[Nicolas.L · Accepted solution]

Hi,

This was a little mystake, her is the solution:

Public ThisDrawing As AcadObject

Sub test()

Dim xAP As Excel.Application
Dim xWB As Excel.Workbook
Dim xWS As Excel.Worksheet
Dim Height As Double
Dim P(0 To 2) As Double
Dim TxtObj As AcadText
Dim TxtStr As String
Dim AcadObj As AcadApplication
Dim AcadDoc As AcadDocument

Set xAP = Excel.Application
Set xWB = xAP.Workbooks.Open("C:\Path\Name.xls")
Set xWS = xWB.Worksheets("Sheet1")
MsgBox "Excel says: """ & Cells(1, 1) & """"

 
On Error Resume Next
Set AcadObj = GetObject(, "AutoCAD.Application")
If Err.Number <> 0 Then
    Set AcadObj = CreateObject("AutoCAD.Application")
    NombreDessinAutocad = 2
End If
AcadObj.Visible = True
 
    MsgBox "Step_1"
       
Set AcadDoc = AcadObj.Application.Documents.Add
MsgBox AcadObj.name & " version " & AcadObj.Version & _
" is running."
Set AcadUtil = AcadDoc.Utility
Set AcadEspaceObj = AcadDoc.ModelSpace
  
    MsgBox "Step_2"

Height = 10
P(0) = 1: P(1) = 1: P(2) = 0
TxtStr = Cells(1, 1)
   
    MsgBox TxtStr
   
'Set TxtObj = AcadObj.ModelSpace.AddText(TxtStr, P, Height)    <------doesn't work
'Set TxtObj = ThisDrawing.ModelSpace.AddText(TxtStr, P, Height)      <------doesn't work

Set TxtObj = AcadEspaceObj.AddText(TxtStr, P, Height) <-------- Work !

    MsgBox "End"
 

End Sub

[noveldecor]

Hi

Thanks for this post.

I am wanting to do a similar thing.

Can you attached a sample Excel data file along with the Autolisp code which i can load in my autocad file.

Best Wishes

-Arian

[lohithna]

can you please write a program for inventor application 

i  have to write for inventor parts