Solved: Sample Code does not work

GeorgK · ‎05-27-2013

Hello together,

I tried the code from the 2014 API Help. But it does not work. What's wrong with it?

Thank you Georg

' This sample demonstrates how to change colors using mini-toolbar
Sub ChangeAppearanceMiniToolbarSample()
    Dim oDoc As PartDocument
    If Not (ThisApplication.ActiveDocument Is Nothing) Then
        If ThisApplication.ActiveDocument.DocumentType = kPartDocumentObject Then
            If (MsgBox("Would you like to create new appearance assets with active document?", vbYesNo, "Autodesk Inventor Prompt") = vbYes) Then
                Set oDoc = ThisApplication.ActiveDocument
            Else
                Set oDoc = ThisApplication.Documents.Add(kPartDocumentObject)
        
                ' Create a block
                Call CreateSolids(oDoc)
            End If
        End If
    Else
        Set oDoc = ThisApplication.Documents.Add(kPartDocumentObject)
        
        ' Create a block
        Call CreateSolids(oDoc)
    End If
        
    ' Create seven appearances for use
    Call CreateColors(oDoc)
    Dim oCamera As Camera
    Set oCamera = oDoc.Views(1).Camera
    
    oCamera.Fit
    oCamera.Apply
    
    Dim oMiniToolbarEvents As New clsColorChange  ' <= here's the error userdefined type not declared
    
    Call oMiniToolbarEvents.Init(oDoc)

End Sub

Private Sub CreateSolids(oDoc As PartDocument)
    Dim oSk As PlanarSketch
    Set oSk = oDoc.ComponentDefinition.Sketches.Add(oDoc.ComponentDefinition.WorkPlanes(3))
    
    Call oSk.SketchLines.AddAsTwoPointRectangle(ThisApplication.TransientGeometry.CreatePoint2d(-2, -2), ThisApplication.TransientGeometry.CreatePoint2d(2, 2))
    
    Dim oProfile As Profile
    Set oProfile = oSk.Profiles.AddForSolid
    
    Dim oBlockDef As ExtrudeDefinition
    Set oBlockDef = oDoc.ComponentDefinition.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProfile, kJoinOperation)
    Call oBlockDef.SetDistanceExtent(4, kSymmetricExtentDirection)
    Dim oBlock As ExtrudeFeature
    Set oBlock = oDoc.ComponentDefinition.Features.ExtrudeFeatures.Add(oBlockDef)
    
    Set oSk = oDoc.ComponentDefinition.Sketches.Add(oBlock.EndFaces(1))
    Call oSk.SketchCircles.AddByCenterRadius(ThisApplication.TransientGeometry.CreatePoint2d(12, 12), 2)
    
    Set oProfile = oSk.Profiles.AddForSolid
    Dim oCylinderDef As ExtrudeDefinition, oCylinder As ExtrudeFeature
    Set oCylinderDef = oDoc.ComponentDefinition.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProfile, kNewBodyOperation)
    Call oCylinderDef.SetDistanceExtent(4, kSymmetricExtentDirection)
    Set oCylinder = oDoc.ComponentDefinition.Features.ExtrudeFeatures.Add(oCylinderDef)
End Sub

