Author Topic: ACAD 2018 and ObjectDBX conundrum?  (Read 7584 times)

0 Members and 1 Guest are viewing this topic.

Yosso

  • Newt
  • Posts: 36
ACAD 2018 and ObjectDBX conundrum?
« on: April 04, 2018, 08:24:10 AM »
Using some ancient code to try to create tables in ACAD 2018 from Excel worksheets.

Everything proceeds without a hitch, until I attempt to create a line and the error message "Invalid procedure call or argument"

oDBxDoc.PaperSpace.AddLine sp, ep

The oDbxDoc is created and shows that it is a valid AxDbDocument in the Watch window.

The code was working (I think) before the stripped the AutoCAD 2017 my PC...but this project has been on going for several months and my memory is getting poor.

My test module:

Code: [Select]
Sub ACADCreateDwg()

On Error GoTo ErrorHandler

' Testing Variables
Dim oDBx As cObjDbx
Dim oDBxDoc As AxDbDocument ' Object ' Late binding!

Dim OpenName As String
Dim SaveName As String

Dim sp(0 To 2) As Single
Dim ep(0 To 2) As Single

Set oDBx = New cObjDbx

sp(0) = 0#: sp(1) = 0#: sp(2) = 0#
ep(0) = 34#: ep(1) = 23#: ep(2) = 0#

OpenName = "D:\Dropbox\AMCE Work Folders\Substation Spreadsheets\Sag-Tension Workbook\XML OUTPUT FROM PLS-CADD\Sag_Tables.dwt"
SaveName = "TEST"

' Open the template file
oDBx.xOpen OpenName

' Cast the Doc property object as an AxDbDocument Ojbect
Set oDBxDoc = oDBx.Doc

' Add a line
oDBxDoc.PaperSpace.AddLine sp, ep

oDBx.xSaveAs oDBx.OrigPath, "Copy of ", "1"

oDBx.xClose

'There 's no New method on an AxDbDocument.
'
'If you want to create a new document that's derived
'from a template, just open the template (DWT) file
'in the AxDbDocument, and when you've done what you
'need, save it as a .DWG file.

Exit Sub

ErrorHandler:

Debug.Print Err.Description

Stop
oDBx.xClose




Class Module from Ed Jobe (circa 2006)

Code: [Select]
Option Explicit

'=================================================================================================
' Purpose   : Create an object class for access Autocad via the ObjectDBX
'
' Date      : 01/19/18
' Updated   :
'=================================================================================================
' Need code to differentiate the various versions of ACAD?
' 2018-01-19
' Replaced AXDBLib with AXDBLib
'=================================================================================================
' References Requires
' AutoCAD    C:\Program Files\Common Files\Autodesk Shared\acax22enu.tlb
' AXDBLib    C:\Program Files\Common Files\Autodesk Shared\axdb22enu.tlb
' Scripting  C:\Windows\SysWOW64\scrrun.dll
'=================================================================================================

'copyright 2006, Ed Jobe
' Note: This requires ObjectDBX to be registered on each
' user's machine. This is done automatically on 2004 and up.
' In your AutoCAD folder, locate the file AxDb15.dll.
' This only needs to be done once at each machine. If you are using vb instead
' of vba, you will also need to set a reference to "ObjectDBX 1.0 Type library"
' and "Microsoft Scripting Runtime".

' This class auto-registers the dll, but here is the normal procedure---
' From the dos command line, type:
' C:\> cd Autodesk\Map200i
' C:\Autodesk\Map2000i> RegSvr32.exe AxDb15.dll

'This class unfortunately doesn't follow standards for objects due to the fact that
'I was unable to Implement the properties/methods of ObjectDbx. Normally, the Open,
'Close, Save and SaveAs methods would belong in the doc class. But since you can't use
'the Implements statement on ObjectDbx, I had to move them to this class. This class
'uses late binding to be able to handle versioning. In order to access all the
'methods/properties of an AxDbDocument in your project, you must Dim a variable as
' type AxDbDocument and then the object returned by the Doc property to cast it as
' an AxDbDocument object. Therefore, this class does not reference AxDb15.dll, so
'your project needs to.

'Last error number used: 1003

'Variable declarations for Properties
Private oDoc As AxDbDocument ' Object
Private strOrigPath As String
Private strTempPath As String
Private strExt As String
Private bReadOnly As Boolean

'Property Declarations
'*********************

Public Property Get Doc() As Object
    Set Doc = oDoc
End Property

Public Property Get Ext() As String
    Ext = strExt
End Property

Public Property Get OrigPath() As String
    OrigPath = strOrigPath
End Property

Public Property Get TempPath() As String
    TempPath = strTempPath
End Property
Public Property Get ReadOnly() As Boolean
    ReadOnly = bReadOnly
End Property

'Class Methods
'*************
Public Sub xClose()
    'required for proper cleanup of temp files
    Set oDoc = Nothing
End Sub

