Thread: Run code with AcadOle object

Hi everyone,

I got help from cadtutor.net where someone posted the code for a short program that is useful to me. One part, however does not work but it apparently works on their computers. I think it has something to do with References.

Public Sub ExportDims()
 Dim oEnt As AcadEntity
 Dim oDim As AcadDimRotated
 Dim oOle As AcadOle
 Dim mea1 As Double
 Dim mea2 As Double
 Dim pickPt As Variant

When I run it, I get a User-defined type not defined and the AcadOle line is selected and the Public Sub ExportDims() is highlighted in yellow.

I have added the following references with no success:

Microsoft DAO 3.6 Object Library
Microsoft OLE DB Error Libarary
oleprn 1.0 Type Library
Microsoft ActiveX Data Objects 2.7 Library
OLE Automation

This is the full code if anyone needs the big picture.

'' require reference to Microsoft Excel XX.X Object Library
Option Explicit
Public Declare Function GetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public Type OPENFILENAME
  lStructSize As Long
  hwndOwner As Long
  hInstance As Long
  lpstrFilter As String
  lpstrCustomFilter As String
  nMaxCustFilter As Long
  nFilterIndex As Long
  lpstrFile As String
  nMaxFile As Long
  lpstrFileTitle As String
  nMaxFileTitle As Long
  lpstrInitialDir As String
  lpstrTitle As String
  flags As Long
  nFileOffset As Integer
  nFileExtension As Integer
  lpstrDefExt As String
  lCustData As Long
  lpfnHook As Long
  lpTemplateName As String
End Type
'@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@
' Display and use the File open dialog
'@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@
Public Function ShowOpen() As String
  Dim strTemp As String
  Dim VertName As OPENFILENAME
  VertName.lStructSize = Len(VertName)
  VertName.hwndOwner = ThisDrawing.HWND
  VertName.lpstrFilter = "All Excel Files (*.xls)" + Chr$(0) + _
                         "*.xls" + Chr$(0) + " | " + "Excel Files (*.xlsx)" + Chr$(0) + _
                         "*.xlsx"
  VertName.lpstrFile = Space$(254)
  VertName.nMaxFile = 255
  VertName.lpstrFileTitle = Space$(254)
  VertName.nMaxFileTitle = 255
  VertName.lpstrInitialDir = CurDir
  VertName.lpstrTitle = "Select Excel File"
  VertName.flags = 0
  If GetOpenFileName(VertName) Then
    strTemp = (Trim(VertName.lpstrFile))
    ShowOpen = Mid(strTemp, 1, Len(strTemp) - 1)
  End If
End Function
'' Modified 10/8/03 to remove early binding and
'' include late binding. Now should work with
'' any version Excel
 
Function IsExcelRunning() As Boolean
    Dim objXL As Object
    On Error Resume Next
    Set objXL = GetObject(, "Excel.Application")
    IsExcelRunning = (Err.Number = 0)
    Set objXL = Nothing
    Err.Clear
End Function
'' based on macros written by Jeff Mishler
'Changed the way Excel is loaded per suggestion by
'Randall Rath - http://www.vbdesign.net/
'which also added the "Function IsExcelRunning"
Public Sub ExportDims()
 Dim oEnt As AcadEntity
 Dim oDim As AcadDimRotated
 Dim oOle As AcadOle
 Dim mea1 As Double
 Dim mea2 As Double
 Dim pickPt As Variant
 
 ThisDrawing.Utility.GetEntity oEnt, pickPt, vbCrLf & "Select length dimension >> "
    If Not TypeOf oEnt Is AcadDimension Then Exit Sub
    Set oDim = oEnt
    mea1 = oDim.Measurement
 
     ThisDrawing.Utility.GetEntity oEnt, pickPt, vbCrLf & "Select width dimension >> "
    If Not TypeOf oEnt Is AcadDimension Then Exit Sub
    Set oDim = oEnt
    mea2 = oDim.Measurement
 
    ThisDrawing.Utility.GetEntity oEnt, pickPt, vbCrLf & "Select embedded table >> "
    If Not TypeOf oEnt Is AcadOle Then Exit Sub
    Set oOle = oEnt
 
    Dim xlFileName As String
 
    '***Begin code from Randall Rath******
    Dim oXL As Object
    Dim blnXLRunning As Boolean
    blnXLRunning = IsExcelRunning()
    If blnXLRunning Then
        Set oXL = GetObject(, "Excel.Application")
    Else
        Set oXL = CreateObject("Excel.Application")
        oXL.Visible = False
        oXL.UserControl = False
        oXL.DisplayAlerts = False
    End If
    '***End code from Randall Rath******
 
    Dim oWb As Object
    Dim oWs As Object
    xlFileName = ShowOpen()
    Set oWb = oXL.Workbooks.Open(xlFileName)
    If oWb Is Nothing Then
        MsgBox "The Excel file " & xlFileName & " not found" & _
               "Try again."
        GoTo Exit_Here
    End If
    Set oWs = oWb.Worksheets("Sheet1")
    oWs.Activate
 
    ' write data to Excel
 
    oWs.Columns(1).NumberFormat = "@"
    oWs.Columns(2).NumberFormat = "0.00"
    oWs.Columns(3).NumberFormat = "0.00"
    oWs.Cells(2, 1) = "-001"
    oWs.Cells(2, 2) = mea1
    oWs.Cells(2, 3) = mea2
 
    oWs.Columns.AutoFit
