可以通过vb判断是否安装了cad,并判断是哪个版本 Dim Info As Variant Private Sub Form_Load() Dim Location(11) As String, i As Integer Info = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1) Location(0) = "SOFTWARE\Autodesk\AutoCAD\R15.0\ACAD-1:804" '2002中文版 Location(1) = "SOFTWARE\Autodesk\AutoCAD\R15.0\ACAD-1:409" '2002英文版 Location(2) = "SOFTWARE\Autodesk\AutoCAD\R16.0\ACAD-201:804" '2004中文版 Location(3) = "SOFTWARE\Autodesk\AutoCAD\R16.0\ACAD-201:409" '2004英文版 Location(4) = "SOFTWARE\Autodesk\AutoCAD\R16.1\ACAD-301:804" '2005中文版 Location(5) = "SOFTWARE\Autodesk\AutoCAD\R16.1\ACAD-301:409" '2005英文版 Location(6) = "SOFTWARE\Autodesk\AutoCAD\R16.2\ACAD-4001:804" '2006中文版 Location(7) = "SOFTWARE\Autodesk\AutoCAD\R16.2\ACAD-4001:409" '2006英文版 Location(8) = "SOFTWARE\Autodesk\AutoCAD\R17.1\ACAD-6001:804" '2008中文版 Location(9) = "SOFTWARE\Autodesk\AutoCAD\R17.1\ACAD-6001:409" '2008英文版 Location(10) = "SOFTWARE\Autodesk\AutoCAD\R17.2\ACAD-7001:804" '2009中文版 Location(11) = "SOFTWARE\Autodesk\AutoCAD\R17.2\ACAD-7001:409" '2009英文版 For i = 0 To 11 Info(i) = SearchCADversion(Location(i)) Option1(i).Enabled = Info(i)(0) Next End Sub
'判断注册项是否存在 Public Function IsSubKeyName(RootKey As Long, SubKeyName As String, Optional hKey As Long) As Boolean If RegOpenKey(RootKey, SubKeyName, hKey) = 0& Then IsSubKeyName = True Else IsSubKeyName = False End If End Function Public Function SearchCADversion(Location As String) Dim Name As String * 255 Dim lngTypeData As Long '返回注册表值的数据类型 Dim intname As String '文件名所在的位置 Dim Being As Boolean Dim result(1) If IsSubKeyName(HKEY_LOCAL_MACHINE, Location, hKey) Then '判断是否存在项目 RegQueryValueEx hKey, "AcadLocation", 0&, lngTypeData, ByVal Name, Len(Name) '读到"AcadLocation"下数据 intname = Left(Name, InStr(Name, Chr(0)) - 1) If Len(intname) = 0 Then '如果存在这个大项目,但是里面AcadLocation没有,就表示可能卸载过,也没有安装这个版本的CAD Being = False Else '即存在大项,又有程序位置,说明存在这个版本的CAD Being = True End If Else '注册项不存在,表示没有这个版本的CAD Being = False End If result(0) = Being: result(1) = intname SearchCADversion = result End Function
|