Dim objApp As SolidEdgeFramework.Application
Dim objDoc As SolidEdgePart.PartDocument
Dim objBaseProf(1 To 2) As SolidEdgePart.Profile
Dim objCirc1 As SolidEdgeFrameworkSupport.Circle2d
Dim objModel As SolidEdgePart.Model
Dim objLoftProf(1 To 3) As SolidEdgePart.Profile
Dim objRefPln As SolidEdgePart.RefPlane
Dim objLoftProt As SolidEdgePart.LoftedProtrusion
Dim objEdges As Object
Dim lngStatus As Long
Dim xOrigin As Double, yOrigin As Double
Dim OriginArray(1 To 3) As Variant
Dim Origin(1 To 2) As Double
Dim SectionTypes(1 To 3) 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
On Error GoTo 0
' Create the Base Protrusion Feature
' Create the Base Profile
Set objBaseProf(1) = objDoc.ProfileSets.Add.Profiles.Add(pRefPlaneDisp:=objDoc.RefPlanes(1))
Set objCirc1 = objBaseProf(1).Circles2d.AddByCenterRadius(x:=0, y:=0, Radius:=0.02)
' Check for the Profile Validity
lngStatus = objBaseProf(1).End(ValidationCriteria:=igProfileClosed)
If lngStatus <> 0 Then
    MsgBox ("Profile not closed")
End If
' Create the Protrusion
Set objModel = objDoc.Models.AddFiniteExtrudedProtrusion(NumberOfProfiles:= _
                                                         1, ProfileArray:=objBaseProf, _
                                                         ProfilePlaneSide:=igRight, _
                                                         ExtrusionDistance:=0.05)
objBaseProf(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 a new Profile to use as the First Section
Set objRefPln = objDoc.RefPlanes.AddParallelByDistance(ParentPlane:= _
                                                       objDoc.RefPlanes(1), Distance:=0.05, NormalSide:=igRight)
Set objLoftProf(1) = objDoc.ProfileSets.Add.Profiles.Add(pRefPlaneDisp:=objRefPln)
Set objCirc1 = objLoftProf(1).Circles2d.AddByCenterRadius(x:=0, y:=0, Radius:=0.02)
' Get the model space origin relative to profile space.
Call objLoftProf(1).Convert3DCoordinate(x3d:=0, y3d:=0, z3d:=0, _
                                        x2d:=xOrigin, y2d:=yOrigin)
' Save the coordinates to define the start point for this profile.
Origin(1) = xOrigin
Origin(2) = yOrigin
OriginArray(1) = Origin
' End and validate the profile.
lngStatus = objLoftProf(1).End(ValidationCriteria:=igProfileClosed)
If lngStatus <> 0 Then
    MsgBox ("Invalid Profile")
End If
' Turn off the display of the profile.
objLoftProf(1).Visible = False
' Create a new reference plane.
Set objRefPln = objDoc.RefPlanes.AddParallelByDistance( _
                ParentPlane:=objDoc.RefPlanes(1), Distance:=0.1, _
                NormalSide:=igRight)
' Create a new profile set and profile to use for the 2nd section.
Set objLoftProf(2) = objDoc.ProfileSets.Add.Profiles.Add(pRefPlaneDisp:=objRefPln)
' Get the model space origin relative to profile space.
Call objLoftProf(2).Convert3DCoordinate(x3d:=0, y3d:=0, z3d:=0, _
                                        x2d:=xOrigin, y2d:=yOrigin)
' Save the coordinates to define the start point for this profile.
Origin(1) = xOrigin
Origin(2) = yOrigin
OriginArray(2) = Origin
' Set a reference to the Circle2d
Set objCirc1 = objLoftProf(2).Circles2d.AddByCenterRadius(x:=0, y:=0, Radius:=0.035)

' End and validate the profile.
lngStatus = objLoftProf(2).End(ValidationCriteria:=igProfileClosed)
If lngStatus <> 0 Then
    MsgBox ("Invalid Profile")
End If
' Turn off the display of the profile.
objLoftProf(2).Visible = False
For i = 1 To 2
    SectionTypes(i) = igProfileBasedCrossSection
Next
' Build up an array of the origin positions.
Set objLoftProt = objDoc.Models(1).LoftedProtrusions.AddSimple( _
                  NumSections:=2, CrossSections:=objLoftProf, _
                  CrossSectionTypes:=SectionTypes, Origins:=OriginArray, _
                  MaterialSide:=igLeft, StartTangentType:=igNone, _
                  EndTangentType:=igNone)

' Check the Status of the Feature
If objLoftProt.Status <> igFeatureOK Then
    MsgBox ("AddSimple method of LoftedCutouts object failed")
End If
' Get the Edges property
Set objEdges = objLoftProt.Edges(EdgeType:=igQueryAll)
' USER DISPLAY
' Release objects
Set objApp = Nothing
Set objDoc = Nothing
Set objBaseProf(1) = Nothing
Set objBaseProf(2) = Nothing
Set objCirc1 = Nothing
Set objModel = Nothing
Set objLoftProf(1) = Nothing
Set objLoftProf(2) = Nothing
Set objLoftProf(3) = Nothing
Set objLoftProt = Nothing
Set objEdges = Nothing
Set objRefPln = Nothing
End Sub