社区 › VB › 使用VBScript设置AutoCAD路径

Dnereb 发表于 2007-5-23 11:24:10

使用VBScript设置AutoCAD路径

我正在尝试使用VBSCript（vbs）设置我的ACAD支持路径
是的，我可以在VBA中创建它，并且有，但我只是好奇设置我是否可以从ACAD外部完成这项工作。
这是我的代码的开头
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

我打开了AutoCAD，但随后代码出错了。
我在想我可能需要先设置对The Profile的引用，但我不确定。
可能VBA也没有被初始化，但同样，我不确定。
感谢任何帮助
谢谢
Mark
**** Hidden Message *****

Dnereb 发表于 2007-5-24 06:10:38

看起来你很早就结婚了。
将
Dim ACADApp
更改为
Dim ACADApp As AutoCAD。AcadApplication
省去了许多猜测....
这张图纸.....eeehhhhhrrr....哪幅画.....代码不在绘图中，所以没有这个绘图。
设置首选项= ACADApp。首选项会做得很好
我没有测试它(不想弄乱我的首选项)，但这应该会为您指出正确的方向

Dnereb 发表于 2007-5-24 09:27:01

谢谢Dnereb
我会试试的
我不怪你不想打乱你的偏好，所以一种解决方法是创建一个名为“测试”或类似的配置文件。这就是我所做的；通过这种方式，您可以随心所欲地将其搞糟，并在完成后恢复默认配置文件
谢谢
马克

Dnereb 发表于 2007-5-24 13:48:43

嘿Dnereb
这是我让脚本做任何事情的唯一方法-->
它不喜欢数据类型，所以我从每个变量中删除了as String。
此外，失踪的女学生是ACADApp。Visible = True
但是，当我运行它时，它确实打开了AutoCAD，并且有效地清除了我的首选项。
不仅仅是设置，还有所有可用的选项。
在惊慌失措了几秒钟之后，我恢复了配置文件，调整了一些用户设置，然后就回来了。
我知道我的思路是正确的，但是，我不能每次测试时都出现这种情况。
你怎么看？谢谢您马克代码1]

Dnereb 发表于 2007-5-24 14:06:38

在VB脚本中你仍然引用了acad对象:
Set Preferences as acad Preferences奇怪的语法反正不应该是:“Set Preferences = AcadPreferences”吗？
如果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
顺便说一句:总是尽可能将变量划分为特定类型，这将加快代码速度并节省内存使用。

Dnereb 发表于 2007-5-25 02:56:26

c:正如你可能猜到的，我不是VB程序员，而是VB(A)程序员。所以准确指出问题对我来说也很棘手。但是如果要我打赌的话，我会选择:
不声明为object，而是声明为variant(如果没有为变量指定类型，则为默认类型)
并声明对象的方法。

Dnereb 发表于 2007-5-25 12:45:44

在这里也是一样，我在VBA工作了一段时间，但我对脚本也不熟悉
微软网站上免费提供VBScripting用户指南；如果你需要链接，我可以给你
无论如何，问题是我（或我们）正在尝试先打开AutoCAD，然后写入注册表。据我所知，ACAD必须关闭才能写入注册表。我可能也做了一些其他错误的事情，但它不在数据类型中。事实上，如果您查看《vbscripting用户指南》，他们并没有真正用数据类型进行声明，这是不寻常的，但对我来说很明显。
马克

Dnereb 发表于 2007-5-25 15:49:46

我使用了您的阵列建议，但我认为Len函数没有必要，因此我更改了一些其他小细节
谢谢
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

我还没有想出如何编写路径脚本，但我正在一点一点地努力。
标记

Dnereb 发表于 2007-5-25 19:42:23

我在VB(A)中做的很少，但看看这段代码是否能有所帮助，我是为VB做的，启动AutoCAD并为我的一个应用程序设置路径。
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 lRC0 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"" 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 发表于 2007-5-29 16:44:25

Dnereb，
我想通了，有一点点帮助。
我现在可以通过 VBA 脚本成功更改注册表中的支持路径。
如果您仍然感兴趣，请告诉我，我将与您共享代码
Mark

查看完整版本: 使用VBScript设置AutoCAD路径