Private Function acadVerNum() As String
    Dim verNum As String
    verNum = "HKEY_CLASSES_ROOT\AutoCAD.Drawing\CurVer\"
   
    Dim wsh As Object
    ' Error trapping
    On Error GoTo ErrorHandler
   
    'access Windows scripting
    Set wsh = CreateObject("WScript.Shell")
   
    'read key from registry
    Dim resKey As String
    resKey = wsh.RegRead(verNum)
     
    acadVerNum = Right(resKey, 2)
   
    Set wsh = Nothing
    Exit Function
   
ErrorHandler:
    acadVerNum = ""
    Set wsh = Nothing
   
End Function

Public Sub xOpen(FilePath As String)
    'Sets the Doc property to an ObjectDBX Document
    'late binding is used to avoid setting a reference.
    '
    On Error GoTo ErrHandler
   
    Dim dbxdoc As AxDbDocument 'Object
    Dim strTempName As String
    Dim fso As Scripting.FileSystemObject
    Dim fsoFile As Scripting.File
    Dim colPCs As AcadPlotConfigurations
    Dim objPC As AcadPlotConfiguration
    Dim varList As Variant
    Dim i As Integer
    Dim cnt As Integer
    Dim iActiveLayout As Integer
    Dim strObjDbxPath As String
    Dim ACAD As Object
       
    bReadOnly = False
    strOrigPath = FilePath
   
    Set fso = CreateObject("Scripting.FileSystemObject")
   
Cleanup:
    'if this is not the first time a doc was opened, then
    'there may be a temp file left. Clean it up!
    If fso.FileExists(strTempPath) Then
        fso.DeleteFile (strTempPath)
        strTempPath = ""
    End If
    'check for dwt, ObjectDbx can only open dwg's
    strExt = fso.GetExtensionName(FilePath)
    'Calling sub can check the Ext property. If it equals "dwt", then
    'a temp file was created at the location stored in the TempPath property.
SetDbxDoc:
    ' MSJ - added a function to obtain the acad version number
    ' 4/4/18
    ' Trying a "trick" get dbxdoc set correct.
    ' https://www.theswamp.org/index.php?topic=15028.0
    ' Set dbxdoc = New AxDbDocument
   
    Select Case acadVerNum ' Left(ThisDrawing.GetVariable("ACADVER"), 2)
    Case Is = "22"
        Set dbxdoc = AcadApplication.GetInterfaceObject("ObjectDBX.AxDbDocument.22")
    Case Is = "21"
        Set dbxdoc = AcadApplication.GetInterfaceObject("ObjectDBX.AxDbDocument.21")
    Case Else
        ' Unable to find ACAD version
         MsgBox "Unable to extract AutoCAD version!!!", vbCritical, "ERROR"
        GoTo ErrHandler
        'Set dbxdoc = AcadApplication.GetInterfaceObject("ObjectDBX.AxDbDocument.19")
    End Select
    If strExt = "dwt" Then
        Err.Raise vbObjectError + 1001
    End If
    dbxdoc.Open FilePath
    Set oDoc = dbxdoc
   
    Set dbxdoc = Nothing
    Set fso = Nothing
    Exit Sub
   
ErrHandler:
    Select Case Err.Number
    Case Is = -2147221005
        'register dll
        'STOP
        strObjDbxPath = "regsvr32 " & AcadApplication.Path & "\axdb22.dll"
        Shell (strObjDbxPath)
        Err.Clear
        GoTo SetDbxDoc
    Case Is = vbObjectError + 1001, 70, -2147467259
        'vbObjectError + 1001 = filetype is *.dwt
        '70 = file access permission denied
        '-2147467259 = Method 'Open' of object 'IAxDbDocument' failed
        'Plan for occasion where the file is already open by
        'another user. This is necessary because ObjectDBX
        'does not support a ReadOnly argument for the Open method.
        'The calling sub can check the ReadOnly property. If True, then
        'then you can clean up by deleting the temp file when done. ObjectDBX also
        'does not open dwt files. If the Ext property equals "dwt", you may need to clean up.
        'I try do do it for you at CleanUp: and Class.Terminate.
        'If there are no errors, the TempPath property will = "", vbNullString.
       
        ' TODO - 2018-01-22 - ADD TEST TO SEE IF ACAD IS OPEN!
               
        ' 4/4/18 = ACAD does not work with AutoCAD 2018
        ' strTempName = ACAD.Application.Preferences.Files.TempFilePath & fso.GetBaseName(FilePath) & ".dwg"
         strTempName = autocad.Application.Preferences.Files.TempFilePath & fso.GetBaseName(FilePath) & ".dwg"
       
        fso.CopyFile FilePath, strTempName, True 'overwrite without prompting
        SetAttr strTempName, vbNormal
        FilePath = strTempName
        dbxdoc.Open FilePath
        strTempPath = strTempName
        bReadOnly = True
        Set oDoc = dbxdoc
        Set dbxdoc = Nothing
        Set fso = Nothing
    Case Else
        MsgBox Err.Number & ": " & Err.Description, vbCritical, "ObjDbx.xOpen"
    End Select
End Sub

