Author Topic: Setting AutoCAD Paths with a VBScript  (Read 5880 times)

0 Members and 1 Guest are viewing this topic.

ML

  • Guest
Setting AutoCAD Paths with a VBScript
« on: May 23, 2007, 11:24:10 AM »

I am trying to set my ACAD Support Paths with a VBSCript (vbs)
Yes, I can create it in VBA and have but I am just curious to set if I can make this work externally from ACAD.

Here is the beginning of my code

Code: [Select]
Dim ACADApp

Set ACADApp = CreateObject("AutoCAD.application")


'Support File Search Paths:

  Dim Preferences As AcadPreferences

  Dim CurrPaths As String
  Dim NewPath1, NewPath2, NewPath3, NewPath4, NewPath5 As String

  Set Preferences = ThisDrawing.Application.Preferences
  CurrPaths = Preferences.Files.SupportPath
   
    NewPath1 = "I:\Directory\Directory"
'  'NewPath2 = "Path2"
'  'NewPath3 = "Path3"
'  'NewPath4 = "Path4"
'  'NewPath5 = "Path5"


'  'Support File Search Paths
   Preferences.Files.SupportPath = CurrPaths & ";" & NewPath1 '& ";" & NewPath2 & ";" & _
   NewPath3 & ";" & NewPath4 & ";" & NewPath5

I have AutoCAD opening up but then the code errors out.
I am thinking that I may need to set a reference to The Profile first but I am not sure.
Possibly VBA is not being initiazed either, but again, I am not sure.
Any help is appreciated

Thanks

Mark

Dnereb

  • Guest
Re: Setting AutoCAD Paths with a VBScript
« Reply #1 on: May 24, 2007, 06:10:38 AM »
By the look of it you are early binding.
Change:
Dim ACADApp
to
Dim ACADApp As AutoCAD.AcadApplication

Saves a lot of guesswork....

Thisdrawing..... eeehhhhhrrr....which drawing..... the code doesn't reside in a drawing so there's no thisdrawing.
Set Preferences = ACADApp.Preferences will do fine

I didn't test it (don't want to mess up my preferences) but this should point you in the right direction  :-)


ML

  • Guest
Re: Setting AutoCAD Paths with a VBScript
« Reply #2 on: May 24, 2007, 09:27:01 AM »

Thanks Dnereb

I will try it.
I don't blame you for not wanting to mess up your preferences so a way to get around that is to create a profile called "Test" or something like that. It is what I did; this way you can screw it up all you want and just restore your default profile when finished.

Let me go try your idea

Thank you

Mark

ML

  • Guest
Re: Setting AutoCAD Paths with a VBScript
« Reply #3 on: May 24, 2007, 01:48:43 PM »

Hey Dnereb

This was the only way I could get the script to do anything --->
It did not like The data types, so I removed as String from each variable.
Also, the missing coed was ACADApp.Visible = True
However, when I ran it, it did open AutoCAD and it effectively WIPED out my preferences.
Not just the settings, but All of the available options as well.
After, panicking for a few seconds, I was able to restore the profiles, tweak a few of my user settings and I was back.
I know I am on the right track here, however, I can not afford to have that happen everytime I test something.

What do you think?

Thank you

Mark


Code: [Select]
Set ACADApp = CreateObject("AutoCAD.application")
Set Preferences as AcadPreferences

ACADApp.Visible = True

Dim CurrPaths
Dim NewPath1, NewPath2, NewPath3, NewPath4, NewPath5

CurrPaths = Preferences.Files.SupportPath

 NewPath1 = "I:\Path\Test"
 'NewPath2 = "Path2"
 'NewPath3 = "Path3"
 'NewPath4 = "Path4"
 'NewPath5 = "Path5"


 'Support File Search Paths
  Preferences.Files.SupportPath = CurrPaths & ";" & NewPath1 '& ";" & NewPath2 & ";" & _
  'NewPath3 & ";" & NewPath4 & ";" & NewPath5

ML

  • Guest
Re: Setting AutoCAD Paths with a VBScript
« Reply #4 on: May 24, 2007, 02:06:38 PM »

I set a reference to The AutoCAD Type Library in Excel,
then I wrote the following syntax:

