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:
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)
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