ACAD 2018和ObjectDBX难题？

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