Private Sub Form_Load()
    Dim objApp As SolidEdgeFrameWork.Application
    Dim objDoc As SolidEdgePart.PartDocument
    Dim objBaseProfile(1 To 2) As SolidEdgePart.Profile
    Dim objLine1 As SolidEdgeFrameworkSupport.Line2d
    Dim objLine2 As SolidEdgeFrameworkSupport.Line2d
    Dim objArc1 As SolidEdgeFrameworkSupport.Arc2d
    Dim objArc2 As SolidEdgeFrameworkSupport.Arc2d
    Dim objModel As SolidEdgePart.Model
    Dim objExtProtrusion As SolidEdgePart.ExtrudedProtrusion
    Dim objRelations As SolidEdgeFrameworkSupport.Relations2d
    Dim objTraceRefPlane As SolidEdgePart.RefPlane
    Dim objTraceprofile(1 To 2) As SolidEdgePart.Profile
    Dim objCSRefPlane As SolidEdgePart.RefPlane
    Dim objCSProfile(1 To 2) As SolidEdgePart.Profile
    Dim vOriginArray(2) As Variant
    Dim objSweptProtrusion As SolidEdgePart.SweptProtrusion
    Dim objFacesByRay As Object
    Dim lngStatus As Long
    Dim lngTraceCurveTypes(1 To 2) As FeaturePropertyConstants
    Dim lngCrossSectionTypes(1 To 2) As FeaturePropertyConstants
    ' Report errors
    Const PI = 3.14159265358979
    ' Create/get the application with specific settings
    On Error Resume Next
    Set objApp = GetObject(, "SolidEdge.Application")
    If Err Then
        Err.Clear
        Set objApp = CreateObject("SolidEdge.Application")
        Set objDoc = objApp.Documents.Add("SolidEdge.PartDocument")
        objApp.Visible = True
    Else
        Set objDoc = objApp.ActiveDocument
    End If
    On Error GoTo 0

    'Create an Extruded Protrusion as Base feature
    Set objBaseProfile(1) = objDoc.ProfileSets.Add.Profiles.Add(pRefPlaneDisp:=objDoc.RefPlanes(1))
    Set objLine1 = objBaseProfile(1).Lines2d.AddBy2Points(x1:=0.05, y1:=0, x2:=0.05, y2:=0.15)
    Set objArc1 = objBaseProfile(1).Arcs2d.AddByCenterStartEnd(xCenter:=0.025, yCenter:=0.15, _
                                                               xStart:=0.05, yStart:=0.15, xEnd:=0, yEnd:=0.15)
    Set objLine2 = objBaseProfile(1).Lines2d.AddBy2Points(x1:=0, y1:=0.15, x2:=0, y2:=0)
    Set objArc2 = objBaseProfile(1).Arcs2d.AddByCenterStartEnd(xCenter:=0.025, yCenter:=0, _
                                                               xStart:=0, yStart:=0, xEnd:=0.05, yEnd:=0)
    Set objRelations = objBaseProfile(1).Relations2d
    objRelations.AddKeypoint Object1:=objLine1, Index1:=igLineEnd, Object2:=objArc1, Index2:=igArcStart
    objRelations.AddKeypoint Object1:=objArc1, Index1:=igArcEnd, Object2:=objLine2, Index2:=igLineStart
    objRelations.AddKeypoint Object1:=objLine2, Index1:=igLineEnd, Object2:=objArc2, Index2:=igArcStart
    objRelations.AddKeypoint Object1:=objArc2, Index1:=igArcEnd, Object2:=objLine1, Index2:=igLineStart
    lngStatus = objBaseProfile(1).End(ValidationCriteria:=igProfileClosed)
    If lngStatus <> 0 Then
        MsgBox ("Base feature profile is not closed")
    End If

    Set objModel = objDoc.Models.AddFiniteExtrudedProtrusion(NumberOfProfiles:=1, ProfileArray:=objBaseProfile, _
                                                             ProfilePlaneSide:=igRight, ExtrusionDistance:=0.05)
    objBaseProfile(1).Visible = False
    Set objExtProtrusion = objModel.ExtrudedProtrusions(1)
    If objExtProtrusion.Status <> igFeatureOK Then
        MsgBox "Base Feature is not created properly"
    End If
    'Create SweptProtrusion with Add method
    Set objTraceRefPlane = objDoc.RefPlanes.AddParallelByDistance(ParentPlane:=objDoc.RefPlanes(1), _
                                                                  Distance:=0.05, NormalSide:=igRight, Local:=True)
    Set objTraceprofile(1) = objDoc.ProfileSets.Add.Profiles.Add(pRefPlaneDisp:=objTraceRefPlane)
    Set objLine1 = objTraceprofile(1).Lines2d.AddBy2Points(x1:=0.05, y1:=0, x2:=0.05, y2:=0.15)
    Set objArc1 = objTraceprofile(1).Arcs2d.AddByCenterStartEnd(xCenter:=0.025, yCenter:=0.15, _
                                                                xStart:=0.05, yStart:=0.15, xEnd:=0, yEnd:=0.15)
    Set objLine2 = objTraceprofile(1).Lines2d.AddBy2Points(x1:=0, y1:=0.15, x2:=0, y2:=0)
    Set objArc2 = objTraceprofile(1).Arcs2d.AddByCenterStartEnd(xCenter:=0.025, yCenter:=0, _
                                                                xStart:=0, yStart:=0, xEnd:=0.05, yEnd:=0)
    Set objRelations = objTraceprofile(1).Relations2d
    objRelations.AddKeypoint Object1:=objLine1, Index1:=igLineEnd, Object2:=objArc1, Index2:=igArcStart
    objRelations.AddKeypoint Object1:=objArc1, Index1:=igArcEnd, Object2:=objLine2, Index2:=igLineStart
    objRelations.AddKeypoint Object1:=objLine2, Index1:=igLineEnd, Object2:=objArc2, Index2:=igArcStart
    objRelations.AddKeypoint Object1:=objArc2, Index1:=igArcEnd, Object2:=objLine1, Index2:=igLineStart
    lngStatus = objTraceprofile(1).End(ValidationCriteria:=igProfileClosed)
    If lngStatus <> 0 Then
        MsgBox ("Trace profile is not closed")
    End If
    Set objCSRefPlane = objDoc.RefPlanes.AddNormalToCurve( _
                        Curve:=objLine1, _
                        PlanePoint:=igCurveStart, _
                        OrientationPlaneOrPivot:=objDoc.RefPlanes(1), _
                        PivotOrigin:=igPivotEnd, _
                        Local:=True, _
                        ParentCurve:=objTraceprofile(1))
    Set objCSProfile(1) = objDoc.ProfileSets.Add.Profiles.Add(pRefPlaneDisp:=objCSRefPlane)
    Call objCSProfile(1).Circles2d.AddByCenterRadius(x:=0, y:=0, Radius:=0.01)
    lngStatus = objCSProfile(1).End(ValidationCriteria:=igProfileClosed)
    If lngStatus <> 0 Then
        MsgBox ("Cross-section profile is not closed")
    End If
    lngTraceCurveTypes(1) = igProfileBasedCrossSection
    lngCrossSectionTypes(1) = igProfileBasedCrossSection
    vOriginArray(1) = 0
    Set objSweptProtrusion = objModel.SweptProtrusions.Add(NumCurves:=1, _
                                                           TraceCurves:=objTraceprofile, TraceCurveTypes:=lngTraceCurveTypes, NumSections:=1, _
                                                           CrossSections:=objCSProfile, CrossSectionTypes:=lngCrossSectionTypes, _
                                                           Origins:=vOriginArray, SegmentMaps:=0, MaterialSide:=igLeft, StartExtentType:=igNone, _
                                                           StartExtentDistance:=0, StartSurfaceOrRefPlane:=Nothing, EndExtentType:=igNone, _
                                                           EndExtentDistance:=0, EndSurfaceOrRefPlane:=Nothing)
    objTraceprofile(1).Visible = False
    objCSProfile(1).Visible = False
    If objSweptProtrusion.Status <> igFeatureOK Then
        MsgBox "SweptProtrusion Feature Failed"
    End If
    'Get the Faces collection using FacesByRay property
    Set objFacesByRay = objSweptProtrusion.FacesByRay(Xorigin:=0.025, Yorigin:=0, Zorigin:=0.055, _
                                                      Xdir:=0, Ydir:=1, Zdir:=0)
    ' USER DISPLAY
    ' Release objects
    Set objApp = Nothing
    Set objDoc = Nothing
    Set objBaseProfile(1) = Nothing
    Set objBaseProfile(2) = Nothing
    Set objLine1 = Nothing
    Set objLine2 = Nothing
    Set objArc1 = Nothing
    Set objArc2 = Nothing
    Set objModel = Nothing
    Set objExtProtrusion = Nothing
    Set objRelations = Nothing
    Set objTraceRefPlane = Nothing
    Set objTraceprofile(1) = Nothing
    Set objTraceprofile(2) = Nothing
    Set objCSRefPlane = Nothing
    Set objCSProfile(1) = Nothing
    Set objCSProfile(2) = Nothing
    Set vOriginArray(1) = Nothing
    Set vOriginArray(2) = Nothing
    Set objSweptProtrusion = Nothing
    Set objFacesByRay = Nothing
End Sub