how to connect to already open excel sheet
 

Hi All,
I need help connecting a open excel file with autocad vba routine.
I'm trying to get a already open excel file and read text from columns and
have it placed this text into autocad. The excel routine was created to
placed text from excel into autocad with a preset drawing with a grid block
at a known coordinates. I now want to alter this so the user selects the
block which is the grid block and get the insert point coordintates from
that block. ( I can do this in the first part of routine) & I get the excel
to work by itself .

Both routines work by themself but I don't see how to get them to work as
one from autocad. The excel part of the routine places the selected text in
excel into autocad

I need to pass insertion point of the block in autocad to the x,y start
point in the excel part of the code. how do I wake up the already open excel
file.

As always, thank you for any comments or direction.
John Coon

'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''I tried this
but am not sure why it doesn't work. I thought this would connect to a
existing or already open excel file
On Error Resume Next
Set excelapp = GetObject(, "Excel.Application")
If Err < 0 Then
Err.Clear
Set excelapp = CreateObject("Excel.Application")
If Err < 0 Then
MsgBox "Could Not Start Excel", vbExclamation
End
End If
End If
excelapp.Visible = True
Set wbkobj = excelapp.Add
Set shtobj = excelapp.Worksheets(1)





'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''gets
autocad block insertion point. need to pass insertion pnt to excel part of
routine
Sub getisnsertionpoint()
Dim dbpref As AcadDatabasePreferences
Set dbpref = ActiveDocument.Preferences
Dim currLayer As AcadLayer
Dim layerObj As AcadLayer
Dim mtxtlabel As AcadMText
Dim strText As String
Dim dblHeight As Double
Dim dblWidth As Double
Dim dblRot As Double
Dim txtinsert As Variant
Dim strNorth As String
Dim strEast As String
dblRot = -ThisDrawing.GetVariable("VIEWTWIST")
Set layerObj = ThisDrawing.Layers.Add("C-LITE-TEXT")
layerObj.Color = acYellow
ThisDrawing.ActiveLayer = layerObj

dblWidth = 0
dblRot = -ThisDrawing.GetVariable("VIEWTWIST")

Dim setOBJ As AcadSelectionSet
Dim ftype(0) As Integer
Dim fdata(0) As Variant
Dim f_type As Variant
Dim f_data As Variant
Dim i As Integer
Dim pt As Variant
ftype(0) = 0
fdata(0) = "INSERT"
f_type = ftype
f_data = fdata

Set setOBJ = ThisDrawing.SelectionSets.Add("TEST2")
setOBJ.SelectOnScreen

For i = 0 To setOBJ.Count - 1
pt = setOBJ.Item(i).InsertionPoint

Dim north As String
Dim east As String
strText = "Test"
east = pt(0)
north = pt(1)

strNorthFormat = "#0.0000"
strEastFormat = "#0.0000"


strNorth = Format(north, strNorthFormat)
strEast = Format(east, strEastFormat)

strText = "N: " & (strNorth) & "\P" _
"E: " & (strEast) & "\P" _


Set mtxtlabel = ThisDrawing.ModelSpace.AddMText(pt, dblWidth, strText)
mtxtlabel.Rotation = dblRot

MsgBox " Coords X,Y = " & pt(0) & "," & pt(1)

Next i

setOBJ.Delete

End Sub



