Lesson 7.4 - code

Files

Code

Module: mMain

Dim swApp As SldWorks.SldWorks
Dim pm As clsPMP
Public swModel As SldWorks.ModelDoc2
Public Const lngGroup1ID As Long = 0
Public Const lngGroup2ID As Long = 1
Public Const lngSelID As Long = 2
Public Const lngOptionRedID As Long = 3
Public Const lngOptionGreenID As Long = 4
Public Const lngOptionBlueID As Long = 5
    
Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    
    'Make sure a part or assy is open
    If swModel Is Nothing Then
        MsgBox "Run in part or assembly."
        End
    End If
    If swModel.GetType = swDocDRAWING Then
        MsgBox "Run in part or assembly."
        End
    End If
    
    'Create the PMP
    Set pm = New clsPMP
    pm.Create swApp
End Sub

Class: clsPMP

Dim pmHandler As clsPMPHandler
Dim pmPage As SldWorks.PropertyManagerPage2
Dim pmGroup1 As SldWorks.PropertyManagerPageGroup
Dim pmGroup2 As SldWorks.PropertyManagerPageGroup
Dim pmSelection As SldWorks.PropertyManagerPageSelectionbox
Dim pmOptionRed As SldWorks.PropertyManagerPageOption
Dim pmOptionGreen As SldWorks.PropertyManagerPageOption
Dim pmOptionBlue As SldWorks.PropertyManagerPageOption
Dim lngErrors As Long
    
Sub Create(swApp As SldWorks.SldWorks)
    Set pmHandler = New clsPMPHandler
    Set pmPage = swApp.CreatePropertyManagerPage("Change Face Color", _
    swPropertyManagerOptions_OkayButton + swPropertyManagerOptions_CancelButton + _
    swPropertyManagerOptions_LockedPage, pmHandler, lngErrors)
        
    If lngErrors = 0 Then
        'Message
        pmPage.SetMessage3 "Select any number of faces and select a color.", _
            swImportantMessageBox, swMessageBoxMaintainExpandState, "Message"
        
        'Group box
        Set pmGroup1 = pmPage.AddGroupBox(lngGroup1ID, "Select faces", _
            swGroupBoxOptions_Expanded + swGroupBoxOptions_Visible)
        
        'Selection box
        Set pmSelection = pmGroup1.AddControl(lngSelID, swControlType_Selectionbox, _
            "Select faces", swControlAlign_Indent, swControlOptions_Visible + _
            swControlOptions_Enabled, Empty)
        pmSelection.SingleEntityOnly = True
        pmSelection.Height = 15
        pmSelection.SetSelectionFilters swSelFACES
        pmSelection.SetStandardPictureLabel swBitmapLabel_SelectFace
        
        'Group box
        Set pmGroup2 = pmPage.AddGroupBox(lngGroup2ID, "Select color", _
            swGroupBoxOptions_Expanded + swGroupBoxOptions_Visible)
        
        'Option buttons
        Set pmOptionRed = pmGroup2.AddControl(lngOptionRedID, swControlType_Option, _
            "Red", swControlAlign_Indent, swControlOptions_Visible + _
            swControlOptions_Enabled, Empty)
        pmOptionRed.Checked = True
        Set pmOptionGreen = pmGroup2.AddControl(lngOptionGreenID, swControlType_Option, _
            "Green", swControlAlign_Indent, swControlOptions_Visible + _
            swControlOptions_Enabled, Empty)
        Set pmOptionBlue = pmGroup2.AddControl(lngOptionBlueID, swControlType_Option, _
            "Blue", swControlAlign_Indent, swControlOptions_Visible + _
            swControlOptions_Enabled, Empty)
    
        'Display the PMP
        pmPage.Show2 0
    Else
        Debug.Print "Error creating PropertyManager page."
        Debug.Print "Error code: " & lngErrors
    End If
End Sub

Class: clsPMPHandler

Implements PropertyManagerPage2Handler8
    
Dim r As Integer, g As Integer, b As Integer
    
Private Sub PropertyManagerPage2Handler8_AfterActivation()
    r = 255
    g = 0
    b = 0
End Sub
    
Private Sub PropertyManagerPage2Handler8_AfterClose()
    
End Sub
    
Private Function PropertyManagerPage2Handler8_OnActiveXControlCreated(ByVal Id As Long, ByVal Status As Boolean) As Long
    
End Function
    
Private Sub PropertyManagerPage2Handler8_OnButtonPress(ByVal Id As Long)
    
End Sub
    
Private Sub PropertyManagerPage2Handler8_OnCheckboxCheck(ByVal Id As Long, ByVal Checked As Boolean)
    
End Sub
    
