'*********************************************************************************************
'获得当前DVB文件路径****************************************************************************
Public Function GetPath() As String
    '获得Cad安装路径
    'MsgBox Application.FullName & Application.Path
    '获得当前的工程路径
    Dim StrPath, i As Integer, temp As String
    
    StrPath = ThisDrawing.Application.VBE.ActiveVBProject.filename
    '解析工具栏按钮图标路径
    For i = Len(StrPath) To 1 Step -1
        temp = Mid(StrPath, i, 1)
        If temp = "/" Or temp = "\" Then Exit For
    Next i
    GetPath = Left(StrPath, i)
End Function
'*********************************************************************************************

Public Function GetVBAProjects()
    
    Dim i As Long, projects() As String


    Dim objIDE As Object
    
    Set objIDE = Application.vbe
    
    ReDim projects(0 To objIDE.VBProjects.Count - 1, 1)
  On Error Resume Next
    For i = 0 To objIDE.VBProjects.Count - 1
        projects(i, 0) = objIDE.VBProjects(i + 1).Name
        projects(i, 1) = objIDE.VBProjects(i + 1).FileName
    Next
    
    GetVBAProjects = projects
    
End Function