excel to autocad routine opens a new instance of excel that has no worksheet.

T

tombates

I have a routine to transfer data between excel and autocad. My
routine starts in Autocad and is supposed to go to the open excel file,
extract the numbers and place the numbers in Autocad. Sometimes it
will bypass the open excel file and will open a new instance of excel
that has no worksheet. How can I prevent this from happening.
Mary
 
T

tombates

Here is the code
Mary
----------
Dim rng As Range

Dim sysVarName1 As String
Dim sysVarName As String
Dim textstring As String

Dim excel As Object
Dim acad As Object

Dim inspt As Variant
Dim sysVarData As Variant
Dim sysVarData1 As Variant
Dim varData1 As Variant
Dim varData As Variant

Dim lastrow As Long
Dim rownum As Long
Dim endrow As Long
Dim endcol As Long
Dim begrow As Long
Dim begcol As Long

Dim HEIGHT1 As Double
Dim WIDTH As Double
Dim dist As Double
Dim dist1 As Double
Dim dist2 As Double

Dim DataType As Integer
Dim intData As Integer

Dim mysheet
Dim ORSNAP
Dim mysnap
Private Sub CommandButton1_Click()

EXAMPLE_GETVARIABLE

Set excel = GetObject(, "Excel.Application")
If Err <> 0 Then
Err.Clear
'Set excel = CreateObject("Excel.Application")
'If Err <> 0 Then
'MsgBox "Could not load Excel.", vbExclamation
'End
'End If
End If
On Error GoTo 0

excel.Visible = True
mysheet = excel.ActiveWorkbook.ActiveSheet.Name
Set excelsheet = excel.ActiveWorkbook.Sheets(mysheet)
Set rng = excel.Application.InputBox(Prompt:="Select range", Type:=8)
begrow = rng(1).Row
begcol = rng(1).Column
endrow = rng(rng.Count).Row
endcol = rng(rng.Count).Column
excelacadform.Hide
excel.Visible = False
Set acad = GetObject(, "autocad.Application")

GETNUMBERS

EXAMPLE_SETVARIABLE

WIDTH = 6 * varData
PtFlag1 = True
col = begcol
rownum = begrow
dist = 0
While PtFlag1 = True
inspt = ThisDrawing.Utility.GetPoint(, "Enter a point: ")
PtFlag = True
rownum = begrow
While PtFlag = True
textstring = excelsheet.Cells(rownum, col).Value
Set textobj = ThisDrawing.ModelSpace.AddMText(inspt, WIDTH, textstring)
textobj.AttachmentPoint = acAttachmentPointMiddleCenter
textobj.InsertionPoint = inspt
inspt(1) = inspt(1) - dist1
rownum = rownum + 1
If rownum = (endrow + 1) Then PtFlag = False
Wend
col = col + 1
If col = (endcol + 1) Then PtFlag1 = False
Wend
intData = varData
excel.Visible = True
sysVarData = ORSNAP
ThisDrawing.SetVariable sysVarName, sysVarData
End Sub
Sub EXAMPLE_SETVARIABLE()


mysnap = ThisDrawing.Utility.GetString(True, "Enter text (1 for int; 2
for near; 3 for none; 4 for insert")
'intData = 64
'mysnap = 4


If mysnap = 1 Then
intData = 32
ElseIf mysnap = 2 Then
intData = 512
ElseIf mysnap = 3 Then
intData = 0
ElseIf mysnap = 4 Then
intData = 64
End If








sysVarName = "osmode"
sysVarData = intData
ThisDrawing.SetVariable sysVarName, sysVarData
End Sub
Sub EXAMPLE_GETVARIABLE()
sysVarName = "OSMODE"
ORSNAP = ThisDrawing.GetVariable(sysVarName)
End Sub
Sub GETNUMBERS()
sysVarName = "textsize"
varData = ThisDrawing.GetVariable(sysVarName)
retval = MsgBox("The current textheight is " &
ThisDrawing.GetVariable(sysVarName) & " do you want to use this?", 36)
If retval = 7 Then
HEIGHT1 = ThisDrawing.Utility.GetReal("type text height:")
sysVarData = HEIGHT1
ThisDrawing.SetVariable sysVarName, sysVarData
End If

GETDIST

End Sub
Sub GETDIST()

sysVarName1 = "userr1"
dist2 = ThisDrawing.GetVariable(sysVarName1)
If dist2 = 0 Then
dist1 = 0.375
sysVarData1 = dist1
ThisDrawing.SetVariable sysVarName1, sysVarData1
retval = nil
End If




sysVarName1 = "userr1"
varData1 = ThisDrawing.GetVariable(sysVarName1)
retval = MsgBox("the current distance between lines of text is " &
ThisDrawing.GetVariable(sysVarName1) & ", do you want to use this?",
36)
If retval = 7 Then
dist1 = ThisDrawing.Utility.GetDistance(, "Pick two points or type
amount.")
sysVarData1 = dist1
ThisDrawing.SetVariable sysVarName1, sysVarData1
End If
If retval = 6 Then
dist1 = 0.375
sysVarData1 = dist1
ThisDrawing.SetVariable sysVarName1, sysVarData1
End If
'MsgBox ThisDrawing.GetVariable(sysVarName1)
End Sub

Private Sub UserForm_Click()

End Sub
 
N

NickHK

Mary,
Looks like GetObject is failing because there is no instance of Excel
running, so you are creating a new empty instance, even though that code is
commented out in your sample.
Also, whilst not the cause your problem, it would be better to use something
like "XLApp" instead of "excel" for the variable name.

Assuming ACAD VBA behaves the same as in Office, this line really means
nothing:
If Err<>0 Then
because you have no "On Error Resume Next" before GetObject. So if there is
an error, it will not be handled.

So basically your is code is working (after you add "On Error Resume Next").
But because you need to work with the current XL file, you should exit your
code if GetObject fails, because you have nothing to work with.
Also, you do know that if you have more than 1 instance of Excel running,
GetObject will give access to 1 instance essentially at random. So you may
not get the reference to workbook you desire.

NickHK

Here is the code
Mary
Dim excel As Object
Dim acad As Object
-------- Excess code cut -------------
Private Sub CommandButton1_Click()

EXAMPLE_GETVARIABLE

Set excel = GetObject(, "Excel.Application")
If Err <> 0 Then
Err.Clear
'Set excel = CreateObject("Excel.Application")
'If Err <> 0 Then
'MsgBox "Could not load Excel.", vbExclamation
'End
'End If
End If
On Error GoTo 0

excel.Visible = True
mysheet = excel.ActiveWorkbook.ActiveSheet.Name
Set excelsheet = excel.ActiveWorkbook.Sheets(mysheet)
Set rng = excel.Application.InputBox(Prompt:="Select range", Type:=8)
begrow = rng(1).Row
--------------- Excess code cut -----------
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top