Lesson 7.5 code - Part B

Files

Lesson 7.5 code - Part B

Code

Module: mMacroFeature

Public swApp As SldWorks.SldWorks
Public swModel As SldWorks.ModelDoc2
Public swBody As SldWorks.Body2
Public swMacroFeatData As SldWorks.MacroFeatureData
    
'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 main()
    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, Nothing, Nothing, 0
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) = 0.01
    Set swBody = swModeler.CreateBodyFromCyl(dblData)
End Sub