Want to add menu items to your right-click
shortcut menu? Try this :
'CODING STARTS HERE
Sub VbaMenu()
Dim currMenuGroup As AcadMenuGroup
Dim openMacro As String
Dim newScmenu As AcadPopupMenu
Dim scMenu As AcadPopupMenu
Dim entry As AcadPopupMenu
On Error GoTo Err_Control
' Use MenuGroups property to obtain
reference to main ACAD menu
Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item("ACAD")
'===================================================================
'find the shortcut menu
For Each entry In currMenuGroup.Menus
If entry.ShortcutMenu = True Then
Set scMenu = entry
End If
Next entry
'create a shortcut menu item
Set newScmenu = scMenu.AddSubMenu(0, "&VBA Menu")
'create the vbaload macro
openMacro = Chr(3) & Chr(3) & Chr(95) & "vbaload" &
Chr(32)
'display the shortcut sub-menu item
newScmenu.AddMenuItem "", "VBA &Load", openMacro
'create the vbaide macro
openMacro = Chr(3) & Chr(3) & Chr(95) & "vbaide" &
Chr(32)
'display the shortcut sub-menu item
newScmenu.AddMenuItem "", "VBA &Editor", openMacro
'create the vbarun macro
openMacro = Chr(3) & Chr(3) & Chr(95) & "vbarun" &
Chr(32)
'display the shortcut sub-menu item
newScmenu.AddMenuItem "", "VBA &Macro", openMacro
'create the vbaman macro
openMacro = Chr(3) & Chr(3) & Chr(95) & "vbaman" &
Chr(32)
'display the shortcut sub-menu item
newScmenu.AddMenuItem "", "&VBA Manager", openMacro
'add a separator line
scMenu.AddSeparator 1
're-compile the AutoCAD menu
currMenuGroup.Save acMenuFileCompiled
'==========================================================
Over_Here:
Exit Sub
Err_Control:
Select Case Err.Number
Case -2147024809
Err.Clear
Resume Over_Here
Case Else
MsgBox Err.Number & " - " & Err.Description
Exit Sub
End Select
End Sub
'CODING ENDS HERE
|