It did exactly what I wanted it to do in ACAD from Excel, however, when I ran the above code in a .vbs file, all hell broke loose.

Helpppppppp!   :-(

Code: [Select]
Sub ExcelToACAD()

Dim ACADApp As AutoCAD.AcadApplication

Set ACADApp = CreateObject("AutoCAD.application")
'Set fso = CreateObject("Scripting.FileSystemObject")
'Set MyFile= "C:\Program Files\Autodesk Land Desktop 2006\acad.exe" /p "Land Desktop"

ACADApp.Visible = True

Dim Preferences As AcadPreferences


'Support File Search Paths:

  Set Preferences = ACADApp.Preferences

  Dim CurrPaths As String
  Dim NewPath1, NewPath2, NewPath3, NewPath4, NewPath5 As String

  CurrPaths = Preferences.Files.SupportPath

  NewPath1 = "I:\Path\Test"
 'NewPath2 = "Path2"
 'NewPath3 = "Path3"
 'NewPath4 = "Path4"
 'NewPath5 = "Path5"


 'Support File Search Paths
   Preferences.Files.SupportPath = CurrPaths & ";" & NewPath1 '& ";" & NewPath2 & ";" & _
   NewPath3 & ";" & NewPath4 & ";" & NewPath5

End Sub

Dnereb

  • Guest
Re: Setting AutoCAD Paths with a VBScript
« Reply #5 on: May 25, 2007, 02:56:26 AM »
In the VB Script you are still referencing the acad object:
Set Preferences as AcadPreferences  'strange syntax anyways, shouldn't it be: "Set Preferences = AcadPreferences "?

If you don't want that use Object instead if that exists in VBSript....

Code: [Select]
Dim ACADAPP as Object
Dim Preferences as Object

Set ACADApp = CreateObject("AutoCAD.application")
Set Preferences = ACADApp.AcadPreferences 'you need to adres the holder acadapp if you aren't in acad

ACADApp.Visible = True

Dim CurrPaths
'Dim NewPath1, NewPath2, NewPath3, NewPath4, NewPath5

CurrPaths = Preferences.Files.SupportPath

'this is sloppy:
'NewPath1 = "I:\Path\Test"
'NewPath2 = "Path2"
'NewPath3 = "Path3"
'NewPath4 = "Path4"
'NewPath5 = "Path5"


'Support File Search Paths
'Preferences.Files.SupportPath = CurrPaths & ";" & NewPath1 '& ";" & NewPath2 & ";" & _
'NewPath3 & ";" & NewPath4 & ";" & NewPath5
'How about:
Dim NewPath(5) as String
Dim AllPaths as String
Dim pCount as Integer

NewPath(0) = "I:\Path\Test"
NewPath(1) = ""
NewPath(2) = ""
NewPath(3) = ""
NewPath(4) = ""

Allpaths = Currpaths
For pCount = 0 to 4
    if Len NewPath(pCount) > 0 then
        Allpaths = Allpaths & ";" & NewPath(pCount)
    end if
next

Preferences.Files.SupportPath = Allpaths

BTW: always dimension variables as type specific as possible, it will speed up the code and save memory usage.


ML

  • Guest
Re: Setting AutoCAD Paths with a VBScript
« Reply #6 on: May 25, 2007, 12:45:44 PM »

Yes you are correct,
A. I meant to say   Set Preferences = AcadPreferences
B. You are correct in the fact that the code is not written the most efficiently, however, I wrote it prior to learning about arrays and it got the job done. I did mean to re visit that part of the code at some point, so thank you for your suggestion and code there.
C. I am new to VBscript, so I am tippy toeing through this.
So, what part of my code do you think that screwed my profile up?

Thanks again

Mark

Dnereb

  • Guest
Re: Setting AutoCAD Paths with a VBScript
« Reply #7 on: May 25, 2007, 03:49:46 PM »
C: As you probably guessed I'm no VB scripter but a VB(A) programmer. So pin pointing the exact problem is tricky for me as well. But if I had to place a bet on it, I would go for:
not declaring as object but a variant (default type if you don't specify the type for a variable)
and adressing a method of the object.


ML

  • Guest
Re: Setting AutoCAD Paths with a VBScript
« Reply #8 on: May 25, 2007, 07:42:23 PM »

Same here, I have been at VBA for a little while but I am also new to Scripting.
While there are a lot of similiarities between the 2, there are still fundemental differences. I think that scripting allows you to branch out a little more.

The VBScripting Users Guide is free at Microsoft's Website; if you need the link, I can get it to you.

Anyhow, the problem was that I (or we) are trying to open AutoCAD first then write to the registry. As I understand it, ACAD must be closed to write to the registry. I may have done a few other things wrong also but it is not in the data types. In fact, if you look at the vbscripting users guide, they don't really declare with data types which was unusual but apparent to me .

Mark

ML

  • Guest
Re: Setting AutoCAD Paths with a VBScript
« Reply #9 on: May 29, 2007, 04:44:25 PM »

I used your array suggestion but I did not find The Len Function necessary and I changed a few other minor details

Thank you

Code: [Select]
Dim Preferences As AcadPreferences
Dim CurrPaths, NewPath(5), AllPaths As String

Dim Pcount As Integer

Set Preferences = ThisDrawing.Application.Preferences


CurrPaths = Preferences.Files.SupportPath


NewPath(0) = "Path"
NewPath(1) = "Path"
NewPath(2) = ""
NewPath(3) = ""
NewPath(4) = ""


For Pcount = 0 To 4
 If NewPath(Pcount) <> 0 Then
  AllPaths = AllPaths & ";" & CurrPaths & ";" & NewPath(Pcount)
 End If
Next Pcount

Preferences.Files.SupportPath = AllPaths

I still haven't figured out how to Script the paths in yet but I am chipping away at it.

Mark

LE

  • Guest
Re: Setting AutoCAD Paths with a VBScript
« Reply #10 on: May 29, 2007, 04:59:38 PM »
I did and have done very little in VB(A), but see if this code can do any help, I did it for VB, to launch AutoCAD and set up the path for one of my apps.

Code: [Select]
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 ejectable 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
   'esperar 20 segundos para que AutoCAD termine de abrirse
   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
   'Adicionar directorio donde esta instalado draftteam si no existe
   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



ML

  • Guest
Re: Setting AutoCAD Paths with a VBScript
« Reply #11 on: May 30, 2007, 11:13:29 AM »

Dnereb,

I figured it out, with alittle help.
I can now sucessfully change a Support Path in the registry via a VBA Script.
If you are still interested, let me know and I will share the code with you

Mark

ML

  • Guest
Re: Setting AutoCAD Paths with a VBScript
« Reply #12 on: June 06, 2007, 11:40:06 AM »

For those that are still interested, the below code is  getting the job done.
I also wanted to thank Keith for his help with this one  :-)

Mark

Code: [Select]
'NOTE:
'AutoCAD must be closed in order for the paths to be updated in AutoCAD

Dim WshShell,WshNetwork
Dim curver, locale, cprofile
Dim username
Dim vname  '= Value Name
Dim vdata  '= Value Data

Set WshShell = WScript.CreateObject("WScript.Shell")
Set WshNetwork = WScript.CreateObject("WScript.Network")

username = WshNetwork.UserName
vname = "SheetSetTemplatePath"

'This reads the currently installed and last accesed version of AutoCAD
curver = WshShell.RegRead ( "HKCU\Software\Autodesk\AutoCAD\curver")
'There is an additional value under that registry key, it is unique and must be grabbed from here, or else you won't know the location of the profile
locale = WshShell.RegRead ( "HKCU\Software\Autodesk\AutoCAD\" & curver & "\curver")
'This Key holds only the current profile
cprofile = WshShell.RegRead ( "HKCU\Software\Autodesk\AutoCAD\" & curver & "\" & locale & "\Profiles\")

'New Path Goes Here
vdata = "I:\Path\Template"

'Return to Default (Local) Path
'vdata = "C:\Documents and Settings\"& Username &"\Local Settings\Application
'Data\Autodesk\Autodesk Land Desktop 2006\R16.2\enu\Template"

'Write The VName and VData (Support Path)
WshShell.RegWrite "HKCU\Software\Autodesk\AutoCAD\" & curver & "\" & locale & "\Profiles\" & cprofile & "\General\" & vname,vdata

'Return The VName and VData (Support Paths)
WScript.Echo "The Path for ValueName " & vname & " is" & VbCrLf & vdata