ACAD 2018 和 ObjectDBX 难题？
使用一些古老的代码尝试从Excel工作表中创建2018年ACAD奥运会的表格。一切顺利进行，直到我试图创建一行并显示错误消息“Invalid procedure call or argument”
oDBxDoc。将创建oDbxDoc，并在“监视”窗口中显示它是有效的AxDbDocument。
在剥离AutoCAD 2017我的电脑之前，代码是有效的(我认为)...但是这个项目已经进行了几个月，我的记忆力越来越差。
我的测试模块代码0]
来自Ed Jobe(大约2006年)的类模块
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
' ScriptingC:\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
**** Hidden Message ***** 我相信您需要在新安装中加载VBA启用码：
https://knowledge.autodesk.com/support/autocad/downloads/caas/downloads/content/download-the-microsoft-visual-basic-for-applications-module-vba.html 嗯，它对我来说适用于以下代码(AutoCAD2018，实际上是AutoCAD Civil3D 2018):
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.Number0 Then
MsgBox "Updated failed: " & Err.Description
Else
MsgBox "Updated"
End If
doc.SaveAs fileName
End Sub
但是，我会避免使用ObjectDBX将实体添加到PaperSpace，因为如果绘图有多种布局(很有可能)，在打开AxDbDocument时，您无法确定哪种布局是PaperSpace。通常，在AutoCAD中打开图形并保存时，它是最后一个激活的布局，但是在使用ObjectDBX处理图形时，您无法知道这一点。
所以，如果使用ObjectDBX文档，而不是使用AxDbDocument。PaperSpace，我会用AxDbDocument。布局([特定布局索引])。块来添加实体，以便您总是确定这些实体被添加到了特定的布局中。
但是，我不确定为什么会出现该错误，因为每个绘图至少应该有一个布局。您可以尝试这样做来查看图形是否至少有一个布局:
If doc。Layouts.Count>0，然后
doc。图纸空间. AddLine...“”或“
”文档。布局(0).Block.AddLine....
Else
Msgbox "绘图中没有布局。无法向图纸空间添加行！
结束条件 我很高兴成为这里的一员。为了让我能完全访问数据。
页:
[1]