Private Sub CreateColors(oDoc As PartDocument)
    Dim bCreateNewAppearance As Boolean: bCreateNewAppearance = False
    
    Dim oCreateColors As Transaction
    Set oCreateColors = ThisApplication.TransactionManager.StartTransaction(oDoc, "Create custom colors")
        On Error Resume Next
        Dim oAsset As Asset, oColor As Color
        Set oAsset = oDoc.Assets.Item("Red")
        If Err Then
            Set oAsset = oDoc.Assets.Add(kAssetTypeAppearance, "Generic", "Red", "Red")
            ' Add Red
            Set oColor = ThisApplication.TransientObjects.CreateColor(255, 0, 0)
            oAsset.Item("generic_diffuse").Value = oColor
            bCreateNewAppearance = True
            Err.Clear
        End If
        
        Set oAsset = oDoc.Assets.Item("Orange")
        If Err Then
            Set oAsset = oDoc.Assets.Add(kAssetTypeAppearance, "Generic", "Orange", "Orange")
            ' Add Orange
            Set oColor = ThisApplication.TransientObjects.CreateColor(255, 165, 0)
            oAsset.Item("generic_diffuse").Value = oColor
        
            bCreateNewAppearance = True
            Err.Clear
        End If
        
        Set oAsset = oDoc.Assets.Item("Yellow")
        If Err Then
            Set oAsset = oDoc.Assets.Add(kAssetTypeAppearance, "Generic", "Yellow", "Yellow")
            ' Add Yellow
            Set oColor = ThisApplication.TransientObjects.CreateColor(255, 255, 0)
            oAsset.Item("generic_diffuse").Value = oColor
        
            bCreateNewAppearance = True
            Err.Clear
        End If

        Set oAsset = oDoc.Assets.Item("Green")
        If Err Then
            Set oAsset = oDoc.Assets.Add(kAssetTypeAppearance, "Generic", "Green", "Green")
            ' Add Green
            Set oColor = ThisApplication.TransientObjects.CreateColor(0, 255, 0)
            oAsset.Item("generic_diffuse").Value = oColor
        
            bCreateNewAppearance = True
            Err.Clear
        End If

        Set oAsset = oDoc.Assets.Item("Blue")
        If Err Then
            Set oAsset = oDoc.Assets.Add(kAssetTypeAppearance, "Generic", "Blue", "Blue")
            ' Add Blue
            Set oColor = ThisApplication.TransientObjects.CreateColor(0, 0, 255)
            oAsset.Item("generic_diffuse").Value = oColor
        
            bCreateNewAppearance = True
            Err.Clear
        End If
  
        Set oAsset = oDoc.Assets.Item("Indigo")
        If Err Then
            Set oAsset = oDoc.Assets.Add(kAssetTypeAppearance, "Generic", "Indigo", "Indigo")
            ' Add Indigo
            Set oColor = ThisApplication.TransientObjects.CreateColor(75, 0, 130)
            oAsset.Item("generic_diffuse").Value = oColor
            bCreateNewAppearance = True
            Err.Clear
        End If

        Set oAsset = oDoc.Assets.Item("Purple")
        If Err Then
            Set oAsset = oDoc.Assets.Add(kAssetTypeAppearance, "Generic", "Purple", "Purple")
            ' Add Purple
            Set oColor = ThisApplication.TransientObjects.CreateColor(160, 32, 240)
            oAsset.Item("generic_diffuse").Value = oColor
        
            bCreateNewAppearance = True
            Err.Clear
        End If
        
        If bCreateNewAppearance Then
            oCreateColors.End
        Else
            oCreateColors.Abort
        End If
    
End Sub

'*************************************************************
' The declarations and functions below need to be copied into
' a class module whose name is "clsColorChange".  The name
' can be changed but you'll need to change the declaration in
' the calling function "ChangeAppearanceMiniToolbarSample" to use the new name.
Private WithEvents m_MiniToolbar As MiniToolbar
Private WithEvents m_Colors As MiniToolbarComboBox
Private WithEvents m_Filter As MiniToolbarDropdown
Private WithEvents m_Preview As MiniToolbarCheckBox
Private m_PreviewColor As MiniToolbarCheckBox

Private WithEvents oInteractionEvents As InteractionEvents
Private WithEvents m_SelectEvents As SelectEvents
Private m_ChangeColorTransaction As Transaction

Private m_Doc As PartDocument
Private m_DefaultColor As Asset

Private bIsinteractionStarted As Boolean

Private bNeedTransaction As Boolean
Private bStop As Boolean

Public Sub Init(oDoc As PartDocument)
    Set m_Doc = oDoc
    Set m_DefaultColor = m_Doc.ActiveAppearance
    
    ' Create interaction events
    Set oInteractionEvents = ThisApplication.CommandManager.CreateInteractionEvents
    'oInteractionEvents.InteractionDisabled = False

    Set m_SelectEvents = oInteractionEvents.SelectEvents
    'm_SelectEvents.ClearSelectionFilter
    'm_SelectEvents.SingleSelectEnabled = False
    'm_SelectEvents.Enabled = True
    
    ' Create mini-tool bar for changing appearance
    Set m_MiniToolbar = oInteractionEvents.CreateMiniToolbar
    Call InitiateMiniToolbar
    
    bStop = False
    Set m_ChangeColorTransaction = ThisApplication.TransactionManager.StartTransaction(m_Doc, "Change Appearance")
    
    Do
        ThisApplication.UserInterfaceManager.DoEvents
    Loop Until bStop
    
End Sub

