EaBIM

标题: [资料] 在注册表中为CAD增加“支持文件搜索路径 [打印本页]
作者: 萧闫子    时间: 2014-1-8 14:07
标题: [资料] 在注册表中为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，然后根据搜索出的版本得到相应版本在注册表中的位置：

  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支持路径在注册表中的位置

  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，你需要先声明下，这里就省了。





欢迎光临 EaBIM (https://eabim.net/) Powered by Discuz! X3.2