'''''''''''''''''''''''''''''''''''''''''''''''''' '''''reads text in excel &
sends to autocad
Sub insertfromexcel()
Dim acadApp As Object
Dim insPnt(0 To 2) As Double
Dim textHgt As Double
'Dim x As Double
Dim textObj As Object
Dim newword As String
On Error Resume Next
Set acadApp = GetObject(, "AutoCAD.Application")
If Err Then
Err.Clear
Set acadApp = CreateObject("AutoCAD.Application")
If Err Then
MsgBox Err.Description
Exit Sub
End If
End If
acadApp.Visible = True
acadApp.Top = 0
acadApp.Left = 0
acadApp.Width = 400
acadApp.Height = 600
Dim acadDoc As Object
Set acadDoc = acadApp.activedocument

Dim layerObj As AcadLayer
Set layerObj = acadDoc.Layers.Add("C-GEOM-TEXT")
layerObj.Color = acYellow
acadDoc.ActiveLayer = layerObj

'HIGHLIGHT RANGE
Worksheets("Sheet1").Activate
RowCount = Selection.Rows.Count
Dim y As Double
Dim x As Double
Dim counter As Double

textHgt = 0.12
x = 2.56
y = 20.12
Set moSpace = acadDoc.ModelSpace

For counter = 1 To RowCount
'1 ROW OF TEXT
newword = Worksheets("Sheet1").Cells(counter, 1).Value
insPnt(0) = x
insPnt(1) = y
x = x + 1
Set textObj = moSpace.AddText(newword, insPnt, textHgt)
Set moSpace = acadDoc.ModelSpace
'2 ROW OF TEXT
newword = Worksheets("Sheet1").Cells(counter, 2).Value
insPnt(0) = x + 5.55
insPnt(1) = y
x = x + 1
Set textObj = moSpace.AddText(newword, insPnt, textHgt)
Set moSpace = acadDoc.ModelSpace
'3 ROW OF TEXT
newword = Worksheets("Sheet1").Cells(counter, 3).Value
insPnt(0) = x + 5.55
insPnt(1) = y
x = x + 1
Set textObj = moSpace.AddText(newword, insPnt, textHgt)
Set moSpace = acadDoc.ModelSpace
'4 ROW OF TEXT

newword = Worksheets("Sheet1").Cells(counter, 4).Value
insPnt(0) = x + 5.4
insPnt(1) = y
x = x + 1
Set textObj = moSpace.AddText(newword, insPnt, textHgt)
Set moSpace = acadDoc.ModelSpace

'5 ROW OF TEXT
newword = Worksheets("Sheet1").Cells(counter, 5).Value
insPnt(0) = x + 7
insPnt(1) = y
x = x + 1
Set textObj = moSpace.AddText(newword, insPnt, textHgt)
Set moSpace = acadDoc.ModelSpace

Dim newword1 As String
Dim blockRefObj As Object
newword1 = Worksheets("Sheet1").Cells(counter, 3).Value
insPnt(0) = x
insPnt(1) = y
Dim x1 As Double
Dim y1 As Double
Dim rot As Double
x1 = 1
y1 = 1
rot = 0
Set blockRefObj = moSpace.InsertBlock(insPnt, newword1, x1, y1, rot)
y = y - 0.72
x = 2.56
Next counter
End Sub

how to connect to already open excel sheet
 

John,

I am not going to try and work it all through, don't have Autocad and can't
test, but maybe some hints.
The code snippet has opened a worksheet okay. What you need to then do is
pass that worksheet object to the other routines and qualify all Excel
objects with that sheet object, something like

Set shtobj = excelapp.Worksheets(1)

Call Suba(shtobj)
....



Suba(sh as object)

With sh

....

.Range("A1") .Value = "abc" 'as an example

End With

End Sub

Not that you call Suba with the shtobj worksheet object, but you can call
the parameter in Suba anything you like (I use sh), but refer in the Suba
code to the parameter name.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"John Coon" wrote in message
...
Hi All,
I need help connecting a open excel file with autocad vba routine.
I'm trying to get a already open excel file and read text from columns and
have it placed this text into autocad. The excel routine was created to
placed text from excel into autocad with a preset drawing with a grid
block
at a known coordinates. I now want to alter this so the user selects the
block which is the grid block and get the insert point coordintates from
that block. ( I can do this in the first part of routine) & I get the
excel
to work by itself .

Both routines work by themself but I don't see how to get them to work as
one from autocad. The excel part of the routine places the selected text
in
excel into autocad

I need to pass insertion point of the block in autocad to the x,y start
point in the excel part of the code. how do I wake up the already open
excel
file.

As always, thank you for any comments or direction.
John Coon

'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''I tried this
but am not sure why it doesn't work. I thought this would connect to a
existing or already open excel file
On Error Resume Next
Set excelapp = GetObject(, "Excel.Application")
If Err < 0 Then
Err.Clear
Set excelapp = CreateObject("Excel.Application")
If Err < 0 Then
MsgBox "Could Not Start Excel", vbExclamation
End
End If
End If
excelapp.Visible = True
Set wbkobj = excelapp.Add
Set shtobj = excelapp.Worksheets(1)





'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''gets
autocad block insertion point. need to pass insertion pnt to excel part of
routine
Sub getisnsertionpoint()
Dim dbpref As AcadDatabasePreferences
Set dbpref = ActiveDocument.Preferences
Dim currLayer As AcadLayer
Dim layerObj As AcadLayer
Dim mtxtlabel As AcadMText
Dim strText As String
Dim dblHeight As Double
Dim dblWidth As Double
Dim dblRot As Double
Dim txtinsert As Variant
Dim strNorth As String
Dim strEast As String
dblRot = -ThisDrawing.GetVariable("VIEWTWIST")
Set layerObj = ThisDrawing.Layers.Add("C-LITE-TEXT")
layerObj.Color = acYellow
ThisDrawing.ActiveLayer = layerObj

dblWidth = 0
dblRot = -ThisDrawing.GetVariable("VIEWTWIST")

Dim setOBJ As AcadSelectionSet
Dim ftype(0) As Integer
Dim fdata(0) As Variant
Dim f_type As Variant
Dim f_data As Variant
Dim i As Integer
Dim pt As Variant
ftype(0) = 0
fdata(0) = "INSERT"
f_type = ftype
f_data = fdata

Set setOBJ = ThisDrawing.SelectionSets.Add("TEST2")
setOBJ.SelectOnScreen

For i = 0 To setOBJ.Count - 1
pt = setOBJ.Item(i).InsertionPoint

Dim north As String
Dim east As String
strText = "Test"
east = pt(0)
north = pt(1)

strNorthFormat = "#0.0000"
strEastFormat = "#0.0000"


strNorth = Format(north, strNorthFormat)
strEast = Format(east, strEastFormat)

strText = "N: " & (strNorth) & "\P" _
"E: " & (strEast) & "\P" _


Set mtxtlabel = ThisDrawing.ModelSpace.AddMText(pt, dblWidth, strText)
mtxtlabel.Rotation = dblRot

MsgBox " Coords X,Y = " & pt(0) & "," & pt(1)

Next i

setOBJ.Delete

End Sub



'''''''''''''''''''''''''''''''''''''''''''''''''' '''''reads text in excel
&
sends to autocad
Sub insertfromexcel()
Dim acadApp As Object
Dim insPnt(0 To 2) As Double
Dim textHgt As Double
'Dim x As Double
Dim textObj As Object
Dim newword As String
On Error Resume Next
Set acadApp = GetObject(, "AutoCAD.Application")
If Err Then
Err.Clear
Set acadApp = CreateObject("AutoCAD.Application")
If Err Then
MsgBox Err.Description
Exit Sub
End If
End If
acadApp.Visible = True
acadApp.Top = 0
acadApp.Left = 0
acadApp.Width = 400
acadApp.Height = 600
Dim acadDoc As Object
Set acadDoc = acadApp.activedocument

