Hi,
In the previous releases, the linear MarkingMenu and RadialMarkingMenu are not introduced. UsertInputEvents. OnContextMenu is to customize the context menu. The structure of VBA code is as below.
' *************module*****************
Sub test()
Dim oC As clsUserInput
Set oC = New clsUserInput
oC.Initialize
Do While True
DoEvents
Loop
End Sub
******class: clsUserInput *********
Option Explicit
Private WithEvents oUserInputEvents As UserInputEvents
Private WithEvents oCtrlDefNew As ButtonDefinition
Public Sub Initialize()
Set oUserInputEvents = ThisApplication.CommandManager.UserInputEvents
End Sub
Private Sub oUserInputEvents_OnContextMenu(ByVal SelectionDevice As SelectionDeviceEnum, ByVal AdditionalInfo As NameValueMap, ByVal CommandBar As CommandBar)
On Error Resume Next
' Check if the context menu has the 'Home View' (formerly 'Isometric View') command
Dim oCmdBarControl As CommandBarControl
Set oCmdBarControl = CommandBar.Controls.Item("AppIsometricViewCmd")
If Not oCmdBarControl Is Nothing Then
'Dim oCtrlDefNew As ButtonDefinition
Set oCtrlDefNew = ThisApplication.CommandManager.ControlDefinitions.AddButtonDefinition("MyContextMenu", _
"MyContextMenu", kShapeEditCmdType, "", "MyContextMenu", "MyContextMenu")
If oCtrlDefNew Is Nothing Then
Set oCtrlDefNew = ThisApplication.CommandManager.ControlDefinitions("MyContextMenu")
End If
Call CommandBar.Controls.AddButton(oCtrlDefNew, oCmdBarControl.index)
End If
End Sub
Public Sub oCtrlDefNew_OnExecute(ByVal Context As NameValueMap) ¡®event of button
oCtrlDefNew.Pressed = Not oCtrlDefNew.Pressed ¡®pressed or un-pressed
MsgBox "my button is clicked"
End Sub
Now, you will need to use
UsertInputEvents. OnLinearMarkingMenu
UsertInputEvents. OnRadialMarkingMenu
UsertInputEvents. OnContextualMiniToolbar
The code demo is as below:
' *************module*****************
Sub test()
Dim oC As Class1
Set oC = New Class1
oC.ini
Do While True
DoEvents
Loop
End Sub
'*********** event *****************
Private WithEvents oUE As UserInputEvents
Public Sub ini()
Set oUE = ThisApplication.CommandManager.UserInputEvents
End Sub
Private Sub oUE_OnLinearMarkingMenu(ByVal SelectedEntities As ObjectsEnumerator, ByVal SelectionDevice As SelectionDeviceEnum, ByVal LinearMenu As CommandControls, ByVal AdditionalInfo As NameValueMap)
' Check to see if a single planar face is selected.
If SelectedEntities.Count = 1 Then
If TypeOf SelectedEntities.Item(1) Is Face Then
Dim oFace As Face
Set oFace = SelectedEntities.Item(1)
If oFace.SurfaceType = kPlaneSurface Then
Call LinearMenu.AddButton(ThisApplication.CommandManager.ControlDefinitions("mycommand_internalname"), True)
End If
End If
End If
Set oUE = Nothing 'stop the events
End Sub
