AutoCAD VBA添加菜单

# 给cad添加自定义菜单

 Private Sub AddBar()
     Dim NewMenuItem As AcadPopupMenuItem
     Dim TheMacro As String
     Dim MI As Integer

     On Error Resume Next
     Dim currMenuGroup As AcadMenuGroup
     Set currMenuGroup = Application.MenuGroups.Item()
     'Create the new menu
     Set NewMenu = currMenuGroup.Menus.Add("批量绘图")
     If Err.Number Then
         Err.Clear
         For Each NewMenu In currMenuGroup.Menus
             If NewMenu.Name = "批量绘图" Then Exit For
         Next
     End If

     'Add a menu item to the new menu
     'Assign the macro string the VB equivalent of "ESC ESC _open "
     'TheMacro = Chr(3) & Chr(3) & Chr(95) & "-vbarun ""GeoSection.dvb!DZPM.GeoSection""" & Chr(32)
     TheMacro = Chr() & Chr() & Chr() & "-vbarun ""MainSub""" & Chr()
     Set NewMenuItem = NewMenu.AddMenuItem(NewMenu.Count + , "批量绘图", TheMacro)
     If Err.Number Then Err.Clear
     'Display the menu on the menu bar
     NewMenu.InsertInMenuBar (ThisDrawing.Application.MenuBar.Count + )
     If Err.Number Then Err.Clear
 End Sub

写几个事件驱动菜单显示

 Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)
     If StrComp(Left$(CommandName, ), "VBA", ) <>  And UCase$(CommandName) <> "APPLOAD" Then Exit Sub
     If NewMenu Is Nothing Then AddBar
 End Sub

 Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
     If StrComp(Left$(CommandName, ), "VBA", ) <>  And UCase$(CommandName) <> "APPLOAD" Then Exit Sub
     If NewMenu Is Nothing Then AddBar
 End Sub

 Public Sub MainSub()
     Dim frm As New UserForm1
     Call UserForm1.Show
 End Sub

最终效果