Dim layerObj As AcadLayer
Set layerObj = acadDoc.Layers.Add("C-GEOM-TEXT")
layerObj.Color = acYellow
acadDoc.ActiveLayer = layerObj

'HIGHLIGHT RANGE
Worksheets("Sheet1").Activate
RowCount = Selection.Rows.Count
Dim y As Double
Dim x As Double
Dim counter As Double

textHgt = 0.12
x = 2.56
y = 20.12
Set moSpace = acadDoc.ModelSpace

For counter = 1 To RowCount
'1 ROW OF TEXT
newword = Worksheets("Sheet1").Cells(counter, 1).Value
insPnt(0) = x
insPnt(1) = y
x = x + 1
Set textObj = moSpace.AddText(newword, insPnt, textHgt)
Set moSpace = acadDoc.ModelSpace
'2 ROW OF TEXT
newword = Worksheets("Sheet1").Cells(counter, 2).Value
insPnt(0) = x + 5.55
insPnt(1) = y
x = x + 1
Set textObj = moSpace.AddText(newword, insPnt, textHgt)
Set moSpace = acadDoc.ModelSpace
'3 ROW OF TEXT
newword = Worksheets("Sheet1").Cells(counter, 3).Value
insPnt(0) = x + 5.55
insPnt(1) = y
x = x + 1
Set textObj = moSpace.AddText(newword, insPnt, textHgt)
Set moSpace = acadDoc.ModelSpace
'4 ROW OF TEXT

