能否新建一个菜单条?

weihedao

如题,如何创建菜单条

chtd

可以编辑acad.mns文件，也可以在cad工具条处右击，在弹出的对话框中，拖动一个命令到工具栏处。

azjmjsj

Sub addmenu()
Dim currMenuGroup As AcadMenuGroup
Dim newMenu As AcadPopupMenu
On Error Resume Next

'建立新菜单
Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
Set newMenu = currMenuGroup.Menus.Add("custom_menu")

'增加菜单项
Dim newMenuitem As AcadPopupMenuItem
Dim Macrostr(4) As String
Macrostr(1) = Chr(3) & Chr(3) & Chr(95) & "-vbarun ""aaa.dvb!ddd""" & Chr(32)
Macrostr(2) = Chr(3) & Chr(3) & Chr(95) & "-vbarun ""bbb.dvb!eee""" & Chr(32)
Macrostr(3) = Chr(3) & Chr(3) & Chr(95) & "-vbarun ""ccc.dvb!fff""" & Chr(32)
Macrostr(4) = Chr(3) & Chr(3) & "(startapp " & Chr(34) & "ggg.exe" & Chr(34) & ")" & Chr(13)
Set newMenuitem = newMenu.AddMenuItem(newMenu.Count + 1, "菜单一", Macrostr(1))
newMenuitem.HelpString = "菜单一"  ' 为菜单项增加状态栏帮助
Set newMenuitem = newMenu.AddMenuItem(newMenu.Count + 1, "菜单二", Macrostr(2))
newMenuitem.HelpString = "菜单二"
Set newMenuitem = newMenu.AddMenuItem(newMenu.Count + 1, "菜单三", Macrostr(3))
newMenuitem.HelpString = "菜单三"
Set newMenuitem = newMenu.AddSeparator(3)   '菜单分隔符
Set newMenuitem = newMenu.AddMenuItem(newMenu.Count + 1, "菜单四", Macrostr(4))
newMenuitem.HelpString = "******制作"

If Err.Number Then Err.Clear

'菜单条上显示菜单
currMenuGroup.Menus.InsertMenuInMenuBar "custom_menu", 8
End Sub

****************************************************************************
西北凡人------http://www.abofanyi.com/blog