Create Flyouts in the CommandManager Example (VB.NET)

Imports System
Imports System.Runtime.InteropServices
Imports System.Collections
Imports System.Diagnostics
Imports System.Reflection

Imports SolidWorks.Interop.sldworks
Imports SolidWorks.Interop.swpublished
Imports SolidWorks.Interop.swconst
Imports SolidWorksTools
Imports SolidWorksTools.File


    ''' <summary>
    ''' This addin shows how to add a FlyoutGroup to the CommandManager and
    ''' context-sensitive menus of selected faces in a part.
    ''' </summary>
    '''
<Guid("6a08dbad-f5a9-4f02-a19b-6e88ee37701f")> _
<ComVisible(True)> _
<SwAddin( _
     Description:="CommandMgrSwVBAddin description", _
     Title:="CommandMgrSwVBAddin", _
     LoadAtStartup:=True _
     )> _
     Public Class SwAddin
    Implements SolidWorks.Interop.swpublished.SwAddin
#Region "Local Variables"
    Private iSwApp As ISldWorks
    Private iCmdMgr As ICommandManager
    Private addinID As Integer

#Region "Event Handler Variables"
    Private m_openDocs As Hashtable
    Private SwEventPtr As SolidWorks.Interop.sldworks.SldWorks
#End Region

#Region "Property Manager Variables"
    Private ppage As UserPMPage
#End Region


    ' Public Properties
    Public ReadOnly Property SwApp() As ISldWorks
        Get
            Return iSwApp
        End Get
    End Property
    Public ReadOnly Property CmdMgr() As ICommandManager
        Get
            Return iCmdMgr
        End Get
    End Property

  
    ReadOnly Property OpenDocumentsTable() As Hashtable
        Get
            Return m_openDocs
        End Get
    End Property

#End Region

#Region "SolidWorks Registration"
    <ComRegisterFunctionAttribute()> _
    Public Shared Sub RegisterFunction(ByVal t As Type)

        '#Region "Get Custom Attribute: SwAddinAttribute"
        Dim SWattr As SwAddinAttribute = Nothing
        Dim type As Type = GetType(SwAddin)
        For Each attr As System.Attribute In type.GetCustomAttributes(False)
            If TypeOf attr Is SwAddinAttribute Then
                SWattr = TryCast(attr, SwAddinAttribute)
                Exit For
            End If
        Next
        '#End Region

        Dim hklm As Microsoft.Win32.RegistryKey = Microsoft.Win32.Registry.LocalMachine
        Dim hkcu As Microsoft.Win32.RegistryKey = Microsoft.Win32.Registry.CurrentUser

        Dim keyname As String = "SOFTWARE\SolidWorks\Addins\{" & t.GUID.ToString() & "}"
        Dim addinkey As Microsoft.Win32.RegistryKey = hklm.CreateSubKey(keyname)
        addinkey.SetValue(Nothing, 0)

        addinkey.SetValue("Description", SWattr.Description)
        addinkey.SetValue("Title", SWattr.Title)

        keyname = "Software\SolidWorks\AddInsStartup\{" & t.GUID.ToString() & "}"
        addinkey = hkcu.CreateSubKey(keyname)
        addinkey.SetValue(Nothing, Convert.ToInt32(SWattr.LoadAtStartup), Microsoft.Win32.RegistryValueKind.DWord)
    End Sub

    <ComUnregisterFunctionAttribute()> _
    Public Shared Sub UnregisterFunction(ByVal t As Type)
        Dim hklm As Microsoft.Win32.RegistryKey = Microsoft.Win32.Registry.LocalMachine
        Dim hkcu As Microsoft.Win32.RegistryKey = Microsoft.Win32.Registry.CurrentUser

        Dim keyname As String = "SOFTWARE\SolidWorks\Addins\{" & t.GUID.ToString() & "}"
        hklm.DeleteSubKey(keyname)

        keyname = "Software\SolidWorks\AddInsStartup\{" & t.GUID.ToString() & "}"
        hkcu.DeleteSubKey(keyname)
    End Sub

#End Region

#Region "ISwAddin Implementation"

    Function ConnectToSW(ByVal ThisSW As Object, ByVal Cookie As Integer) As Boolean Implements SolidWorks.Interop.swpublished.SwAddin.ConnectToSW
        iSwApp = DirectCast(ThisSW, ISldWorks)
        addinID = cookie

        'Setup callbacks
        iSwApp.SetAddinCallbackInfo(0, Me, addinID)

        '#Region "Setup the Command Manager"
        iCmdMgr = iSwApp.GetCommandManager(cookie)
        AddCommandMgr()
        '#End Region

        '#Region "Setup the Event Handlers"
        SwEventPtr = DirectCast(iSwApp, SolidWorks.Interop.sldworks.SldWorks)
        m_openDocs = New Hashtable()
        AttachEventHandlers()
        '#End Region

        '#Region "Setup Sample Property Manager"
        AddPMP()
        '#End Region

        Return True
    End Function

    Function DisconnectFromSW() As Boolean Implements SolidWorks.Interop.swpublished.SwAddin.DisconnectFromSW
        RemoveCommandMgr()
        RemovePMP()
        DetachEventHandlers()

        iSwApp = Nothing
        'The addin _must_ call GC.Collect() here in order to retrieve all managed code pointers
        GC.Collect()
        Return True
    End Function
#End Region

#Region "UI Methods"
    Public Sub updateBtns()
        Dim flyoutGroup As IFlyoutGroup
        flyoutGroup = iCmdMgr.GetFlyoutGroup(500)
        flyoutGroup.RemoveAllCommandItems()

        flyoutGroup.AddCommandItem("FlyoutCommand 1", "FlyoutCommand 1", -1, "FlyoutCommandItem1", "FlyoutEnableCommandItem1")
        flyoutGroup.AddCommandItem("FlyoutCommand 2", "FlyoutCommand 2", -1, "FlyoutCommandItem2", "FlyoutEnableCommandItem2")

        flyoutGroup.FlyoutType = CInt(swCommandFlyoutStyle_e.swCommandFlyoutStyle_LastUsed)
        'flyoutGroup.FlyoutType = CInt(swCommandFlyoutStyle_e.swCommandFlyoutStyle_Favorite)

        'flyoutGroup.FlyoutType = CInt(swCommandFlyoutStyle_e.swCommandFlyoutStyle_Simple)
    End Sub
    Public Sub AddCommandMgr()
        Dim cmdGroup As ICommandGroup
        Dim flyoutGroup As IFlyoutGroup
        Dim iBmp As New BitmapHandler()
        Dim thisAssembly As Assembly
        Dim cmdIndex0 As Integer, cmdIndex1 As Integer

        Dim errors As Integer = 0
        Dim Title As String = "VB.NET Add-in", ToolTip As String = "VB.NET Add-in"
        Dim FlyoutTitle As String = "VB.NET Flyout", FlyoutToolTip As String = "VB.NET Flyout"


        Dim docTypes As Integer() = New Integer() {CInt(swDocumentTypes_e.swDocASSEMBLY), CInt(swDocumentTypes_e.swDocDRAWING), CInt(swDocumentTypes_e.swDocPART)}

        thisAssembly = System.Reflection.Assembly.GetAssembly(Me.[GetType]())

        ' Create a CommandGroup

        cmdGroup = iCmdMgr.CreateCommandGroup2(1, Title, ToolTip, "", -1, True, _
        errors)

        cmdGroup.LargeIconList = iBmp.CreateFileFromResourceBitmap("CommandMgrSwVBAddin.ToolbarLarge.bmp", thisAssembly)
        cmdGroup.SmallIconList = iBmp.CreateFileFromResourceBitmap("CommandMgrSwVBAddin.ToolbarSmall.bmp", thisAssembly)
        cmdGroup.LargeMainIcon = iBmp.CreateFileFromResourceBitmap("CommandMgrSwVBAddin.MainIconLarge.bmp", thisAssembly)
        cmdGroup.SmallMainIcon = iBmp.CreateFileFromResourceBitmap("CommandMgrSwVBAddin.MainIconSmall.bmp", thisAssembly)

        cmdIndex0 = cmdGroup.AddCommandItem2("CreateCube", -1, "Create a cube", "Create cube", 0, "CreateCube", _
        "CubeEnable", 1, 3)
        cmdIndex1 = cmdGroup.AddCommandItem2("Show PMP", -1, "Display sample property manager", "Show PMP", 1, "ShowPMP", _
        "PMPEnable", 2, 3)

        cmdGroup.HasToolbar = True
        cmdGroup.HasMenu = True
        cmdGroup.Activate()

        ' Get number of command IDs in the CommandGroup
        Debug.Print("Number of command IDs in the CommandGroup is " & iCmdMgr.GetCommandIDsCount(1).ToString())

        ' Get group data from registry
        Dim userIDs As Integer()
        Dim objIDs As Object = Nothing
        iCmdMgr.GetGroupDataFromRegistry(1, objIDs)
        userIDs = DirectCast(objIDs, Integer())
        Debug.Print("Command IDs found in the registry:")
        For Each ID As Integer In userIDs
            Debug.Print(ID.ToString())
        Next

        Dim bResult As Boolean

        ' Create a FlyoutGroup

        flyoutGroup = iCmdMgr.CreateFlyoutGroup(500, FlyoutTitle, FlyoutToolTip, FlyoutTitle, cmdGroup.SmallMainIcon, cmdGroup.LargeMainIcon, _
        cmdGroup.SmallIconList, cmdGroup.LargeIconList, "FlyoutCallback", "FlyoutEnable")

        ' Add the FlyoutGroup to the context-sensitive menus of faces in parts
        bResult = flyoutGroup.AddContextMenuFlyout(CInt(swDocumentTypes_e.swDocPART), CInt(swSelectType_e.swSelFACES))
        Debug.Print("Context menu flyout created for faces in parts: " & bResult.ToString())

        ' Get the total number of FlyoutGroups in CommandManager
        Debug.Print("Number of FlyoutGroups is " & iCmdMgr.NumberOfFlyoutGroups)

        ' Get the FlyoutGroups
        Dim objGroups As Object()
        objGroups = DirectCast(iCmdMgr.GetFlyoutGroups(), Object())
        Debug.Print("Find all FlyoutGroups in CommandManager:")
        Dim i As Integer
        For i = 0 To objGroups.GetUpperBound(0)

            Debug.Print("FlyoutGroup found")
        Next

        ' Get a FlyoutGroup by its user-defined ID
        Dim fogrp As IFlyoutGroup
        fogrp = iCmdMgr.GetFlyoutGroup(500)
        Debug.Print(" CmdID: " & fogrp.CmdID)
        Debug.Print(" Button count: " & fogrp.ButtonCount)
        Debug.Print(" Flyout Type: " & fogrp.FlyoutType)
        Debug.Print(" SmallMainIcon: " & fogrp.SmallMainIcon)
        Debug.Print(" LargeMainIcon: " & fogrp.LargeMainIcon)
        Debug.Print(" SmallIconList: " & fogrp.SmallIconList)
        Debug.Print(" LargeIconList: " & fogrp.LargeIconList)



        For Each type As Integer In docTypes
            Dim cmdTab As ICommandTab

            cmdTab = DirectCast(iCmdMgr.AddCommandTab(type, Title), ICommandTab)

            Dim cmdBox As CommandTabBox = cmdTab.AddCommandTabBox()

            Dim cmdIDs As Integer() = New Integer(2) {}
            Dim TextType As Integer() = New Integer(2) {}


            cmdIDs(0) = cmdGroup.CommandID(cmdIndex0)
            System.Diagnostics.Debug.Print(cmdGroup.CommandID(cmdIndex0).ToString())
            TextType(0) = CInt(swCommandTabButtonTextDisplay_e.swCommandTabButton_TextHorizontal)

            cmdIDs(1) = cmdGroup.CommandID(cmdIndex1)
            System.Diagnostics.Debug.Print(cmdGroup.CommandID(cmdIndex1).ToString())
            TextType(1) = CInt(swCommandTabButtonTextDisplay_e.swCommandTabButton_TextHorizontal)

            cmdIDs(2) = cmdGroup.ToolbarId
            System.Diagnostics.Debug.Print(cmdIDs(2).ToString())
            TextType(2) = CInt(swCommandTabButtonTextDisplay_e.swCommandTabButton_TextHorizontal) Or CInt(swCommandTabButtonFlyoutStyle_e.swCommandTabButton_ActionFlyout)

            bResult = cmdBox.AddCommands(cmdIDs, TextType)

            ' Add another CommandTabBox with the FlyoutGroup

            Dim cmdBox1 As CommandTabBox = cmdTab.AddCommandTabBox()
            cmdIDs = New Integer(1) {}
            TextType = New Integer(1) {}

            cmdIDs(0) = cmdGroup.ToolbarId
            TextType(0) = CInt(swCommandTabButtonTextDisplay_e.swCommandTabButton_TextBelow) Or CInt(swCommandTabButtonFlyoutStyle_e.swCommandTabButton_ActionFlyout)

            cmdIDs(1) = fogrp.CmdID
            TextType(1) = CInt(swCommandTabButtonTextDisplay_e.swCommandTabButton_TextBelow) Or CInt(swCommandTabButtonFlyoutStyle_e.swCommandTabButton_ActionFlyout)

            bResult = cmdBox1.AddCommands(cmdIDs, TextType)


            cmdTab.AddSeparator(cmdBox1, cmdGroup.ToolbarId)
        Next


        thisAssembly = Nothing
        iBmp.Dispose()
    End Sub


    Public Sub RemoveCommandMgr()
        iCmdMgr.RemoveCommandGroup2(1, False)

        iCmdMgr.RemoveFlyoutGroup(500)
    End Sub

    Public Function AddPMP() As [Boolean]
        ppage = New UserPMPage
        ppage.Init(iSwApp, Me)
    End Function

    Public Function RemovePMP() As [Boolean]
        ppage = Nothing
        Return True
    End Function

#End Region

#Region "UI Callbacks"

    Public Sub CreateCube()
        'make sure we have a part open
        Dim partTemplate As String = iSwApp.GetUserPreferenceStringValue(CInt(swUserPreferenceStringValue_e.swDefaultTemplatePart))
        Dim modDoc As IModelDoc2 = DirectCast(iSwApp.NewDocument(partTemplate, CInt(swDwgPaperSizes_e.swDwgPaperA2size), 0.0R, 0.0R), IModelDoc2)

        modDoc.InsertSketch2(True)
        modDoc.SketchRectangle(0, 0, 0, 0.1, 0.1, 0.1, _
        False)

        'Extrude the sketch
        Dim featMan As IFeatureManager = modDoc.FeatureManager
        featMan.FeatureExtrusion(True, False, False, CInt(swEndConditions_e.swEndCondBlind), CInt(swEndConditions_e.swEndCondBlind), 0.1, _
        0.0R, False, False, False, False, 0.0R, _
        0.0R, False, False, False, False, True, _
        False, False)
    End Sub

    Public Sub FlyoutCallback()
        Debug.Print("Flyout group called")
        updateBtns()
    End Sub
    Public Function FlyoutEnable() As Integer
        Return 1
    End Function

    Public Sub FlyoutCommandItem1()
        Debug.Print("Flyout command 1 called")
    End Sub
    Public Function FlyoutEnableCommandItem1() As Integer
        Return 1
    End Function

    Public Sub FlyoutCommandItem2()
        Debug.Print("Flyout command 2 called")
    End Sub
    Public Function FlyoutEnableCommandItem2() As Integer
        Return 1
    End Function

    Public Sub ShowPMP()
        If ppage IsNot Nothing Then
            ppage.Show()
        End If
    End Sub

    Public Function PMPEnable() As Integer
        If iSwApp.ActiveDoc IsNot Nothing Then
            Return 1
        Else
            Return 0
        End If
    End Function

    Public Function CubeEnable() As Integer


        Return 1
    End Function
#End Region

#Region "Event Methods"
    Public Function AttachEventHandlers() As Boolean
        AttachSwEvents()
        'Listen for events on all currently open docs
        AttachEventsToAllDocuments()
        Return True
    End Function

    Private Function AttachSwEvents() As Boolean
        Try
            AddHandler SwEventPtr.ActiveDocChangeNotify, AddressOf OnDocChange
            AddHandler SwEventPtr.DocumentLoadNotify2, AddressOf OnDocLoad
            AddHandler SwEventPtr.FileNewNotify2, AddressOf OnFileNew
            AddHandler SwEventPtr.ActiveModelDocChangeNotify, AddressOf OnModelChange
            AddHandler SwEventPtr.FileOpenPostNotify, AddressOf FileOpenPostNotify
            Return True
        Catch e As Exception
            Console.WriteLine(e.Message)
            Return False
        End Try
    End Function



    Private Function DetachSwEvents() As Boolean
        Try
            RemoveHandler SwEventPtr.ActiveDocChangeNotify, AddressOf OnDocChange
            RemoveHandler SwEventPtr.DocumentLoadNotify2, AddressOf OnDocLoad
            RemoveHandler SwEventPtr.FileNewNotify2, AddressOf OnFileNew
            RemoveHandler SwEventPtr.ActiveModelDocChangeNotify, AddressOf OnModelChange
            RemoveHandler SwEventPtr.FileOpenPostNotify, AddressOf FileOpenPostNotify
            Return True
        Catch e As Exception
            Console.WriteLine(e.Message)
            Return False

        End Try
    End Function

    Public Sub AttachEventsToAllDocuments()
        Dim modDoc As ModelDoc2 = DirectCast(iSwApp.GetFirstDocument(), ModelDoc2)
        While modDoc IsNot Nothing
            If Not m_openDocs.Contains(modDoc) Then
                AttachModelDocEventHandler(modDoc)
            End If
            modDoc = DirectCast(modDoc.GetNext(), ModelDoc2)
        End While
    End Sub

    Public Function AttachModelDocEventHandler(ByVal modDoc As ModelDoc2) As Boolean
        If modDoc Is Nothing Then
            Return False
        End If

        Dim docHandler As DocumentEventHandler = Nothing

        If Not m_openDocs.Contains(modDoc) Then
            Select Case modDoc.[GetType]()
                Case CInt(swDocumentTypes_e.swDocPART)
                    If True Then
                        docHandler = New PartEventHandler()
                        Exit Select
                    End If
                Case CInt(swDocumentTypes_e.swDocASSEMBLY)
                    If True Then
                        docHandler = New AssemblyEventHandler()
                        Exit Select
                    End If
                Case CInt(swDocumentTypes_e.swDocDRAWING)
                    If True Then
                        docHandler = New DrawingEventHandler()
                        Exit Select
                    End If
                Case Else
                    If True Then
                        Return False
                        'Unsupported document type
                    End If
            End Select
            docHandler.Init(iSwApp, Me, modDoc)
            docHandler.AttachEventHandlers()
            m_openDocs.Add(modDoc, docHandler)
        End If
        Return True
    End Function

    Public Function DetachModelEventHandler(ByVal modDoc As ModelDoc2) As Boolean
        Dim docHandler As DocumentEventHandler
        docHandler = DirectCast(m_openDocs(modDoc), DocumentEventHandler)
        m_openDocs.Remove(modDoc)
        modDoc = Nothing
        docHandler = Nothing
        Return True
    End Function

    Public Function DetachEventHandlers() As Boolean
        DetachSwEvents()

        'Close events on all currently open docs
        Dim docHandler As DocumentEventHandler
        Dim numKeys As Integer = m_openDocs.Count
        Dim keys As Object() = New [Object](numKeys - 1) {}

        'Remove all document event handlers
        m_openDocs.Keys.CopyTo(keys, 0)
        For Each key As ModelDoc2 In keys
            docHandler = DirectCast(m_openDocs(key), DocumentEventHandler)
            docHandler.DetachEventHandlers()
            'This also removes the pair from the hash
            docHandler = Nothing
        Next
        Return True
    End Function
#End Region

#Region "Event Handlers"
    'Events
    Public Function OnDocChange() As Integer
        Return 0
    End Function

    Public Function OnDocLoad(ByVal docTitle As String, ByVal docPath As String) As Integer
        Return 0
    End Function

    Private Function FileOpenPostNotify(ByVal FileName As String) As Integer
        AttachEventsToAllDocuments()
        Return 0
    End Function

    Public Function OnFileNew(ByVal newDoc As Object, ByVal docType As Integer, ByVal templateName As String) As Integer
        AttachEventsToAllDocuments()
        Return 0
    End Function

    Public Function OnModelChange() As Integer
        Return 0
    End Function

#End Region
End Class