VB编写的自动加载arx程序支持win10 64位系统修改后可加载lsp net等

言戲無軍 · 发表于 2018-8-22 16:05:00

把此程序放到需要加载的arx同目录下，将此程序名称改为arx同样名字(如 Myapp.exe 32位：Myapp.16.arx 64位：Myapp.16.X64.arx 16为arx版本对应的CAD版本号)，否则无法加载，点运行即可加载及卸载，
加载后，CAD每次运行都会加载ARX.
注册表读取函数来自zzyong版主，其它部分代码来自网络，在此谢过，代码水平有限，仅限于实现功能。包涵。
源码共享，这个代码稍作修改可用于加载net lisp程序，需要有人来继续了哦
部分核心代码，加载部分

copy

Private Sub Command4_Click()
 Dim MyAppName As String
 MyAppName = App.Title
 'MsgBox App.Path
 
 
 Dim CurVer As String, cadpath As String, i As Long, Ver As String
 
 For i = 0 To List1.ListCount - 1
 If List1.Selected(i) = True Then
 Ver = CStr(Cadstr(i))
  Select Case Ver
         Case "16.0", "16.1", "16.2"
            
               CurVer = RegQueryStringValue(HKCU32, "Software\Autodesk\\R" & Ver, "CurVer")
                   cadpath = RegQueryStringValue(GetPreferredRoot32, "Software\Autodesk\AutoCAD\R" & Ver & "" & CurVer, "Location")
                 If Dir(cadpath & "\acad.exe")  "" Then
                     
                     PopulateDemandloadKey GetPreferredRoot32, "Software\Autodesk\AutoCAD\R" & Ver & "" & CurVer & "\Applications", MyAppName & ".ARX." & Int(CDbl(Ver)) & ".arx", Ver
                  End If
            
         Case Else:
                CurVer = RegQueryStringValue(HKCU32, "Software\Autodesk\AutoCAD\R" & Ver, "CurVer")
                   cadpath = RegQueryStringValue(GetPreferredRoot32, "Software\Autodesk\AutoCAD\R" & Ver & "" & CurVer, "Location")
                 If Dir(cadpath & "\acad.exe")  "" Then
                 MsgBox cadpath & "1"
                     PopulateDemandloadKey GetPreferredRoot32, "Software\Autodesk\AutoCAD\R" & Ver & "" & CurVer & "\Applications", MyAppName & ".ARX." & Int(CDbl(Ver)) & ".arx", Ver
                  End If
                  If Is64bit() Then
                  CurVer = RegQueryStringValue(HKCU64, "Software\Autodesk\AutoCAD\R" & Ver, "CurVer")
                   cadpath = RegQueryStringValue(GetPreferredRoot64, "Software\Autodesk\AutoCAD\R" & Ver & "" & CurVer, "Location")
                 If Dir(cadpath & "\acad.exe")  "" Then
                 'MsgBox cadpath & "2"
                     PopulateDemandloadKey GetPreferredRoot64, "Software\Autodesk\AutoCAD\R" & Ver & "" & CurVer & "\Applications", MyAppName & ".ARX." & Int(CDbl(Ver)) & ".X64.arx", Ver
                  End If
                  End If
         
         
  
  End Select
End If
Next
End Sub