分享一个VBA用于获取用户系统中AutoCAD版本及初始化的类模块

xsk199529

Private Sub App_BeginQuit(Cancel As Boolean)
    ' 获得AutoCAD的版本
    Dim strAcadVersion As String
    strAcadVersion = Application.Version

    Dim hKey As Long, ret As Long

Const REG_OPTION_NON_VOLATILE = 0 ' 当系统重新启动时，关键字被保留

' 注册表关键字安全选项...
Const READ_CONTROL = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + READ_CONTROL
Const KEY_WRITE = KEY_SET_VALUE + KEY_CREATE_SUB_KEY + READ_CONTROL
Const KEY_EXECUTE = KEY_READ
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
Const KEY_WOW64_64KEY = &H100 + KEY_ALL_ACCESS

#If VBA7 Then

    If StrComp(Left(strAcadVersion, 4), "15.0", vbTextCompare) = 0 Then
        ' AutoCAD 2002版本
        ret = RegOpenKey(HKEY_CURRENT_USER, "Software\Autodesk\AutoCAD\R15.0\ACAD-1:804\Profiles", hKey)
        If ret = 0 Then
            RegSetValue HKEY_CURRENT_USER, "Software\Autodesk\AutoCAD\R15.0\ACAD-1:409\Profiles", _
                        REG_SZ, "", 0
            RegCloseKey hKey
        End If
    ElseIf StrComp(Left(strAcadVersion, 4), "16.0", vbTextCompare) = 0 Then
        ' AutoCAD 2004版本
        ret = RegOpenKey(HKEY_CURRENT_USER, "Software\Autodesk\AutoCAD\R16.0\ACAD-201:804\Profiles", hKey)
        If ret = 0 Then
            RegSetValue HKEY_CURRENT_USER, "Software\Autodesk\AutoCAD\R16.0\ACAD-201:409\Profiles", _
                        REG_SZ, "", 0
            RegCloseKey hKey
        End If

    ElseIf StrComp(Left(strAcadVersion, 4), "17.1", vbTextCompare) = 0 Then
        ' AutoCAD 2008版本
        ret = RegOpenKey(HKEY_CURRENT_USER, "Software\Autodesk\AutoCAD\R17.1\ACAD-6001:804\Profiles", hKey)
        If ret = 0 Then
            RegSetValue HKEY_CURRENT_USER, "Software\Autodesk\AutoCAD\R17.1\ACAD-6001:409\Profiles", _
                        REG_SZ, "", 0
            RegCloseKey hKey
        End If

    ElseIf StrComp(Left(strAcadVersion, 4), "18.0", vbTextCompare) = 0 Then
        ' AutoCAD 2010版本
        ret = RegOpenKeyEx(HKEY_CURRENT_USER, "Software\Autodesk\AutoCAD\R18.0\ACAD-8001:804\Profiles", 0, KEY_READ Or KEY_WOW64_64KEY, hKey)
        If ret = 0 Then
            'RegSetValue HKEY_CURRENT_USER, "Software\Autodesk\AutoCAD\R18.0\ACAD-8001:409\Profiles", _
                        REG_SZ, "", 0
            SetKeyValue HKEY_CURRENT_USER, "SOFTWARE\Autodesk\AutoCAD\R18.0\ACAD-8001:409\Profiles", _
                       "", "", REG_SZ
            RegCloseKey hKey
        End If

    ElseIf StrComp(Left(strAcadVersion, 4), "19.1", vbTextCompare) = 0 Then
        ' AutoCAD 2014版本
        ret = RegOpenKeyEx(HKEY_CURRENT_USER, "Software\Autodesk\AutoCAD\R19.1\ACAD-D001:804\Profiles", 0, KEY_READ Or KEY_WOW64_64KEY, hKey)
        If ret = 0 Then
            'RegSetValue HKEY_CURRENT_USER, "Software\Autodesk\AutoCAD\R19.1\ACAD-D001:409\Profiles", _
                        REG_SZ, "", 0
            SetKeyValue HKEY_CURRENT_USER, "SOFTWARE\Autodesk\AutoCAD\R19.1\ACAD-D001:409\Profiles", _
                       "", "", REG_SZ

            RegCloseKey hKey
        End If
    ElseIf StrComp(Left(strAcadVersion, 4), "20.1", vbTextCompare) = 0 Then
        ' AutoCAD 2016版本
        ret = RegOpenKeyEx(HKEY_CURRENT_USER, "Software\Autodesk\AutoCAD\R20.1\ACAD-F001:804\Profiles", 0, KEY_READ Or KEY_WOW64_64KEY, hKey)
        If ret = 0 Then
            'RegSetValue HKEY_CURRENT_USER, "Software\Autodesk\AutoCAD\R20.1\ACAD-F001:409\Profiles", _
                        REG_SZ, "", 0
            SetKeyValue HKEY_CURRENT_USER, "SOFTWARE\Autodesk\AutoCAD\R20.1\ACAD-F001:409\Profiles", _
                       "", "", REG_SZ

            RegCloseKey hKey
        End If
    ElseIf StrComp(Left(strAcadVersion, 4), "22.0", vbTextCompare) = 0 Then
        ' AutoCAD 2018版本
        ret = RegOpenKeyEx(HKEY_CURRENT_USER, "Software\Autodesk\AutoCAD\R22.0\ACAD-1001:804\Profiles", 0, KEY_READ Or KEY_WOW64_64KEY, hKey)
        If ret = 0 Then
            'RegSetValue HKEY_CURRENT_USER, "Software\Autodesk\AutoCAD\R22.0\ACAD-1001:409\Profiles", _
                        REG_SZ, "", 0
            SetKeyValue HKEY_CURRENT_USER, "SOFTWARE\Autodesk\AutoCAD\R22.0\ACAD-1001:409\Profiles", _
                       "", "", REG_SZ

            RegCloseKey hKey
        End If
    End If