newword = Worksheets("Sheet1").Cells(counter, 4).Value
insPnt(0) = x + 5.4
insPnt(1) = y
x = x + 1
Set textObj = moSpace.AddText(newword, insPnt, textHgt)
Set moSpace = acadDoc.ModelSpace

'5 ROW OF TEXT
newword = Worksheets("Sheet1").Cells(counter, 5).Value
insPnt(0) = x + 7
insPnt(1) = y
x = x + 1
Set textObj = moSpace.AddText(newword, insPnt, textHgt)
Set moSpace = acadDoc.ModelSpace

Dim newword1 As String
Dim blockRefObj As Object
newword1 = Worksheets("Sheet1").Cells(counter, 3).Value
insPnt(0) = x
insPnt(1) = y
Dim x1 As Double
Dim y1 As Double
Dim rot As Double
x1 = 1
y1 = 1
rot = 0
Set blockRefObj = moSpace.InsertBlock(insPnt, newword1, x1, y1, rot)
y = y - 0.72
x = 2.56
Next counter
End Sub

how to connect to already open excel sheet
 

Bob,

Thank you for you comments. I'll try as you suggested

again Thank you for your help.

John Coon
"Bob Phillips" wrote in message
...
John,

I am not going to try and work it all through, don't have Autocad and
can't
test, but maybe some hints.
The code snippet has opened a worksheet okay. What you need to then do is
pass that worksheet object to the other routines and qualify all Excel
objects with that sheet object, something like

Set shtobj = excelapp.Worksheets(1)

Call Suba(shtobj)
...



Suba(sh as object)

With sh

....

.Range("A1") .Value = "abc" 'as an example

End With

End Sub

Not that you call Suba with the shtobj worksheet object, but you can call
the parameter in Suba anything you like (I use sh), but refer in the Suba
code to the parameter name.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"John Coon" wrote in message
...
Hi All,
I need help connecting a open excel file with autocad vba routine.
I'm trying to get a already open excel file and read text from columns
and
have it placed this text into autocad. The excel routine was created to
placed text from excel into autocad with a preset drawing with a grid
block
at a known coordinates. I now want to alter this so the user selects the
block which is the grid block and get the insert point coordintates from
that block. ( I can do this in the first part of routine) & I get the
excel
to work by itself .

Both routines work by themself but I don't see how to get them to work
as
one from autocad. The excel part of the routine places the selected text
in
excel into autocad

I need to pass insertion point of the block in autocad to the x,y start
point in the excel part of the code. how do I wake up the already open
excel
file.

As always, thank you for any comments or direction.
John Coon

'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''I tried
this
but am not sure why it doesn't work. I thought this would connect to a
existing or already open excel file
On Error Resume Next
Set excelapp = GetObject(, "Excel.Application")
If Err < 0 Then
Err.Clear
Set excelapp = CreateObject("Excel.Application")
If Err < 0 Then
MsgBox "Could Not Start Excel", vbExclamation
End
End If
End If
excelapp.Visible = True
Set wbkobj = excelapp.Add
Set shtobj = excelapp.Worksheets(1)





'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''gets
autocad block insertion point. need to pass insertion pnt to excel part
of
routine
Sub getisnsertionpoint()
Dim dbpref As AcadDatabasePreferences
Set dbpref = ActiveDocument.Preferences
Dim currLayer As AcadLayer
Dim layerObj As AcadLayer
Dim mtxtlabel As AcadMText
Dim strText As String
Dim dblHeight As Double
Dim dblWidth As Double
Dim dblRot As Double
Dim txtinsert As Variant
Dim strNorth As String
Dim strEast As String
dblRot = -ThisDrawing.GetVariable("VIEWTWIST")
Set layerObj = ThisDrawing.Layers.Add("C-LITE-TEXT")
layerObj.Color = acYellow
ThisDrawing.ActiveLayer = layerObj

dblWidth = 0
dblRot = -ThisDrawing.GetVariable("VIEWTWIST")

Dim setOBJ As AcadSelectionSet
Dim ftype(0) As Integer
Dim fdata(0) As Variant
Dim f_type As Variant
Dim f_data As Variant
Dim i As Integer
Dim pt As Variant
ftype(0) = 0
fdata(0) = "INSERT"
f_type = ftype
f_data = fdata

