Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
ON OPEN VBA Code input incorrectly now excel sheet wont open | New Users to Excel | |||
Creating Macros to connect 2 different excel sheet | Excel Discussion (Misc queries) | |||
why, when i open a work sheet does a blank sheet open as well | Excel Discussion (Misc queries) | |||
When I open Excel I want it to open on Sheet 1 | Excel Discussion (Misc queries) | |||
excel - macro code to open a protected sheet, enter passowrd, and then protect sheet | Excel Programming |