TheSwamp
Code Red => VB(A) => Topic started by: ML 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
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
-
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 :-)
-
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
-
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
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
-
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! :-(
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
-
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....
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.
-
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
-
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.
-
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
-
I used your array suggestion but I did not find The Len Function necessary and I changed a few other minor details
Thank you
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
-
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.
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
-
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
-
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
'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