#Else

    If StrComp(Left(strAcadVersion, 4), "15.0", vbTextCompare) = 0 Then
        ' AutoCAD 2002版本
        ret = RegOpenKey(HKEY_CURRENT_USER, "Software\Autodesk\AutoCAD\R15.0\ACAD-1:804\Profiles", hKey)
        If ret = 0 Then
            RegSetValue HKEY_CURRENT_USER, "Software\Autodesk\AutoCAD\R15.0\ACAD-1:409\Profiles", _
                        REG_SZ, "", 0
            RegCloseKey hKey
        End If
    ElseIf StrComp(Left(strAcadVersion, 4), "16.0", vbTextCompare) = 0 Then
        ' AutoCAD 2004版本
        ret = RegOpenKey(HKEY_CURRENT_USER, "Software\Autodesk\AutoCAD\R16.0\ACAD-201:804\Profiles", hKey)
        If ret = 0 Then
            RegSetValue HKEY_CURRENT_USER, "Software\Autodesk\AutoCAD\R16.0\ACAD-201:409\Profiles", _
                        REG_SZ, "", 0
            RegCloseKey hKey
        End If

    ElseIf StrComp(Left(strAcadVersion, 4), "17.1", vbTextCompare) = 0 Then
        ' AutoCAD 2008版本
        ret = RegOpenKey(HKEY_CURRENT_USER, "Software\Autodesk\AutoCAD\R17.1\ACAD-6001:804\Profiles", hKey)
        If ret = 0 Then
            RegSetValue HKEY_CURRENT_USER, "Software\Autodesk\AutoCAD\R17.1\ACAD-6001:409\Profiles", _
                        REG_SZ, "", 0
            RegCloseKey hKey
        End If

    ElseIf StrComp(Left(strAcadVersion, 4), "18.0", vbTextCompare) = 0 Then
        ' AutoCAD 2010版本
        ret = RegOpenKey(HKEY_CURRENT_USER, "Software\Autodesk\AutoCAD\R18.0\ACAD-8001:804\Profiles", hKey)
        If ret = 0 Then
            RegSetValue HKEY_CURRENT_USER, "Software\Autodesk\AutoCAD\R18.0\ACAD-8001:409\Profiles", _
                        REG_SZ, "", 0
            RegCloseKey hKey
        End If

    ElseIf StrComp(Left(strAcadVersion, 4), "19.1", vbTextCompare) = 0 Then
        ' AutoCAD 2014版本
        ret = RegOpenKey(HKEY_CURRENT_USER, "Software\Autodesk\AutoCAD\R19.1\ACAD-D001:804\Profiles", hKey)
        If ret = 0 Then
            RegSetValue HKEY_CURRENT_USER, "Software\Autodesk\AutoCAD\R19.1\ACAD-D001:409\Profiles", _
                        REG_SZ, "", 0
            RegCloseKey hKey
        End If
    ElseIf StrComp(Left(strAcadVersion, 4), "20.1", vbTextCompare) = 0 Then
        ' AutoCAD 2016版本
        ret = RegOpenKey(HKEY_CURRENT_USER, "Software\Autodesk\AutoCAD\R20.1\ACAD-F001:804\Profiles", hKey)
        If ret = 0 Then
            RegSetValue HKEY_CURRENT_USER, "Software\Autodesk\AutoCAD\R20.1\ACAD-F001:409\Profiles", _
                        REG_SZ, "", 0
            RegCloseKey hKey
        End If
    ElseIf StrComp(Left(strAcadVersion, 4), "22.0", vbTextCompare) = 0 Then
        ' AutoCAD 2018版本
        ret = RegOpenKey(HKEY_CURRENT_USER, "Software\Autodesk\AutoCAD\R22.0\ACAD-1001:804\Profiles", hKey)
        If ret = 0 Then
            RegSetValue HKEY_CURRENT_USER, "Software\Autodesk\AutoCAD\R22.0\ACAD-1001:409\Profiles", _
                        REG_SZ, "", 0
            RegCloseKey hKey
        End If
    End If
#End If

End Sub

zzyong00

代码不完整，且有问题
如：acadapplication对应，在App_BeginQuit，是App,而获取版本时，用的是 Application.Version

言戲無軍

zzyong00 发表于 2018-7-6 12:35
代码不完整，且有问题
如：acadapplication对应，在App_BeginQuit，是App,而获取版本时，用的是 Applicati ...

请教zzyong00大神，最近win10 64位升级1803版本后，CAD2006~CAD2008都无法加载 带窗体的VBA程序，不知道为什么，VBA中插入窗体也会提示未正确注册，引用窗体控件也无用

言戲無軍

言戲無軍 发表于 2018-7-14 16:24
请教zzyong00大神，最近win10 64位升级1803版本后，CAD2006~CAD2008都无法加载 带窗体的VBA程序，不知道 ...

注册了，fm20.dll，32位office 2010用带窗体的VBA都没问题

言戲無軍

言戲無軍 发表于 2018-7-14 16:24
请教zzyong00大神，最近win10 64位升级1803版本后，CAD2006~CAD2008都无法加载 带窗体的VBA程序，不知道 ...

刚才试了下，确实fm20.dll没注册成功，但是也找不到解决办法

言戲無軍

言戲無軍 发表于 2018-7-14 17:02
刚才试了下，确实fm20.dll没注册成功，但是也找不到解决办法

但是CAD2010及以上 32位能加载带窗体 VBA