Private Sub PropertyManagerPage2Handler8_OnClose(ByVal Reason As Long)
    If Reason = swPropertyManagerPageClose_Okay Then
        Dim vMatPropValues As Variant
        vMatPropValues = swModel.MaterialPropertyValues
        swModel.SelectedFaceProperties RGB(r, g, b), vMatPropValues(3), _
            vMatPropValues(4), vMatPropValues(5), vMatPropValues(6), _
            vMatPropValues(7), vMatPropValues(8), False, Empty
    End If
    swModel.ClearSelection2 True
    r = g = b = 0
End Sub
    
Private Sub PropertyManagerPage2Handler8_OnComboboxEditChanged(ByVal Id As Long, ByVal Text As String)
    
End Sub
    
Private Sub PropertyManagerPage2Handler8_OnComboboxSelectionChanged(ByVal Id As Long, ByVal Item As Long)
    
End Sub
    
Private Sub PropertyManagerPage2Handler8_OnGainedFocus(ByVal Id As Long)
    
End Sub
    
Private Sub PropertyManagerPage2Handler8_OnGroupCheck(ByVal Id As Long, ByVal Checked As Boolean)
    
End Sub
    
Private Sub PropertyManagerPage2Handler8_OnGroupExpand(ByVal Id As Long, ByVal Expanded As Boolean)
    
End Sub
    
Private Function PropertyManagerPage2Handler8_OnHelp() As Boolean
    
End Function
    
Private Function PropertyManagerPage2Handler8_OnKeystroke(ByVal Wparam As Long, ByVal Message As Long, ByVal Lparam As Long, ByVal Id As Long) As Boolean
    
End Function
    
Private Sub PropertyManagerPage2Handler8_OnListboxRMBUp(ByVal Id As Long, ByVal PosX As Long, ByVal PosY As Long)
    
End Sub
    
Private Sub PropertyManagerPage2Handler8_OnListboxSelectionChanged(ByVal Id As Long, ByVal Item As Long)
    
End Sub
    
Private Sub PropertyManagerPage2Handler8_OnLostFocus(ByVal Id As Long)
    
End Sub
    
Private Function PropertyManagerPage2Handler8_OnNextPage() As Boolean
    
End Function
    
Private Sub PropertyManagerPage2Handler8_OnNumberboxChanged(ByVal Id As Long, ByVal Value As Double)
    
End Sub
    
Private Sub PropertyManagerPage2Handler8_OnOptionCheck(ByVal Id As Long)
    r = g = b = 0
    If Id = lngOptionRedID Then r = 255
    If Id = lngOptionGreenID Then g = 255
    If Id = lngOptionBlueID Then b = 255
End Sub
    
Private Sub PropertyManagerPage2Handler8_OnPopupMenuItem(ByVal Id As Long)
    
End Sub
    
Private Sub PropertyManagerPage2Handler8_OnPopupMenuItemUpdate(ByVal Id As Long, retval As Long)
    
End Sub
    
Private Function PropertyManagerPage2Handler8_OnPreview() As Boolean
    
End Function
    
Private Function PropertyManagerPage2Handler8_OnPreviousPage() As Boolean
    
End Function
    
Private Sub PropertyManagerPage2Handler8_OnRedo()
    
End Sub
    
Private Sub PropertyManagerPage2Handler8_OnSelectionboxCalloutCreated(ByVal Id As Long)
    
End Sub
    
Private Sub PropertyManagerPage2Handler8_OnSelectionboxCalloutDestroyed(ByVal Id As Long)
    
End Sub
    
Private Sub PropertyManagerPage2Handler8_OnSelectionboxFocusChanged(ByVal Id As Long)
    
End Sub
    
Private Sub PropertyManagerPage2Handler8_OnSelectionboxListChanged(ByVal Id As Long, ByVal Count As Long)
    
End Sub
    
Private Sub PropertyManagerPage2Handler8_OnSliderPositionChanged(ByVal Id As Long, ByVal Value As Double)
    
End Sub
    
Private Sub PropertyManagerPage2Handler8_OnSliderTrackingCompleted(ByVal Id As Long, ByVal Value As Double)
    
End Sub
    
Private Function PropertyManagerPage2Handler8_OnSubmitSelection(ByVal Id As Long, ByVal Selection As Object, ByVal SelType As Long, ItemText As String) As Boolean
    PropertyManagerPage2Handler8_OnSubmitSelection = True
End Function
    
Private Function PropertyManagerPage2Handler8_OnTabClicked(ByVal Id As Long) As Boolean
    
End Function
    
Private Sub PropertyManagerPage2Handler8_OnTextboxChanged(ByVal Id As Long, ByVal Text As String)
    
End Sub
    
Private Sub PropertyManagerPage2Handler8_OnUndo()
    
End Sub
    
Private Sub PropertyManagerPage2Handler8_OnWhatsNew()
    
End Sub
    
Private Function PropertyManagerPage2Handler8_OnWindowFromHandleControlCreated(ByVal Id As Long, ByVal Status As Boolean) As Long
    
End Function