Private Sub InitiateMiniToolbar()
    m_MiniToolbar.ShowOK = True
    m_MiniToolbar.ShowApply = True
    m_MiniToolbar.ShowCancel = True
    
    Dim oControls As MiniToolbarControls
    Set oControls = m_MiniToolbar.Controls
    oControls.Item("MTB_Options").Visible = False
        
    Set m_Filter = m_MiniToolbar.Controls.AddDropdown("Filter", False, True, True, False)
    Call m_Filter.AddItem("Part", "Part", "Filter_Part", False, False)
    Call m_Filter.AddItem("Feature", "Feature", "Filter_Feature", False, False)
    Call m_Filter.AddItem("Face", "Face", "Filter_Face", False, False)
    
    
    Set m_Colors = oControls.AddComboBox("Colors", True, True, 50)
    Call m_Colors.AddItem("Default", "Use default color", "Default", False)
    Call m_Colors.AddItem("Red", "Red", "Red", False)
    Call m_Colors.AddItem("Orange", "Orange", "Orange", False)
    Call m_Colors.AddItem("Yellow", "Yellow", "Yellow", False)
    Call m_Colors.AddItem("Green", "Green", "Green", False)
    Call m_Colors.AddItem("Blue", "Blue", "Blue", False)
    Call m_Colors.AddItem("Indigo", "Indigo", "Indigo", False)
    Call m_Colors.AddItem("Purple", "Purple", "Purple", False)
    
    oControls.AddNewLine
    
    ' Specify if preview the color when hover a color item
    Set m_PreviewColor = m_MiniToolbar.Controls.AddCheckBox("PreviewColor", "Hover color preview", "Whether preview color when hover on it", True)
    
    ' Position the mini-tool bar to the top-left.
    Dim oPosition As Point2d
    Set oPosition = ThisApplication.TransientGeometry.CreatePoint2d(0, 0)
    
    m_MiniToolbar.Visible = True
    m_MiniToolbar.Position = oPosition
End Sub

Private Sub m_Colors_OnItemHoverStart(ByVal ListItem As MiniToolbarListItem)
    ' Preview the color when hover on it.
    If m_PreviewColor.Checked Then
        Call ChangeColor(ListItem.Text)
    End If
End Sub

Private Sub m_Colors_OnSelect(ByVal ListItem As MiniToolbarListItem)
    ' Check if the selected color is already used for the part/objects
    If m_Filter.SelectedItem.Text = "Part" Then
        If m_Doc.ActiveAppearance.Name = ListItem.Text Then
            bNeedTransaction = False
        Else
            bNeedTransaction = True
        End If
    Else
        bNeedTransaction = True
    End If
    
    Call ChangeColor(ListItem.Text)
    
End Sub
' Change filter for assigning color
Private Sub m_Filter_OnSelect(ByVal ListItem As MiniToolbarListItem)
    If ThisApplication.TransactionManager.CurrentTransaction.DisplayName = "Change Appearance" Then
        ThisApplication.TransactionManager.CurrentTransaction.Abort
    End If
    
    Set m_ChangeColorTransaction = ThisApplication.TransactionManager.StartTransaction(m_Doc, "Change Appearance")
    
    Select Case ListItem.Text
        Case "Part"
            m_Doc.SelectSet.Clear
            m_SelectEvents.ResetSelections
            m_SelectEvents.ClearSelectionFilter
            m_SelectEvents.AddSelectionFilter kPartDefaultFilter
            oInteractionEvents.SetCursor kCursorTypeDefault
        Case "Feature"
            m_Doc.SelectSet.Clear
             
            m_SelectEvents.ResetSelections
            m_SelectEvents.ClearSelectionFilter
            m_SelectEvents.AddSelectionFilter kPartFeatureFilter
             
            If Not bIsinteractionStarted Then
                oInteractionEvents.Start
                bIsinteractionStarted = True
            End If
        Case "Face"
            m_Doc.SelectSet.Clear
            m_SelectEvents.ResetSelections
            m_SelectEvents.ClearSelectionFilter
            m_SelectEvents.AddSelectionFilter kPartFaceFilter
            If Not bIsinteractionStarted Then
                oInteractionEvents.Start
                bIsinteractionStarted = True
            End If
            
    End Select
    m_Doc.Views(1).Update
    Call ChangeColor(ListItem.Text)
    
End Sub

