AutoCAD VBA添加菜单

# 给cad添加自定义菜单

?

 1 Private Sub AddBar()
 2     Dim NewMenuItem As AcadPopupMenuItem
 3     Dim TheMacro As String
 4     Dim MI As Integer
 5     
 6     On Error Resume Next
 7     Dim currMenuGroup As AcadMenuGroup
 8     Set currMenuGroup = Application.MenuGroups.Item(0)
 9     'Create the new menu
10     Set NewMenu = currMenuGroup.Menus.Add("批量绘图")
11     If Err.Number Then
12         Err.Clear
13         For Each NewMenu In currMenuGroup.Menus
14             If NewMenu.Name = "批量绘图" Then Exit For
15         Next
16     End If
17     
18     'Add a menu item to the new menu
19     'Assign the macro string the VB equivalent of "ESC ESC _open "
20     'TheMacro = Chr(3) & Chr(3) & Chr(95) & "-vbarun ""GeoSection.dvb!DZPM.GeoSection""" & Chr(32)
21     TheMacro = Chr(3) & Chr(3) & Chr(95) & "-vbarun ""MainSub""" & Chr(32)
22     Set NewMenuItem = NewMenu.AddMenuItem(NewMenu.Count   1, "批量绘图", TheMacro)
23     If Err.Number Then Err.Clear
24     'Display the menu on the menu bar
25     NewMenu.InsertInMenuBar (ThisDrawing.Application.MenuBar.Count   1)
26     If Err.Number Then Err.Clear
27 End Sub

View Code

写几个事件驱动菜单显示

?

 1 Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)
 2     If StrComp(Left$(CommandName, 3), "VBA", 1) <> 0 And UCase$(CommandName) <> "APPLOAD" Then Exit Sub
 3     If NewMenu Is Nothing Then AddBar
 4 End Sub
 5 
 6 Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
 7     If StrComp(Left$(CommandName, 3), "VBA", 1) <> 0 And UCase$(CommandName) <> "APPLOAD" Then Exit Sub
 8     If NewMenu Is Nothing Then AddBar
 9 End Sub
10 
11 Public Sub MainSub()
12     Dim frm As New UserForm1
13     Call UserForm1.Show
14 End Sub

View Code

?最终效果

?

来源：http://www./content-4-220601.html