Public Sub xSave()
    'Save the currently open oDoc
    'Replaces the AxDbDocument's Save method
    On Error GoTo ErrHandler
   
    If oDoc Is Nothing Then
        Err.Raise vbObjectError + 1002, , "Method failed. There is no document to save."
    End If
   
    'Use the SaveAs method, since Save "doesn't work"
    oDoc.SaveAs strOrigPath
    Exit Sub
   
ErrHandler:
    Select Case Err.Number
    Case Is = vbObjectError + 1002
        MsgBox Err.Number & ": " & Err.Description, vbCritical, "ObjDbx.xSave"
    Case Else
        MsgBox Err.Number & ": " & Err.Description, vbCritical, "ObjDbx.xSave"
    End Select
   
End Sub

Public Sub xSaveAs(FilePath As String, Optional Prefix As String, Optional Suffix As String)
    'SaveAs the currently open oDoc
    'For flexibility only, since oDoc inherits the AxDbDocument's methods.
    'Also, I added some optional arguments.
    On Error GoTo ErrHandler
   
    Dim fso As Scripting.FileSystemObject
    Dim strFile As String
   
    If oDoc Is Nothing Then
        Err.Raise vbObjectError + 1003, , "Method failed. There is no document to save."
    End If
    Set fso = CreateObject("Scripting.FileSystemObject")
    strFile = fso.GetParentFolderName(FilePath) & "\" & Prefix & _
              fso.GetBaseName(FilePath) & Suffix & "." & fso.GetExtensionName(FilePath)
    oDoc.SaveAs strFile
    Set fso = Nothing
    Exit Sub
   
ErrHandler:
    Select Case Err.Number
    Case Is = vbObjectError + 1002
        MsgBox Err.Number & ": " & Err.Description, vbCritical, "ObjDbx.xSaveAs"
    Case Else
        MsgBox Err.Number & ": " & Err.Description, vbCritical, "ObjDbx.xSaveAs"
    End Select
   
End Sub

Private Sub Class_Terminate()
    Dim fso As Scripting.FileSystemObject
   
    'Make sure that the doc object doesn't
    'have a hold on the temp file.
    'Close the doc without saving changes.
    Set oDoc = Nothing
    'Cleanup temp file if it exists.
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FileExists(strTempPath) Then fso.DeleteFile (strTempPath)
    Set fso = Nothing

End Sub




DeeGeeCees_V.2.0

  • Newt
  • Posts: 154

n.yuan

  • Bull Frog
  • Posts: 348
Re: ACAD 2018 and ObjectDBX conundrum?
« Reply #2 on: April 04, 2018, 10:03:36 AM »
Well, it works for me with following code (AutoCAD2018, actually, AutoCAD Civil3D 2018):

Code: [Select]
Option Explicit

Public Sub DbxTest()

    Dim fileName As String
    fileName = "D:\Temp\SideDbTest.dwg"
   
    Dim doc As AXDBLib.AxDbDocument
   
    Dim sp(0 To 2) As Double
    Dim ep(0 To 2) As Double
   
    sp(0) = 0#: sp(1) = 0#: sp(2) = 0#
    ep(0) = 100#: ep(1) = 100#: ep(2) = 0#
   
    Set doc = ThisDrawing.Application.GetInterfaceObject("ObjectDBX.AxDbDocument.22")
    doc.Open fileName
   
    On Error Resume Next
   
    doc.PaperSpace.AddLine sp, ep
   
    If Err.Number <> 0 Then
        MsgBox "Updated failed: " & Err.Description
    Else
        MsgBox "Updated"
    End If
   
    doc.SaveAs fileName
   
End Sub

However, I'd avoid to add entities into PaperSpace with ObjectDBX, because if the drawing have multiple layouts (very likely), you are not sure which layout is the PaperSpace at the moment when AxDbDocument is opened. Usually, it is the last Layout that is active when the drawing is opened in AutoCAD and saved, but you have no way to know that when using ObjectDBX to work with the drawing.

So, if working with ObjectDBX document, rather than using AxDbDocument.PaperSpace, I'd use AxDbDocument.Layouts([specific layout index]).Block to add entities, so that you always certain the entities are added to specific layout.

I am not sure why you get that error, though, because there should be always at least 1 layout existing per drawing. You could try this to see if the drawing has at least 1 layout or not:

If doc.Layouts.Count>0 Then
   doc.PaperSpace.AddLine...
   '' Or
   '' doc.Layout(0).Block.AddLine ....
Else
   Msgbox "There is no layout in drawing. Cannot add line to PaperSpace!"
End If

Yosso

  • Newt
  • Posts: 36
Re: ACAD 2018 and ObjectDBX conundrum?
« Reply #3 on: April 04, 2018, 10:16:51 AM »
@DeeGeeCees_V.2.0 I've got the VBA enabler installed...I think....let me check. Yep, it's installed.

@n.yuan.  Seems like my class code is not working correctly, might be best to just keep it simple. 

Thank you all, for the feedback and advice.

M.


Gandxsla

  • Guest
Re: ACAD 2018 and ObjectDBX conundrum?
« Reply #4 on: September 11, 2018, 05:24:37 AM »
I am very pleased to be a member here. In order for me to access the data fully.