Launch AutoCAD and Create a Search File Path

[Anonymous]

' Hi,
' I did the below bit and pieces code to launch AutoCAD from my exe and also
' to create a new Search File Path from where I launched folder, but only
works if I have AutoCAD already opened
' not from scratch (from the exe) it always create the path from:
\windows\system32
' can someone test this is for Visual Basic, thanks Luis E.

Option Explicit

Public objAcad As AcadApplication
Public ThisDrawing As AcadDocument
Sub main()

Dim AcadRunning As Boolean

On Error GoTo Err_Control

AcadRunning = IsAutoCADOpen()

If AcadRunning Then
Set objAcad = GetObject(, "AutoCAD.Application")
Else
Set objAcad = CreateObject("AutoCAD.Application")
End If

' starting code to create the Search File Path

Dim preferences As Object

Set preferences = objAcad.preferences

Dim SPath As String

SPath = preferences.Files.SupportPath

Dim addPath As String

addPath = objAcad.ActiveDocument.GetVariable("DWGPREFIX")

' just testing to show what path is added
MsgBox ("New path: " & addPath)

Dim lengthPath As Integer

lengthPath = Len(addPath)
If Right(addPath, 1) = "\" Then
addPath = Left(addPath, lengthPath - 1)
End If

' add our folder where we have installed our application
' or from where AutoCAD is opened
If StrConv(SPath, 1) Like "*" & addPath & "*" <> True Then
preferences.Files.SupportPath = SPath & ";" & addPath
End If

objAcad.Visible = True

Set ThisDrawing = objAcad.ActiveDocument

Exit_Here:
Exit Sub
Err_Control:
MsgBox Err.Description
Resume Exit_Here
End Sub

Function IsAutoCADOpen() As Boolean
On Error Resume Next
Set objAcad = GetObject(, "AutoCAD.Application")
IsAutoCADOpen = (Err.Number = 0)
Set objAcad = Nothing
Err.Clear
End Function

[Anonymous]

Luis,

Here's your answer.

Joe
--

  On Error Resume Next

  'open AutoCAD

  Set objAcad = GetObject(, "AutoCAD.Application")

  

  If Err Then

    Err.Clear

    Set objAcad = CreateObject("AutoCAD.Application")

    If Err Then

      MsgBox "Could not start AutoCAD!", vbCritical, "Error - AutoCAD not found"

      'unload application form

      Unload Me

      'exit the application

      Exit Sub

    End If

  End If

  

'starting code to create the Search File Path

Dim oPreferences As AcadPreferences

Dim SPath As String

Dim addPath As String

Dim lengthPath As Integer



  Set oPreferences = objAcad.preferences

  SPath = oPreferences.Files.SupportPath

  addPath = objAcad.ActiveDocument.GetVariable("DWGPREFIX")



  'just testing to show what path is added

  MsgBox ("New path: " & addPath)



  lengthPath = Len(addPath)



  If Right(addPath, 1) = "\" Then

    addPath = Left(addPath, lengthPath - 1)

  End If



  'add our folder where we have installed our application

  'or from where AutoCAD is opened

  If StrConv(SPath, 1) Like "*" & addPath & "*" <> True Then

    preferences.Files.SupportPath = SPath & ";" & addPath

  End If

  

  'make AutoCAD visible

  objAcad.Visible = True

[Anonymous]

Scrap the IsAutoCADOpen() function.

Joe
--

[Anonymous]

Thank Joe,

But it does the same as my previous code, I will keep testing.

---
luis

[Anonymous]

Luis,

It worked prefectly for him so maybe I'm missing something. Perhaps more explanation would help.

Joe
--

[Anonymous]

"joesu" wrote in message
news:f14b867.1@WebX.maYIadrTaRb...
Scrap the IsAutoCADOpen() function.
Joe
--

Here is my previous code that I want it to update for AutoCAD 15, can you
tested please (is not working...):

What I want to do is to launch autocad from my exe and create a support path
from where I have my exe.

thank you,
----
luis

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

Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_CLASSES_ROOT = &H80000001
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
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)
GetAppPath = Left$(s, lLen - 1)
End Function

Sub Main()
Dim Acaddir As String
Dim version As String
Dim result As Boolean
Dim sAcadEntry As String

On Error Resume Next

sAcadEntry = "AutoCAD.Drawing.15\shell\open\command"
version = GetAppPath("command", sAcadEntry)
Acaddir = GetAppPath("AcadLocation", sAcadEntry & "\" & version)
If StrConv(Dir(Acaddir & "\ACAD.EXE"), 1) Like "ACAD.EXE" <> True Then
MsgBox ("AutoCAD Ver. 15 not installed. Please refer to User Manual.")
End
End If
result = Shell(Acaddir & "\acad.exe /b myapp.scr", 1)

'Wait 20 second to let AutoCAD open
Dim TimeNow As Double
Dim TimeEnd As Double
TimeNow = Hour(Now()) + (Minute(Now()) / 60#) + (Second(Now()) / 3600#)
TimeEnd = TimeNow + (180# / 3600#)
While TimeNow < TimeEnd And result <> True
TimeNow = Hour(Now()) + (Minute(Now()) / 60#) + (Second(Now()) /
3600#)
Wend

If result <> True Then
MsgBox ("Cannot open AutoCAD 15.0")
End
End If
Dim acadApp As Object
Set acadApp = GetObject(, "AutoCAD.Application")
Dim preferences As Object
Set preferences = acadApp.preferences.Files
Dim SPath As String
SPath = preferences.Files.SupportPath
Dim newPath As String
newPath = acadApp.ActiveDocument.GetVariable("DWGPREFIX")
Dim LnewPath As Integer
LnewPath = Len(newPath)
If Right(newPath, 1) = "\" Then
newPath = Left(newPath, LnewPath - 1)
End If
'Add our folder where we are installed our application
If StrConv(SPath, 1) Like "*" & newPath & "*" <> True Then
preferences.Files.SupportPath = SPath & ";" & newPath
End If
Set acadApp = Nothing
Set preferences = Nothing

End Sub

[Anonymous]

using Luis's first code I am getting an error, that described as "Call was
rejected by callee."
I am working with Acad2002 and VB.NET
Do you have some suggestions?