[求助]cad菜单栏中"帮助"右边追加一个菜单(非弹出式)

cctv2cctv · 发表于 2008-4-19 15:29:00


Sub Ch6_AddASubMenu()
Dim currMenuGroup As AcadMenuGroup
Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)' 建立一个新菜单
Dim newMenu As AcadPopupMenu
Set newMenu = currMenuGroup.Menus.Add("TestMenu")
' 增加子菜单
Dim FileSubMenu As AcadPopupMenu
Set FileSubMenu = newMenu.AddSubMenu("", "OpenFile")
' 在子菜单中增加一个菜单项
Dim newMenuItem As AcadPopupMenuItem
Dim openMacro As String
' 指定宏为VBA表达式"ESC ESC _open "
openMacro = Chr(3) + Chr(3) + Chr(95) + "open" + Chr(32)Set newMenuItem = FileSubMenu.AddMenuItem _
(newMenu.count + 1, "Open", openMacro)
' 菜单条上显示菜单
newMenu.InsertInMenuBar _
(ThisDrawing.Application.menuBar.count + 1)
End Sub

我已阅读了以上文章，以上文章是弹出式菜单，但想在cad菜单栏 “帮助”后面追加一个菜单，点击此菜单马上调用相应宏命令，而不是弹出菜单再进行选择，还是实现不了

copy


' 增加子菜单
Dim FileSubMenu As AcadPopupMenu
Set FileSubMenu = newMenu.AddSubMenu("", "OpenFile")
' 在子菜单中增加一个菜单项
Dim newMenuItem As AcadPopupMenuItem
Dim openMacro As String
' 指定宏为VBA表达式"ESC ESC _open "
openMacro = Chr(3) + Chr(3) + Chr(95) + "open" + Chr(32)Set newMenuItem = FileSubMenu.AddMenuItem _
(newMenu.count + 1, "Open", openMacro)