get already open excel file

[jcoon]

I'm trying to get a already open excel file and read text from columns and have it placed into autocad. The excel routine was created to placed text from excel in autocad with a preset drawing with a grid block. I now want to make it so the user selects the block which is the grid block and get the insert point from that. both routines work by themself but I don't see how to get them to work as one from 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

' gets insertion point of slected block
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



''''''''''''''need to get info from a already open excel file
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

[inner69923]

i use this code in a vb6 dll

Public Function ConnectExcel(x As Variant) As Object
Dim ExcelServerdll As Object

On Error Resume Next

Err.Clear
Set ExcelServerdll = GetObject(, "Excel.Application") '<--already open excel file
If Err.Number = 0 Then
GoTo FINISH
End If
Err.Clear
Set ExcelServerdll = CreateObject("Excel.Application")
If Err.Number = 0 Then
GoTo FINISH
End If

MsgBox "No tienes instalada ninguna version de Excel compatible con esta Macro", vbCritical, "Error"
Exit Function

FINISH:

ExcelServerdll.WindowState = -4140 ' xlMinimizado
ExcelServerdll.Visible = True ' lo hace visible
Set ConnectExcel = ExcelServerdll
Set ExcelServerdll = Nothing
End Function
-------------------

Public VB6DLL As Object
Public xExcel As Object
Public objWorksheet As Object, objWorkBook As Object

Public Sub .........
On Error GoTo NoExcel

Set VB6DLL = GetInterfaceObject("External.ExternalClass1")
Set xExcel = VB6DLL.ConnectExcel(1)
If xExcel Is Nothing Then
GoTo exithere
End If

Set objWorksheet = xExcel.ActiveWorkbook.Worksheets(1)
On Error GoTo ErrControl
............
............
vertlist(0) = objWorksheet.Cells(Ntemp, 1).Value
...........
...........
NoExcel:
MsgBox "No hay abierta ninguna hoja de Excel o no esta activada. Si es el ultimo caso, debes activar la hoja donde estan los datos antes de ejecutar esta operacion.", vbOKOnly, "Aviso"
Resume exithere

End Sub

[jcoon]

inner,

Thank you for comments. I'll update my routine and is if your supplied data will fix my problem.

Thank you, Have a great day.
John coon