LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 9
Default 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



 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
ON OPEN VBA Code input incorrectly now excel sheet wont open mmartin New Users to Excel 1 February 16th 11 11:33 PM
Creating Macros to connect 2 different excel sheet Trups Excel Discussion (Misc queries) 2 August 9th 07 04:54 AM
why, when i open a work sheet does a blank sheet open as well John Excel Discussion (Misc queries) 2 July 7th 07 06:20 PM
When I open Excel I want it to open on Sheet 1 traveye Excel Discussion (Misc queries) 7 January 24th 07 12:03 AM
excel - macro code to open a protected sheet, enter passowrd, and then protect sheet arunjoshi[_5_] Excel Programming 1 May 2nd 04 03:50 PM


All times are GMT +1. The time now is 06:32 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"