[资料] 在注册表中为CAD增加“支持文件搜索路径

萧闫子

思路：1.读取注册表得到CAD“支持文件搜索路径”中的所有路径（在注册表中的位置见http://hi.baidu.com/kakanimo/blog/item/68171331079f5391a9018e91.html）；2.把路径分开（按;分开，注册表中的“ACAD”的值就是这个样式）3.判断所要添加路径在不在其中，在、不添加写回注册表，不在、就添加进去然后写回注册表。需要注意的是。修改的时候一定要把CAD关闭(判断是否在运行见http://hi.baidu.com/kakanimo/blog/item/47272439f2e0022cb9998f6e.html)，否则又会回到修改前的样子。   下面是代码：分为几个小部分
    1.得到本机上安装的所有CAD的“支持文件搜索路径”在注册表中的位置；2.读取注册表某个键的值；3.把读取的值分析是否加入新的路径信息。
    先搜索出本机上安装的CAD版本，代码我就省了，见“如何搜索出本机上安装的AutoCAD版本”http://hi.baidu.com/kakanimo/blo ... 5887d8a9ec9ac8.html，然后根据搜索出的版本得到相应版本在注册表中的位置：

1. 
   
2. Sub AddSupportPath()
   
3. Dim LocationEx(13) As String, i As Integer
   
4. For i = 0 To 13
   
5.     If Check1(i).Value = 1 Then
   
6.         Select Case i
   
7.             Case 0 To 1
   
8.                 '"AutoCAD 2002"
   
9.                 LocationEx(i) = Location(i) & "\Profiles\<<Unnamed Profile>>\General"
   
10.             Case 2 To 3
    
11.                 ' "AutoCAD 2004"
    
12.                 LocationEx(i) = Location(i) & "\Profiles\<<未命名配置>>\General"
    
13.             Case 4 To 5
    
14.                 ' "AutoCAD 2005"
    
15.                 LocationEx(i) = Location(i) & "\Profiles\<<未命名配置>>\General"
    
16.             Case 6 To 7
    
17.                 '"AutoCAD 2006"
    
18.                 LocationEx(i) = Location(i) & "\Profiles\<<未命名配置>>\General"
    
19.             Case 8 To 9
    
20.                 '"AutoCAD 2007"
    
21.                 LocationEx(i) = Location(i) & "\Profiles\<<未命名配置>>\General"
    
22.             Case 10 To 11
    
23.                 ' "AutoCAD 2008"
    
24.                 LocationEx(i) = Location(i) & "\Profiles\<<未命名配置>>\General"
    
25.             Case 12 To 13
    
26.                 '"AutoCAD 2009"
    
27.                 LocationEx(i) = Location(i) & "\Profiles\<<未命名配置>>\General"
    
28.         End Select
    
29.     End If
    
30. Next

复制代码

'接下来读取支持目录

1. Dim temp As String
   
2. For i = 0 To 13
   
3.     If Check1(i).Value = 1 Then
   
4.         temp = GetKeyValue(HKEY_CURRENT_USER, LocationEx(i), hKey) '得到字符串
   
5.         'MsgBox "前" & temp

复制代码

        '判断并修改这个字符串'写入注册表
      

1.   If AddSupportPathtoString(App.Path, temp) = False Then
   
2.             '写入注册表写入字符串值
   
3.             RegSetValueEx hKey, "ACAD", 0, REG_SZ, ByVal temp, LenB(StrConv(temp, vbFromUnicode)) + 1
   
4.         End If
   
5.     End If
   
6. Next
   
7. End Sub

复制代码

见上面代码。先根据搜索出来的CAD版本加上相应版本字符串得到CAD在注册表中“支持文件搜索路径”的完整位置，然后temp = GetKeyValue(HKEY_CURRENT_USER, LocationEx(i), hKey) 得到里面的值。然后用AddSupportPathtoString判断并写入，以下是上面代码中用到得函数：
Private Function GetKeyValue(RootKey As Long, SubKeyName As String, Optional hKey As Long) As String
    Dim intname As String '读取的字符串
    Dim Name As String * 1024 '这里要非常注意，后面这个1024如果设置小的画会下面读不出值
    Dim lngTypeData As Long '返回注册表值的数据类型
    Call RegOpenKey(RootKey, SubKeyName, hKey) '打开
    Call RegQueryValueEx(hKey, "ACAD", 0&, lngTypeData, ByVal Name, Len(Name))   '读到"ACAD"下数据
    intname = Left(Name, InStr(Name, Chr(0)) - 1)
    GetKeyValue = intname
    'MsgBox intname
End Function
'***********************************
'设置支持路径,
'****************************************
'入口：1.文件夹路径。2.ACAD支持路径在注册表中的位置

1. 
   
2. Function AddSupportPathtoString(ByVal Path As String, AcadFiles As String) As Boolean
   
3. Dim curSupportPath As Variant
   
4. Dim i As Integer
   
5. Dim Support As Boolean
   
6. Support = False
   
7. curSupportPath = VBA.Split(AcadFiles, ";")
   
8. For i = 0 To UBound(curSupportPath)
   
9.     If StrConv(curSupportPath(i), vbUpperCase) = StrConv(Path, vbUpperCase) Then '已经存在就不添加
   
10.         Support = True
    
11.         Exit For
    
12.     End If
    
13. Next
    
14. If Not Support Then
    
15.     AcadFiles = Path & ";" & AcadFiles
    
16. End If
    
17. AddSupportPathtoString = Support
    
18. End Function

复制代码

当然上面用到了API，你需要先声明下，这里就省了。