- 积分
- 429
- 明经币
- 个
- 注册时间
- 2003-7-23
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
第一次运行时没有问题,但后来再运行时不知道为什么“Public Sub DeleteMenu()”段就运行不了,说是方法“Item"作用于"IAcadPopupmenus"失败。我将菜单名改为中文时也会出现错误。
Public Sub CreateMenu()
Dim curMenuGroup As AcadMenuGroup
Set curMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
Dim newMenu As AcadPopupMenu
Set newMenu = curMenuGroup.Menus.Add("Te" + Chr(Asc("&")) + "stMenu1")
Dim openMacro As String
Dim saveMacro As String
Dim editMacro As String
openMacro = Chr(3) + Chr(3) + Chr(95) + "open" + Chr(32) '即VBA中的ESC ESC _Open
saveMacro = Chr(3) + Chr(3) + Chr(95) + "save" + Chr(32) '即VBA中的ESC ESC _Save
editMacro = Chr(3) + Chr(3) + Chr(95) + "edit" + Chr(32) '即VBA中的ESC ESC _Edit
Dim openMenuItem As AcadPopupMenuItem
Dim saveMenuItem As AcadPopupMenuItem
Dim editMenuItem As AcadPopupMenuItem
Dim sepaMenuItem As AcadPopupMenuItem
Set openMenuItem = newMenu.AddMenuItem _
(newMenu.Count + 1, Chr(Asc("&")) + "Open", openMacro)
Set sepaMenuItem = newMenu.AddSeparator(newMenu.Count + 1)
Set saveMenuItem = newMenu.AddMenuItem _
(newMenu.Count + 1, Chr(Asc("&")) + "Save", saveMacro)
Set sepaMenuItem = newMenu.AddSeparator(newMenu.Count + 1)
Set editMenuItem = newMenu.AddMenuItem _
(newMenu.Count + 1, Chr(Asc("&")) + "Edit", editMacro)
Dim saveasSubMenu As AcadPopupMenu
Set saveasSubMenu = newMenu.AddSubMenu(newMenu.Count + 1, "SaveAsFile")
Dim subMenuItem As AcadPopupMenuItem
Dim subMacro As String
subMacro = Chr(3) + Chr(3) + Chr(95) + "SaveAs" + Chr(32)
Set subMenuItem = saveasSubMenu.AddMenuItem _
(saveasSubMenu.Count + 1, "SaveAs", subMacro)
editMenuItem.Enable = False
newMenu.InsertInMenuBar (ThisDrawing.Application.MenuBar.Count + 1)
End Sub
Public Sub CreateShortCutMenu()
Dim curMenuGroup As AcadMenuGroup
Set curMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
'
Dim scMenu As AcadPopupMenu
Dim entMenu As AcadPopupMenu
For Each entMenu In curMenuGroup.Menus
If entMenu.ShortcutMenu = True Then
Set scMenu = entMenu
Else
Exit Sub
End If
Next entMenu
Dim scMenuItem As AcadPopupMenuItem
Dim openMacro As String
openMacro = Chr(3) + Chr(3) + Chr(95) + "open" + Chr(32)
'
Set scMenuItem = scMenu.AddMenuItem _
(scMenu.Count + 1, Chr(Asc("&")) + "OpenDWG", openMacro)
End Sub
Public Sub DeleteMenu()
Dim curMenuGroup As AcadMenuGroup
Set curMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
Dim oldMenu As AcadPopupMenu
Set oldMenu = curMenuGroup.Menus.Item("Te" + Chr(Asc("&")) + "stMenu")
oldMenu.RemoveFromMenuBar
End Sub |
|