Lesson 4.2a code

Files

Lesson 4.2a code Associated model(s)

Code

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSketchMgr As SldWorks.SketchManager
Dim swFeatMgr As SldWorks.FeatureManager
    
Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swSketchMgr = swModel.SketchManager
    Set swFeatMgr = swModel.FeatureManager
    
    'create plate sketch profile
    swModel.Extension.SelectByID2 "Front Plane", "PLANE", 0, 0, 0, False, 0, Nothing, 0
    swSketchMgr.InsertSketch True
    swSketchMgr.CreateCircleByRadius 0, 0, 0, 0.05
    swModel.Extension.SelectByID2 "", "EXTSKETCHPOINT", 0, 0, 0, False, 6, Nothing, 0
    swSketchMgr.FullyDefineSketch True, True, 1023, True, 1, Nothing, 1, Nothing, 0, 0
    
    'create mid-plane base extrusion
    swFeatMgr.FeatureExtrusion2 True, False, False, 6, 0, 0.01, 0, False, False, False, _
        False, 0, 0, False, False, False, False, True, True, True, 0, 0, False
        
    'create extrude cut profile
    swModel.Extension.SelectByID2 "Front Plane", "PLANE", 0, 0, 0, False, 0, Nothing, 0
    swSketchMgr.InsertSketch True
    swSketchMgr.CreateCircleByRadius -0.04, 0, 0, 0.004
    swModel.Extension.SelectByID2 "", "EXTSKETCHPOINT", 0, 0, 0, False, 6, Nothing, 0
    swSketchMgr.FullyDefineSketch True, True, 1023, True, 1, Nothing, 1, Nothing, 0, 0
    
    'create bi-directional cut extrude
    swFeatMgr.FeatureCut3 False, False, False, 1, 1, 0.01, 0.01, False, False, False, False, _
        0, 0, False, False, False, False, False, True, True, True, True, False, 0, 0, False
    
    'create an axis
    swModel.Extension.SelectByID2 "Top Plane", "PLANE", 0, 0, 0, False, 0, Nothing, 0
    swModel.Extension.SelectByID2 "Right Plane", "PLANE", 0, 0, 0, True, 0, Nothing, 0
    swModel.InsertAxis2 True
    
    'create a circular pattern of extrude cut
    swModel.Extension.SelectByID2 "Axis1", "AXIS", 0, 0, 0, False, 1, Nothing, 0
    swModel.Extension.SelectByID2 "Cut-Extrude1", "BODYFEATURE", 0, 0, 0, True, 4, Nothing, 0
    swFeatMgr.FeatureCircularPattern2 10, 2 * 4 * Atn(1) / 10, False, "", False
    
    'create a simple fillet on outside edges
    Dim swPart As SldWorks.PartDoc
    Dim vBodies As Variant
    Dim swBody As SldWorks.Body2
    Dim vFaces As Variant
    Dim swFace As SldWorks.Face2
    Dim swFinalFace As SldWorks.Face2
    Dim swSurf As SldWorks.Surface
    Dim swEnt As SldWorks.Entity
    Dim i As Integer
    Dim dblArea As Double
    
    dblArea = 0
    Set swPart = swModel
    vBodies = swPart.GetBodies2(swSolidBody, False)
    Set swBody = vBodies(0) 'assumes only one solid body in part
    vFaces = swBody.GetFaces
    For i = 0 To UBound(vFaces)
        Set swFace = vFaces(i)
        Set swSurf = swFace.GetSurface
        If swSurf.IsCylinder Then
            If swFace.GetArea > dblArea Then
                dblArea = swFace.GetArea
                Set swFinalFace = swFace
            End If
        End If
    Next i
    Set swEnt = swFinalFace
    swEnt.Select4 False, Nothing
    swFeatMgr.FeatureFillet 2, 0.001, 0, 0, Empty, Empty, Empty
    
    'change material
    swPart.SetMaterialPropertyName2 "", "", "Plain Carbon Steel"
End Sub