Public AcadObj As AcadApplication
Set AcadObj = CreateObject("AutoCAD.Application")
AcadObj.Visible = True
It worked fine on my system. However, after mailing it to the customer, he reported back the following error message:Public AcadObj As AcadApplication
Set AcadObj = CreateObject(Class:="AutoCAD.Application")
AcadObj.Visible = True
Now the customer reported another error message:Public AcadObj As AcadApplication
Set AcadObj = CreateObject("AutoCAD.Application.16.2")
AcadObj.Visible = True
The "16.2" addition should make sure to launch Autocad 2006 full version. However, this attempt put us right back in square 1:Function GetAcadObject(Optional ByVal AcadVersion As Variant) As Object
On Error Resume Next
Set GetAcadObject = GetObject(, "AutoCAD.Application" & AcadVersion)
If Err <> 0 Then
Err.Clear
Set GetAcadObject = CreateObject("AutoCAD.Application" & AcadVersion)
If Err <> 0 Then
MsgBox "Could not load or find AutoCAD.", vbExclamation
End
End If
End If
End Function
Set AC = GetAcadObject(".15")
Set AC = GetAcadObject()
Private Sub cmdLookForOpenAutocad2006FullVersion() 'commandbutton
Dim strMsg As String
strMsg = "Please launch Autocad 2006 full version" & vbCr
strMsg = strMsg & "(first close any other Autocad version)"
On Error Resume Next
Set AcadObj = GetObject(, "AutoCAD.Application.16.2")
If Err Then MsgBox (strMsg): Exit Sub 'Acad 2006 full version not open
'if not error, continue with the sub
Option Explicit
Public AcadObj As AcadApplication
'----------
Private Sub StartAutocad_Click()
'look for Autocad 2006 (full version)
On Error Resume Next
Set AcadObj = GetObject(, "AutoCAD.Application.16.2")
If Err <> 0 Then
Err.Clear
Set AcadObj = CreateObject("AutoCAD.Application.16.2")
If Err <> 0 Then ErrorMessage1: Exit Sub 'Get and Create failed
End If
'Get or Create Acad 2006 (full version?) was successful
Err.Clear: On Error GoTo 0
AcadObj.Visible = True
End Sub
'----------
Private Sub DrawTextstring_Click()
On Error Resume Next
Dim textObj As AcadText
Dim text As String
Dim insPt(0 To 2) As Double
Dim height As Double
' Define the text object
text = ". Test successful ."
insPt(0) = 2: insPt(1) = 2: insPt(2) = 0
height = 0.5
' Create the text object in model space
Set textObj = AcadObj.ActiveDocument.ModelSpace.AddText(text, insPt, height)
AcadObj.ZoomExtents
If Err <> 0 Then ErrorMessage2 'Autocad 2006 LT may have spoiled the fun...
End Sub
'----------
Private Sub Exit_Click()
On Error Resume Next 'just in case button was clicked without Acad loaded
AcadObj.Quit
Unload Me
End Sub
'----------
Private Sub ErrorMessage1()
Err.Clear: On Error GoTo 0
Dim strMsg As String
strMsg = "Can't find or start Autocad 2006 full version." & vbCr
strMsg = strMsg & "Please close all other versions and" & vbCr
strMsg = strMsg & "launch Autocad 2006 full version yourself."
MsgBox (strMsg)
End Sub
'----------
Private Sub ErrorMessage2()
Err.Clear: On Error GoTo 0
Dim strMsg As String
strMsg = "If Autocad 2006 full version has been opened" & vbCr
strMsg = strMsg & "but no text was drawn just now, then" & vbCr
strMsg = strMsg & "maybe Autocad 2006 LT is interfering."
MsgBox (strMsg)
End Sub
Option Explicit
Public AcadObj As Object
'----------
Private Sub StartAutocad_Click()
'look for Autocad 2006 (full version)
On Error Resume Next
Set AcadObj = GetObject(, "AutoCAD.Application.16.2")
If Err <> 0 Then
Err.Clear
Set AcadObj = CreateObject("AutoCAD.Application.16.2")
If Err <> 0 Then ErrorMessage: Exit Sub 'Get and Create failed
End If
'Get or Create Acad 2006 (full version?) was successful
Err.Clear: On Error GoTo 0
AcadObj.Visible = True
End Sub
'----------
Private Sub DrawTextstring_Click()
On Error Resume Next
Dim textObj As Object 'this is a direct reference to the acad object as well
Dim text As String
Dim insPt(0 To 2) As Double
Dim height As Double
' Define the text object
text = ". Test successful ."
insPt(0) = 2: insPt(1) = 2: insPt(2) = 0
height = 0.5
' Create the text object in model space
Set textObj = AcadObj.ActiveDocument.ModelSpace.AddText(text, insPt, height)
AcadObj.ZoomExtents
If Err <> 0 Then ErrorMessage 'Autocad 2006 LT may have spoiled the fun...
End Sub
'----------
Private Sub Exit_Click()
On Error Resume Next 'just in case button was clicked without Acad loaded
AcadObj.Quit
Unload Me
End Sub
'----------
Private Sub ErrorMessage()
Err.Clear: On Error GoTo 0
Dim strMsg As String
strMsg = "Can't find or start Autocad 2006 full version." & vbCr
strMsg = strMsg & "Please close all other versions and" & vbCr
strMsg = strMsg & "launch Autocad 2006 full version yourself."
MsgBox (strMsg)
End Sub
Enough about ethics, let's return to the subject.
Unless your project is tiny, the idea of replacing all autocad object references to object and then working on said project at a later date would be confusing or require having two projects synced. Either way I don't think it's a good idea.I am working on a project that contains collectively 16000 lines of code and over 200 individual files. I always utilize late binding because it makes my program work on multiple versions ... This application is deployed over all versions from R2000 to R2007 without any issues ...
Personally, I have built quite a large autocad dll utility app that I drop into my programs for use. I cannot imagine having to maintain all generic objects in it and totally wiping out my intellisense.
Not to mention there are features added in new compiles that will not work with older versions so knowing the version can be important.
I currently have two dll's one pre 2004 and one 2004 to 2006. I will drop the old one this year and add a new managed one for C#. I have about 1,000 apps deployed and have had no problems with having two versions of the programs provided on the cd's.I currently have one single application that works on multiple versions and I only have a single version to maintain.
Option Explicit
Option Compare Text
Declare Function RegQueryValueEx& Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey&, ByVal lpszValueName$, ByVal lpdwRes&, lpdwType&, ByVal lpDataBuff$, nSize&)
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal hwnd As Long, ByVal lpszOp As _
String, ByVal lpszFile As String, ByVal lpszParams As String, _
ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_CLASSES_ROOT = &H80000000
Const KEY_QUERY_VALUE = &H1&
Const KEY_ENUMERATE_SUB_KEYS = &H8&
Const KEY_NOTIFY = &H10&
Const READ_CONTROL = &H20000
Const STANDARD_RIGHTS_READ = READ_CONTROL
Const KEY_READ = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY
Const SW_SHOWNORMAL = 1
Const SE_ERR_FNF = 2&
Const SE_ERR_PNF = 3&
Const SE_ERR_ACCESSDENIED = 5&
Const SE_ERR_OOM = 8&
Const SE_ERR_DLLNOTFOUND = 32&
Const SE_ERR_SHARE = 26&
Const SE_ERR_ASSOCINCOMPLETE = 27&
Const SE_ERR_DDETIMEOUT = 28&
Const SE_ERR_DDEFAIL = 29&
Const SE_ERR_DDEBUSY = 30&
Const SE_ERR_NOASSOC = 31&
Const ERROR_BAD_FORMAT = 11&
Private Function GetAppPath(subkey As String, sAppEntry As String) As String
Dim s As String * 255, sAppPath As String
Dim lAppKey As Long, lType As Long, lLen As Long, lRC As Long
lLen = Len(s)
lRC = RegOpenKeyEx(HKEY_CLASSES_ROOT, sAppEntry, 0, KEY_READ, lAppKey)
If lRC <> 0 Then Exit Function
lRC = RegQueryValueEx( _
lAppKey, _
subkey, _
0, _
lType, _
s, _
lLen)
's = Left$(s, lLen - 6)
GetAppPath = Mid(s, 2, lLen - 8) 'Left$(s, lLen - 5)
End Function
Function StartDoc(DocName As String, Param As String, Dir As String) As Long
Dim Scr_hDC As Long
Scr_hDC = GetDesktopWindow()
StartDoc = ShellExecute(Scr_hDC, "Open", DocName, _
Param, Dir, SW_SHOWNORMAL)
End Function
Sub Main()
Dim version As String
Dim result As Boolean
Dim sAcadEntry As String
On Error Resume Next
sAcadEntry = "AutoCAD.Drawing.16\shell\open\command"
version = GetAppPath("", sAcadEntry)
If StrConv(version, 1) Like "*ACAD.EXE" <> True Then
MsgBox ("El programa AutoCAD Ver. 2004 no se encuentra instalado. \nPor favor refiérase al Manual del Usuario.")
End
End If
'result = Shell(version & " /b draftteam.scr", 1)
Dim r As Long, msg As String, Dir As String
Dir = App.Path
r = StartDoc(version, " /b draftteam.scr", Dir)
If r <= 32 Then
'There was an error
Select Case r
Case SE_ERR_FNF
msg = "Archivo ejecutable de AutoCAD no encontrado."
Case SE_ERR_PNF
msg = "Ruta de AutoCADno encontrada"
Case SE_ERR_ACCESSDENIED
msg = "Acceso denegado de AutoCAD"
Case SE_ERR_OOM
msg = "Memoria insuficient"
Case SE_ERR_DLLNOTFOUND
msg = "DLL no encontrado"
Case SE_ERR_SHARE
msg = "Error de memoria"
Case SE_ERR_ASSOCINCOMPLETE
msg = "Incompleta o asociación de archivo inválida."
Case SE_ERR_DDETIMEOUT
msg = "DDE finalizó"
Case SE_ERR_DDEFAIL
msg = "Transacción DDE fallida."
Case SE_ERR_DDEBUSY
msg = "DDE ocupado"
Case SE_ERR_NOASSOC
msg = "No hay asociación para extensión de archivo."
Case ERROR_BAD_FORMAT
msg = "Ejecutable inválido."
Case Else
msg = "Error desconocido."
End Select
MsgBox msg
End
End If
'wait 20 seconds to let AutoCAD open
Dim TimeNow As Double
Dim TimeEnd As Double
TimeNow = Hour(Now()) + (Minute(Now()) / 60#) + (Second(Now()) / 3600#)
TimeEnd = TimeNow + (20# / 3600#)
Dim objAcad As Object
Set objAcad = GetObject(, "AutoCAD.Application")
While TimeNow < TimeEnd And (objAcad Is Nothing = True)
Set objAcad = GetObject(, "AutoCAD.Application")
TimeNow = Hour(Now()) + (Minute(Now()) / 60#) + (Second(Now()) / 3600#)
Wend
Dim preferences As Object
Set preferences = objAcad.preferences
Dim sPath As String
sPath = preferences.Files.SupportPath
If sPath <> "" Then
Dim DttPath As String
DttPath = objAcad.ActiveDocument.GetVariable("DWGPREFIX")
Dim LDttPath As Integer
LDttPath = Len(DttPath)
If Right(DttPath, 1) = "\" Then
DttPath = Left(DttPath, LDttPath - 1)
End If
'Add the path if does not exist
If StrConv(sPath, 1) Like "*" & StrConv(DttPath, 1) & "*" <> True Then
preferences.Files.SupportPath = sPath & ";" & DttPath
End If
End If
Set objAcad = Nothing
Set preferences = Nothing
End Sub
Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal x As Long, ByVal y As Long, _
ByVal cx As Long, ByVal cy As Long, _
ByVal wFlags As Long) As Long
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Could that cause the problem?But that's exactly my point: Acad 16.2 IS installed.