NanShengBlogs

Sub AutoADDAutoCADTypeLib()
    Dim Ref As Variant
    Dim hasAutoTypeLib As Boolean, hasAXDBLib As Boolean, acadName As String
    hasAutoTypeLib = False: hasAXDBLib = False
    For Each Ref In ThisWorkbook.VBProject.References
        If Ref.Name = "AutoCAD" Then hasAutoTypeLib = True
        If Ref.Name = "AXDBLib" Then hasAXDBLib = True
    Next Ref
    Dim wshell As Object
    Set wshell = CreateObject("WScript.Shell")
    Dim strAcadShardFd As String, acadCurVer1 As String, acadCurVer2 As String, acadLanguage As String
    \'读取cad的版本
    acadCurVer1 = wshell.regread("HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\CurVer")
    \'读取cad的语言版本
    acadCurVer2 = wshell.regread("HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\" & acadCurVer1 & "\CurVer")
    \'读取cad的最后一次启动的语言版本
    acadLanguage = wshell.regread("HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\" & acadCurVer1 & "\" & acadCurVer2 & "\AllUsersFolder")
    Dim LanguagePath As Variant, acadVer As String
    LanguagePath = VBA.Split(acadLanguage, "\")
    acadVer = VBA.Mid(acadCurVer1, 2, 2) & LanguagePath(UBound(LanguagePath) - 1)
    acadName = LanguagePath(UBound(LanguagePath) - 3)
    \'读取cad的64位类型库的路径
    strAcadShardFd = wshell.regread("HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\" & acadCurVer1 & "\" & acadCurVer2 & "\AutodeskSharedFolder")
    
    \'读取cad的32位类型库的路径
    \'strAcad32ShardFd = wshell.regread("HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\" & acadCurVer1 & "\" & acadCurVer2 & "\AutodeskShared32Folder")
    
    Set wshell = Nothing
    
    If hasAutoTypeLib = False Then
        ThisWorkbook.VBProject.References.AddFromFile (strAcadShardFd & "acax" & acadVer & ".tlb")
        MsgBox acadName & " AutoCAD Type Lib Already add to referecne scucces"
    Else
        MsgBox "AutoCAD Type Lib Already add to referecne, no need add aagin"
    End If
    If hasAXDBLib = False Then
        ThisWorkbook.VBProject.References.AddFromFile (strAcadShardFd & "axdb" & acadVer & ".tlb")
        MsgBox acadName & " AXDBLib Already add to referecne scucces"
    Else
        MsgBox "AXDBLib Already add to referecne, no need add aagin"
    End If
End Sub

 

 

 

 

分类:

技术点:

相关文章:

  • 2021-09-17
  • 2021-12-03
  • 2021-11-07
  • 2021-11-24
  • 2021-04-27
  • 2021-08-29
  • 2021-12-29
  • 2021-12-12
猜你喜欢
  • 2021-12-18
  • 2021-11-20
  • 2021-12-12
  • 2020-05-07
  • 2021-11-27
  • 2021-12-08
  • 2021-11-20
相关资源
相似解决方案