Set setOBJ = ThisDrawing.SelectionSets.Add("TEST2")
setOBJ.SelectOnScreen

For i = 0 To setOBJ.Count - 1
pt = setOBJ.Item(i).InsertionPoint

Dim north As String
Dim east As String
strText = "Test"
east = pt(0)
north = pt(1)

strNorthFormat = "#0.0000"
strEastFormat = "#0.0000"


strNorth = Format(north, strNorthFormat)
strEast = Format(east, strEastFormat)

strText = "N: " & (strNorth) & "\P" _
"E: " & (strEast) & "\P" _


Set mtxtlabel = ThisDrawing.ModelSpace.AddMText(pt, dblWidth, strText)
mtxtlabel.Rotation = dblRot

MsgBox " Coords X,Y = " & pt(0) & "," & pt(1)

Next i

setOBJ.Delete

End Sub



'''''''''''''''''''''''''''''''''''''''''''''''''' '''''reads text in
excel
&
sends to autocad
Sub insertfromexcel()
Dim acadApp As Object
Dim insPnt(0 To 2) As Double
Dim textHgt As Double
'Dim x As Double
Dim textObj As Object
Dim newword As String
On Error Resume Next
Set acadApp = GetObject(, "AutoCAD.Application")
If Err Then
Err.Clear
Set acadApp = CreateObject("AutoCAD.Application")
If Err Then
MsgBox Err.Description
Exit Sub
End If
End If
acadApp.Visible = True
acadApp.Top = 0
acadApp.Left = 0
acadApp.Width = 400
acadApp.Height = 600
Dim acadDoc As Object
Set acadDoc = acadApp.activedocument

Dim layerObj As AcadLayer
Set layerObj = acadDoc.Layers.Add("C-GEOM-TEXT")
layerObj.Color = acYellow
acadDoc.ActiveLayer = layerObj

'HIGHLIGHT RANGE
Worksheets("Sheet1").Activate
RowCount = Selection.Rows.Count
Dim y As Double
Dim x As Double
Dim counter As Double

textHgt = 0.12
x = 2.56
y = 20.12
Set moSpace = acadDoc.ModelSpace

For counter = 1 To RowCount
'1 ROW OF TEXT
newword = Worksheets("Sheet1").Cells(counter, 1).Value
insPnt(0) = x
insPnt(1) = y
x = x + 1
Set textObj = moSpace.AddText(newword, insPnt, textHgt)
Set moSpace = acadDoc.ModelSpace
'2 ROW OF TEXT
newword = Worksheets("Sheet1").Cells(counter, 2).Value
insPnt(0) = x + 5.55
insPnt(1) = y
x = x + 1
Set textObj = moSpace.AddText(newword, insPnt, textHgt)
Set moSpace = acadDoc.ModelSpace
'3 ROW OF TEXT
newword = Worksheets("Sheet1").Cells(counter, 3).Value
insPnt(0) = x + 5.55
insPnt(1) = y
x = x + 1
Set textObj = moSpace.AddText(newword, insPnt, textHgt)
Set moSpace = acadDoc.ModelSpace
'4 ROW OF TEXT

newword = Worksheets("Sheet1").Cells(counter, 4).Value
insPnt(0) = x + 5.4
insPnt(1) = y
x = x + 1
Set textObj = moSpace.AddText(newword, insPnt, textHgt)
Set moSpace = acadDoc.ModelSpace

'5 ROW OF TEXT
newword = Worksheets("Sheet1").Cells(counter, 5).Value
insPnt(0) = x + 7
insPnt(1) = y
x = x + 1
Set textObj = moSpace.AddText(newword, insPnt, textHgt)
Set moSpace = acadDoc.ModelSpace

Dim newword1 As String
Dim blockRefObj As Object
newword1 = Worksheets("Sheet1").Cells(counter, 3).Value
insPnt(0) = x
insPnt(1) = y
Dim x1 As Double
Dim y1 As Double
Dim rot As Double
x1 = 1
y1 = 1
rot = 0
Set blockRefObj = moSpace.InsertBlock(insPnt, newword1, x1, y1, rot)
y = y - 0.72
x = 2.56
Next counter
End Sub