|
|
发表于 2008-1-8 23:51:00
|
显示全部楼层
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 |
|
置顶卡