Exit_Here:
    Set oWs = Nothing
    oWb.Save: oWb.Close
    Set oWb = Nothing
    oXL.Quit
    Set oXL = Nothing
DoEvents
    MsgBox "Done"
 
End Sub

You need the library for whatever CAD system you're trying to automate -- AutoCAD?

If you are running it within AutoCAD then I would not expect you to need a reference set for that, since it looks to be a native AutoCAD type. It may just be that it requires a later version than you have.
PS Per that code, you will also need to set a reference to Excel!

Do you not have Excel listed under Tools-References in your VBEditor (I don't know AutoCAD at all, so I'm assuming the environment is the same!)

Unless you already have Excel open, the application is opened invisibly and the workbook is opened and populated. Have you checked the workbook?

Okay change of plan,

DB connect is to heavy, because it reads of the jet database the solution is more complicated than it is worth

Try this.

1/. With your Excel worksheet create a named range that represents your table.
Format the columns etc.

2/. With AutoCAD

Insert > Ole Object > Microsoft Excel Worksheet > Create from file > Select file > check automatic update.(could be Microsoft Excel 2003 or some thing like that in 2002).

3/. With AutoCAD, Insert this code in a new module, (careful it goes with ThisDrawing, not Project Global.)

Option Explicit
 
Const strExcelFileName As String = "C:\My Documents\AcadTest\Sample1.xls"
Const strExcelSheetName As String = "Sheet1"

Public Sub ExportDims()
    Dim objEnt As AcadEntity
    Dim objDim As AcadDimRotated
    Dim mea1 As Double
    Dim mea2 As Double
    Dim pickPt As Variant
    Dim objExcel As Object, objWorkbook As Object, objWorksheet As Object
    
    'Check for Linked file, exit if missing.
    If Dir(strExcelFileName) = "" Then
        MsgBox strExcelFileName & Chr(13) & Chr(13) & "Cannot be found.", _
               vbCritical + vbOKOnly, "Linked File Missing."
        Exit Sub
    End If
    
On Error GoTo FirstDim
FirstDim:
    ThisDrawing.Utility.GetEntity objEnt, pickPt, vbCrLf & "Select length dimension >> "
    If Not TypeOf objEnt Is AcadDimension Then GoTo FirstDim
    Set objDim = objEnt
    mea1 = objDim.Measurement
    
On Error GoTo NextDim
NextDim:
    ThisDrawing.Utility.GetEntity objEnt, pickPt, vbCrLf & "Select width dimension >> "
    If Not TypeOf objEnt Is AcadDimension Then GoTo NextDim
    Set objDim = objEnt
    mea2 = objDim.Measurement
    
On Error GoTo 0
    Set objExcel = GetObject(, "Excel.Application")
    
    Set objWorkbook = objExcel.Workbooks.Open(strExcelFileName)
    
    Set objWorksheet = objWorkbook.Worksheets("Sheet1")
    
    ' write data to Excel
    With objWorksheet
        .Cells(2, 2) = mea1
        .Cells(2, 3) = mea2
        .Columns.AutoFit
    End With
    
    'Save changes
    ThisDrawing.Save
    With objWorkbook
        .Save
        .Close
    End With
    
    'Clean up
    Set objWorksheet = Nothing
    Set objWorkbook = Nothing
    
    objExcel.Quit
    Set objExcel = Nothing
    
    'Call Dialogue box to update links,
    'this wiil have to be done manually until I can
    'remember how to get a handle on embedded objects.
    'It is buried deep in early versions of VbaAutoCAD
    Rem: Select the link > Update Now > Close
    ThisDrawing.SendCommand "_olelinks" & vbCr
    
End Sub

Change the constants to suit your file names.

This will not allow you to procede until the two dims have been selected, the solution you had fails if a wrong entity is selected.

The embeded table does not update in AutoCad until the DWG is saved, closed and reopened. This is standard on these earlier editions.

This is why I have forced a manual link update.
I just cannot remember how to finish this off, but try it as it is and I'll dig a bit deeper into my old files for the final solution.
Might even have to call on AutoLisp for the first time in umpteen years!!!!

Caution if you double click on the embedded table before it is updated it will overwrite your changes in excel. It's not the friendliest of tools to use.

I Have run this in both 2000 and 2005 so it should be okay in 2002, let me know of any bugs you find.

Hope this helps, at least temporarily.

Alistair