Lesson 7.5 code - Part E

Files

Lesson 7.5 code - Part E

Code

Module: mMain

Option Explicit
    
Public swApp As SldWorks.SldWorks
Public swModel As SldWorks.ModelDoc2
Public swFeat As SldWorks.feature
Public swMacroFeatData As SldWorks.MacroFeatureData
Public swBody As SldWorks.Body2
Public swEditBody(0) As SldWorks.Body2
Public vEditBody As Variant
Public pm As PropMgr
Public dblDepth As Double
    
Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swFeat = Nothing
    Set pm = New PropMgr
    pm.Layout
End Sub

Module: mCreateBody

Sub CreateBody()
    Dim swModeler As SldWorks.Modeler
    Set swModeler = swApp.GetModeler
    Dim dblData(8) As Double
    dblData(0) = 0
    dblData(1) = 0
    dblData(2) = 0
    dblData(3) = 0
    dblData(4) = 0
    dblData(5) = 1
    dblData(6) = 0.05
    dblData(7) = dblDepth
    Set swBody = swModeler.CreateBodyFromCyl(dblData)
End Sub

Module: mMacroFeature

'Rebuild function
Function swmRebuild(app As Variant, model As Variant, feat As Variant) As Variant
    Set swApp = app
    Set swMacroFeatData = feat.GetDefinition
    Call CreateBody
    
    'Assign edge and face IDs
    Dim vEdges As Variant
    Dim vFaces As Variant
    vEdges = swBody.GetEdges
    vFaces = swBody.GetFaces
    Dim i As Integer
    For i = 0 To UBound(vEdges)
        swMacroFeatData.SetEdgeUserId vEdges(i), i, 0
    Next i
    For i = 0 To UBound(vFaces)
        swMacroFeatData.SetFaceUserId vFaces(i), i, 0
    Next i
    
    Set swmRebuild = swBody
End Function
    
'Edit definition function
Function swmEditDefinition(app As Variant, model As Variant, feat As Variant) As Variant
    Debug.Print "Edit"
End Function
    
'Security function
Function swmSecurity(app As Variant, model As Variant, feat As Variant) As Variant
    swmSecurity = SwConst.swMacroFeatureSecurityOptions_e.swMacroFeatureSecurityByDefault
End Function
    
'Insert macro feature
Sub InsertMacroFeature()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    
    'MACRO METHODS
    Dim strMacroMethods(8) As String
    'Rebuild function
    strMacroMethods(0) = swApp.GetCurrentMacroPathName
    strMacroMethods(1) = "mMacroFeature"
    strMacroMethods(2) = "swmRebuild"
    'Edit definition function
    strMacroMethods(3) = swApp.GetCurrentMacroPathName
    strMacroMethods(4) = "mMacroFeature"
    strMacroMethods(5) = "swmEditDefinition"
    'Security function (optional)
    strMacroMethods(6) = swApp.GetCurrentMacroPathName
    strMacroMethods(7) = "mMacroFeature"
    strMacroMethods(8) = "swmSecurity"
    
    'Create the macro feature
    swModel.FeatureManager.InsertMacroFeature3 "Cylinder", Empty, strMacroMethods, _
        Nothing, Nothing, Nothing, Nothing, Nothing, vEditBody, Nothing, 0
End Sub

Class: PropMgr

Option Explicit
    
Private pmPage As PropertyManagerPage2
Private pmGroup As PropertyManagerPageGroup
Private pmGroup2 As PropertyManagerPageGroup
Private pmSelBox As PropertyManagerPageSelectionbox
Private pmNumBoxExtrude As SldWorks.PropertyManagerPageNumberbox
Private pmHandler As New PropMgrHdlr
    
Sub Layout()
    Set pmHandler = New PropMgrHdlr
    
    'Create PMP
    Set pmPage = swApp.CreatePropertyManagerPage("Cylinder", _
        swPropertyManagerOptions_OkayButton + swPropertyManagerOptions_CancelButton, _
        pmHandler, Empty)
    
    'Message
    pmPage.SetMessage "Select body to modify.", swImportantMessageBox
    
    'Group box
    Set pmGroup = pmPage.AddGroupBox(0, "Input body", _
        swGroupBoxOptions_Visible + swGroupBoxOptions_Expanded)
    
    'Selection box
    Set pmSelBox = pmGroup.AddControl(1, swControlType_Selectionbox, Empty, _
        swControlAlign_Indent, swControlOptions_Visible + swControlOptions_Enabled, _
        "Select body")
    Dim filterArray(0 To 1) As Long
    filterArray(0) = swSelSOLIDBODIES
    filterArray(1) = swSelSURFACEBODIES
    pmSelBox.SetSelectionFilters filterArray
    pmSelBox.SingleEntityOnly = True
    pmSelBox.Height = 12
    pmSelBox.SetStandardPictureLabel swBitmapLabel_SelectFace
    
    'Group box
    Set pmGroup2 = pmPage.AddGroupBox(2, "Depth", swGroupBoxOptions_Expanded + _
        swGroupBoxOptions_Visible)
    
    'Number box
    Set pmNumBoxExtrude = pmGroup2.AddControl(3, swControlType_Numberbox, Empty, _
        swControlAlign_LeftEdge, swControlOptions_Visible + swControlOptions_Enabled, _
        "Depth")
    pmNumBoxExtrude.SetRange2 swNumberBox_Length, 0, 1, True, 0.005, 0.005, 0.005
    dblDepth = 0.005    'initial value
    pmNumBoxExtrude.Value = dblDepth
    
    'Show
    pmPage.Show2 0
End Sub

