Private Sub Form_Load()
    Dim objApp As SolidEdgeFramework.Application
    Dim objDoc As SolidEdgePart.PartDocument
    Dim objRefAxis As SolidEdgePart.RefAxis
    Dim objModel As SolidEdgePart.Model
    Dim objProfile As SolidEdgePart.Profile
    Dim objProfileArray(1 To 2) As SolidEdgePart.Profile
    Dim objCutProfArray(1 To 3) As SolidEdgePart.Profile
    Dim objLines As SolidEdgeFrameworkSupport.Lines2d
    Dim objRelns1 As SolidEdgeFrameworkSupport.Relations2d
    Dim objRelns As SolidEdgeFrameworkSupport.Relations2d
    Dim objCutLines1 As SolidEdgeFrameworkSupport.Lines2d
    Dim objRelns2 As SolidEdgeFrameworkSupport.Relations2d
    Dim objCutLines2 As SolidEdgeFrameworkSupport.Lines2d
    Dim objRevCutout As SolidEdgePart.RevolvedCutout
    Dim objRefPln As SolidEdgePart.RefPlane
    Dim objLine As SolidEdgeFrameworkSupport.Line2d
    Dim objRCProfCollection As SolidEdgePart.Profiles
    Dim lngStatus As Long
    Dim i As Integer
    ' 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
    ' Draw the Profile
    Set objProfileArray(1) = objDoc.ProfileSets.Add.Profiles.Add(pRefPlaneDisp:=objDoc.RefPlanes(1))
    Set objLines = objProfileArray(1).Lines2d
    Call objLines.AddBy2Points(x1:=0, y1:=0, x2:=0.08, y2:=0)
    Call objLines.AddBy2Points(x1:=0.08, y1:=0, x2:=0.08, y2:=0.08)
    Call objLines.AddBy2Points(x1:=0.08, y1:=0.08, x2:=0, y2:=0.08)
    Call objLines.AddBy2Points(x1:=0, y1:=0.08, x2:=0, y2:=0)
    ' Relate the Lines to make the Profile closed
    Set objRelns = objProfileArray(1).Relations2d
    Call objRelns.AddKeypoint(Object1:=objLines(1), Index1:=igLineEnd, Object2:=objLines(2), Index2:=igLineStart)
    Call objRelns.AddKeypoint(Object1:=objLines(2), Index1:=igLineEnd, Object2:=objLines(3), Index2:=igLineStart)
    Call objRelns.AddKeypoint(Object1:=objLines(3), Index1:=igLineEnd, Object2:=objLines(4), Index2:=igLineStart)
    Call objRelns.AddKeypoint(Object1:=objLines(4), Index1:=igLineEnd, Object2:=objLines(1), Index2:=igLineStart)
    ' Check for the Profile Validity
    lngStatus = objProfileArray(1).End(ValidationCriteria:=igProfileClosed)
    If lngStatus <> 0 Then
        MsgBox ("Profile not closed")
    End If
    ' Create the Base Protrusion Object
    Set objModel = objDoc.Models.AddFiniteExtrudedProtrusion(NumberOfProfiles:=1, _
                                                             ProfileArray:=objProfileArray, ProfilePlaneSide:=igRight, _
                                                             ExtrusionDistance:=0.08)
    objProfileArray(1).Visible = False
    ' Check the status of Base Feature
    If objModel.ExtrudedProtrusions(1).Status <> igFeatureOK Then
        MsgBox ("Error in the Creation of Base Protrusion Feature object")
    End If

    ' Create the Revolved Cutout Profile
    Set objRefPln = objDoc.RefPlanes.AddParallelByDistance(ParentPlane:=objDoc.RefPlanes(1), Distance:=0.04, NormalSide:=igRight)
    Set objProfile = objDoc.ProfileSets.Add.Profiles.Add(pRefPlaneDisp:=objRefPln)
    Set objCutLines1 = objProfile.Lines2d
    Call objCutLines1.AddBy2Points(x1:=-0.02, y1:=0, x2:=0.02, y2:=0)
    Call objCutLines1.AddBy2Points(x1:=0.02, y1:=0, x2:=0.02, y2:=0.02)
    Call objCutLines1.AddBy2Points(x1:=0.02, y1:=0.02, x2:=-0.02, y2:=0.02)
    Call objCutLines1.AddBy2Points(x1:=-0.02, y1:=0.02, x2:=-0.02, y2:=0)
    ' Relate the Lines to make the Profile closed
    Set objRelns1 = objProfile.Relations2d
    Call objRelns1.AddKeypoint(Object1:=objCutLines1(1), Index1:=igLineEnd, Object2:=objCutLines1(2), Index2:=igLineStart)
    Call objRelns1.AddKeypoint(Object1:=objCutLines1(2), Index1:=igLineEnd, Object2:=objCutLines1(3), Index2:=igLineStart)
    Call objRelns1.AddKeypoint(Object1:=objCutLines1(3), Index1:=igLineEnd, Object2:=objCutLines1(4), Index2:=igLineStart)
    Call objRelns1.AddKeypoint(Object1:=objCutLines1(4), Index1:=igLineEnd, Object2:=objCutLines1(1), Index2:=igLineStart)

    ' Create another Revolved Cutout Profile
    Call objCutLines1.AddBy2Points(x1:=-0.02, y1:=0.06, x2:=0.02, y2:=0.06)
    Call objCutLines1.AddBy2Points(x1:=0.02, y1:=0.06, x2:=0.02, y2:=0.08)
    Call objCutLines1.AddBy2Points(x1:=0.02, y1:=0.08, x2:=-0.02, y2:=0.08)
    Call objCutLines1.AddBy2Points(x1:=-0.02, y1:=0.08, x2:=-0.02, y2:=0.06)
    ' Relate the Lines to make the Profile closed
    Call objRelns1.AddKeypoint(Object1:=objCutLines1(5), Index1:=igLineEnd, Object2:=objCutLines1(6), Index2:=igLineStart)
    Call objRelns1.AddKeypoint(Object1:=objCutLines1(6), Index1:=igLineEnd, Object2:=objCutLines1(7), Index2:=igLineStart)
    Call objRelns1.AddKeypoint(Object1:=objCutLines1(7), Index1:=igLineEnd, Object2:=objCutLines1(8), Index2:=igLineStart)
    Call objRelns1.AddKeypoint(Object1:=objCutLines1(8), Index1:=igLineEnd, Object2:=objCutLines1(5), Index2:=igLineStart)
    ' Check for the Profile Validity
    lngStatus = objProfile.End(ValidationCriteria:=igProfileClosed)
    If lngStatus <> 0 Then
        MsgBox ("Profile not closed")
    End If
    'Get the Profile Array
    Set objRCProfCollection = objProfile.Parent.Profiles
    For i = 1 To objRCProfCollection.Count
        Set objCutProfArray(i) = objRCProfCollection(i)
    Next i
    ' Create the Revolution Axis
    Set objLine = objDoc.ProfileSets(1).Profiles.Add(pRefPlaneDisp:=objRefPln). _
                  Lines2d.AddBy2Points(x1:=0.04, y1:=0.04, x2:=0.04, y2:=0)
    Set objRefAxis = objDoc.ProfileSets(1).Profiles(2).SetAxisOfRevolution(LineForAxis:=objLine)
    ' Create the Revolved Cutout with no optional arguments and Profileside set to igRight
    Set objRevCutout = objModel.RevolvedCutouts.AddFiniteMulti( _
                       NumberOfProfiles:=2, ProfileArray:=objCutProfArray, _
                       RefAxis:=objRefAxis)
    objCutProfArray(1).Visible = False
    objCutProfArray(2).Visible = False
    ' USER DISPLAY
    ' Release objects
    Set objApp = Nothing
    Set objDoc = Nothing
    Set objRefAxis = Nothing
    Set objModel = Nothing
    Set objProfile = Nothing
    Set objProfileArray(1) = Nothing
    Set objLines = Nothing
    Set objProfileArray(2) = Nothing
    Set objRelns1 = Nothing
    Set objRelns2 = Nothing
    Set objRelns = Nothing
    Set objCutProfArray(1) = Nothing
    Set objCutProfArray(2) = Nothing
    Set objCutProfArray(3) = Nothing
    Set objCutLines1 = Nothing
    Set objRefPln = Nothing
    Set objCutLines2 = Nothing
    Set objRevCutout = Nothing
    Set objLine = Nothing
    Set objRCProfCollection = Nothing
End Sub