Private Sub m_MiniToolbar_OnApply()
    
    If (m_Filter.SelectedItem.Text = "Feature" Or m_Filter.SelectedItem.Text = "Face") And (m_SelectEvents.SelectedEntities.Count = 0) Then
        m_ChangeColorTransaction.Abort
        m_Doc.Views(1).Update
        Set m_ChangeColorTransaction = ThisApplication.TransactionManager.StartTransaction(m_Doc, "Change Appearance")
        Exit Sub
    Else
        If bNeedTransaction Then ' Change color style
            Call ChangeColor(m_Colors.SelectedItem.Text)
            m_ChangeColorTransaction.End
        Else ' If no change to the color style
            m_ChangeColorTransaction.Abort
        End If
        
        ' Clear current selection for Feature and Face filter.
        If (m_Filter.SelectedItem.Text = "Feature" Or m_Filter.SelectedItem.Text = "Face") Then
            m_Doc.SelectSet.Clear
            m_SelectEvents.ResetSelections
        End If
    End If

    Set m_ChangeColorTransaction = ThisApplication.TransactionManager.StartTransaction(m_Doc, "Change Appearance")
End Sub

Private Sub m_MiniToolbar_OnCancel()
    bStop = True
    If ThisApplication.TransactionManager.CurrentTransaction Is m_ChangeColorTransaction Then
        m_ChangeColorTransaction.Abort
    End If
    m_SelectEvents.AddSelectionFilter kPartDefaultFilter
    If bIsinteractionStarted Then oInteractionEvents.Stop
    m_Doc.Views(1).Update
    
End Sub

Private Sub m_MiniToolbar_OnOK()
    bStop = True
    If bNeedTransaction Then ' Change color
        Call ChangeColor(m_Colors.SelectedItem.Text)
        m_ChangeColorTransaction.End
    Else ' If no change to the color style
        m_ChangeColorTransaction.Abort
    End If
End Sub
 
Private Sub oInteractionEvents_OnTerminate()
  
    If ThisApplication.TransactionManager.CurrentTransaction Is m_ChangeColorTransaction Then
        m_ChangeColorTransaction.Abort
    End If
    If bIsinteractionStarted Then
        oInteractionEvents.Stop
    End If
    m_Doc.Views(1).Update
End Sub

Private Sub ChangeColor(sColor As String)
        Debug.Print "Passed in:" & sColor
        If m_Filter.SelectedItem.Text = "Part" Then
            Select Case sColor
                Case "Default"
                    m_Doc.ActiveAppearance = m_DefaultColor
                Case "Red", "Orange", "Yellow", "Green", "Blue", "Indigo", "Purple"
                    m_Doc.ActiveAppearance = m_Doc.AppearanceAssets.Item(sColor)
            End Select
        ElseIf m_Filter.SelectedItem.Text = "Feature" Then
            If m_SelectEvents.SelectedEntities.Count Then
                Dim oFeature As PartFeature, oSelectedObj As Object
                
                For Each oSelectedObj In m_SelectEvents.SelectedEntities
                    If InStr(1, TypeName(oSelectedObj), "Feature") Then
                        Set oFeature = oSelectedObj
                        
                        Select Case sColor 'm_Colors.SelectedItem.Text
                            Case "Default"
                                oFeature.Appearance = m_DefaultColor
                            Case "Red", "Orange", "Yellow", "Green", "Blue", "Indigo", "Purple"
                                oFeature.Appearance = m_Doc.AppearanceAssets.Item(sColor)
                        End Select
                    End If
                Next
            End If
        ElseIf m_Filter.SelectedItem.Text = "Face" Then
            If m_SelectEvents.SelectedEntities.Count Then
                Dim oFace As Face
                
                For Each oSelectedObj In m_SelectEvents.SelectedEntities
                    If InStr(1, TypeName(oSelectedObj), "Face") Then
                        Set oFace = oSelectedObj
                        
                        Select Case sColor
                            Case "Default"
                                oFace.Appearance = m_DefaultColor
                            Case "Red", "Orange", "Yellow", "Green", "Blue", "Indigo", "Purple"
                                oFace.Appearance = m_Doc.AppearanceAssets.Item(sColor)
                        End Select
                    End If
                Next
            End If
        End If
End Sub

ekinsb · ‎05-28-2013

The short description at the top of the sample could definitely be better, but notice a several line comment about 1/3 of the way down in the code. All of the code past that point needs to be copied into a class module named "clsColorChange". That should be the only issue because I just tested it and it ran fine once I did that. The other thing that's not obvious is that you execute the sample by running the sub "ChangeAppearanceMiniToolbarSample".

Brian Ekins
Inventor and Fusion 360 API Expert
Mod the Machine blog

GeorgK · ‎05-28-2013

Thanks for the help. I tried it today. It works now.

Sample Code does not work

Sample Code does not work

Forums Links

Post to forums