如何把.PAT文件所属的文件路径用VBA程序自动添加到AUTOCAD的支持文件搜索路径中.

jinyongjun

如何把.PAT文件所属的文件路径用VBA程序自动添加到AutoCAD的支持文件搜索路径中.即我把.PAT文件保存在 "E:\工程项目\SUPPORT\" 文件夹中,如何用VBA语言编程自动添加到AUTOCAD2002 >TOOLS>OPTIONS>SUPPORT FILE SERACH PATH 中.

mccad

MSITStore:C:\Program%20Files\Common%20Files\Autodesk%20Shared\acadauto.chm::/idh_preferencesfiles_object.htm" target="_blank" >PreferencesFiles.SupportPath

jinyongjun

能否写具体点,谢谢

clement

Sub Example_SupportPath()
' This example returns the current setting of
' SupportPath. It then changes the value, and finally
' it resets the value back to the original setting.

Dim preferences As AcadPreferences
Dim currSupportPath As String
Dim newSupportPath As String

Set preferences = ThisDrawing.Application.preferences

' Retrieve the current SupportPath value
currSupportPath = preferences.Files.SupportPath
MsgBox "The current value for SupportPath is " & currSupportPath, vbInformation, "SupportPath Example"

' Change the value for SupportPath
newSupportPath = "TestSupportPath"
preferences.Files.SupportPath = newSupportPath
MsgBox "The new value for SupportPath is " & newSupportPath, vbInformation, "SupportPath Example"

' Reset SupportPath to its original value
preferences.Files.SupportPath = currSupportPath
MsgBox "The SupportPath value is reset to " & currSupportPath, vbInformation, "SupportPath Example"
End Sub

wyj7485

Sub AddSupportPath(ByVal Path As String)
Dim curSupportPath As Variant
Dim i As Integer
Dim Support As Boolean Support = False
curSupportPath = Split(ThisDrawing.Application.preferences.Files, ";") For i = 0 To UBound(curSupportPath)
If StrConv(curSupportPath(i), vbUpperCase) = StrConv(Path, vbUpperCase) Then
Support = True
Exit For
End If
Next If Not Support Then
ThisDrawing.Application.preferences.Files = ThisDrawing.Application.preferences.Files & ";" & Path
End If End Sub Sub test()
AddSupportPath "d:\test"
End Sub

tanglianyu

楼上讲的是inventor吗？