Class: PropMgrHdler

Option Explicit
    
Implements PropertyManagerPage2Handler9
    
Private Sub PropertyManagerPage2Handler9_AfterActivation()
    
End Sub
    
Private Sub PropertyManagerPage2Handler9_AfterClose()
    
End Sub
    
Private Function PropertyManagerPage2Handler9_OnActiveXControlCreated(ByVal Id As Long, ByVal Status As Boolean) As Long
    
End Function
    
Private Sub PropertyManagerPage2Handler9_OnButtonPress(ByVal Id As Long)
    
End Sub
    
Private Sub PropertyManagerPage2Handler9_OnCheckboxCheck(ByVal Id As Long, ByVal Checked As Boolean)
    
End Sub
    
Private Sub PropertyManagerPage2Handler9_OnClose(ByVal Reason As Long)
    If Reason = swPropertyManagerPageClose_Okay Then Call InsertMacroFeature
End Sub
    
Private Sub PropertyManagerPage2Handler9_OnComboboxEditChanged(ByVal Id As Long, ByVal Text As String)
    
End Sub
    
Private Sub PropertyManagerPage2Handler9_OnComboboxSelectionChanged(ByVal Id As Long, ByVal Item As Long)
    
End Sub
    
Private Sub PropertyManagerPage2Handler9_OnGainedFocus(ByVal Id As Long)
    
End Sub
    
Private Sub PropertyManagerPage2Handler9_OnGroupCheck(ByVal Id As Long, ByVal Checked As Boolean)
    
End Sub
    
Private Sub PropertyManagerPage2Handler9_OnGroupExpand(ByVal Id As Long, ByVal Expanded As Boolean)
    
End Sub
    
Private Function PropertyManagerPage2Handler9_OnHelp() As Boolean
    
End Function
    
Private Function PropertyManagerPage2Handler9_OnKeystroke(ByVal Wparam As Long, ByVal Message As Long, ByVal Lparam As Long, ByVal Id As Long) As Boolean
    
End Function
    
Private Sub PropertyManagerPage2Handler9_OnListboxRMBUp(ByVal Id As Long, ByVal PosX As Long, ByVal PosY As Long)
    
End Sub
    
Private Sub PropertyManagerPage2Handler9_OnListboxSelectionChanged(ByVal Id As Long, ByVal Item As Long)
    
End Sub
    
Private Sub PropertyManagerPage2Handler9_OnLostFocus(ByVal Id As Long)
    
End Sub
    
Private Function PropertyManagerPage2Handler9_OnNextPage() As Boolean
    
End Function
    
Private Sub PropertyManagerPage2Handler9_OnNumberboxChanged(ByVal Id As Long, ByVal Value As Double)
    If Id = 3 Then dblDepth = Value
End Sub
    
Private Sub PropertyManagerPage2Handler9_OnNumberBoxTrackingCompleted(ByVal Id As Long, ByVal Value As Double)
    
End Sub
    
Private Sub PropertyManagerPage2Handler9_OnOptionCheck(ByVal Id As Long)
    
End Sub
    
Private Sub PropertyManagerPage2Handler9_OnPopupMenuItem(ByVal Id As Long)
    
End Sub
    
Private Sub PropertyManagerPage2Handler9_OnPopupMenuItemUpdate(ByVal Id As Long, retval As Long)
    
End Sub
    
Private Function PropertyManagerPage2Handler9_OnPreview() As Boolean
    
End Function
    
Private Function PropertyManagerPage2Handler9_OnPreviousPage() As Boolean
    
End Function
    
Private Sub PropertyManagerPage2Handler9_OnRedo()
    
End Sub
    
Private Sub PropertyManagerPage2Handler9_OnSelectionboxCalloutCreated(ByVal Id As Long)
    
End Sub
    
Private Sub PropertyManagerPage2Handler9_OnSelectionboxCalloutDestroyed(ByVal Id As Long)
    
End Sub
    
Private Sub PropertyManagerPage2Handler9_OnSelectionboxFocusChanged(ByVal Id As Long)
    
End Sub
    
Private Sub PropertyManagerPage2Handler9_OnSelectionboxListChanged(ByVal Id As Long, ByVal Count As Long)
    
End Sub
    
Private Sub PropertyManagerPage2Handler9_OnSliderPositionChanged(ByVal Id As Long, ByVal Value As Double)
    
End Sub
    
Private Sub PropertyManagerPage2Handler9_OnSliderTrackingCompleted(ByVal Id As Long, ByVal Value As Double)
    
End Sub
    
Private Function PropertyManagerPage2Handler9_OnSubmitSelection(ByVal Id As Long, ByVal Selection As Object, ByVal SelType As Long, ItemText As String) As Boolean
    'Accept selection
    PropertyManagerPage2Handler9_OnSubmitSelection = True
    
    'Get EditBodies for use in IFeatureManager::InsertMacroFeature3
    Set swEditBody(0) = Selection
    vEditBody = swEditBody
End Function
    
Private Function PropertyManagerPage2Handler9_OnTabClicked(ByVal Id As Long) As Boolean
    
End Function
    
Private Sub PropertyManagerPage2Handler9_OnTextboxChanged(ByVal Id As Long, ByVal Text As String)
    
End Sub
    
Private Sub PropertyManagerPage2Handler9_OnUndo()
    
End Sub
    
Private Sub PropertyManagerPage2Handler9_OnWhatsNew()
    
End Sub
    
Private Function PropertyManagerPage2Handler9_OnWindowFromHandleControlCreated(ByVal Id As Long, ByVal Status As Boolean) As Long
    
End Function