Private Sub Form_Load()
Dim objApp As solidEdgeFramework.Application
Dim objDoc As solidEdgePart.PartDocument
Dim objBaseProfile As solidEdgePart.Profile
Dim objBaseProfileArray(1 To 2) As solidEdgePart.Profile
Dim objBaseModel As solidEdgePart.Model
Dim objRPProfile As solidEdgePart.Profile
Dim objLine As solidEdgeFrameworkSupport.Line2d
Dim objRefAxis As solidEdgePart.RefAxis
Dim objRevProt As solidEdgePart.RevolvedProtrusion
Dim lngType As Long
Dim lngStatus As Long
' 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
' *** creating the base feature
' creating the profile for the base feature and validating it
Set objBaseProfile = objDoc.ProfileSets.Add.Profiles.Add(pRefPlaneDisp:=objDoc.RefPlanes(1))
Call objBaseProfile.Circles2d.AddByCenterRadius(x:=0, y:=0, Radius:=0.01)
lngStatus = objBaseProfile.End(ValidationCriteria:=igProfileClosed)
If lngStatus <> 0 Then
MsgBox "Profile for the base feature is not closed"
End If
' creating the base extruded protrusion feature and validating it
Set objBaseProfileArray(1) = objBaseProfile
Set objBaseModel = objDoc.Models.AddFiniteExtrudedProtrusion(NumberOfProfiles:=1, _
ProfileArray:=objBaseProfileArray, ProfilePlaneSide:=igSymmetric, ExtrusionDistance:=0.1)
If (objBaseModel.ExtrudedProtrusions(1).Status <> igFeatureOK) Then
MsgBox "AddFiniteExtrudedProtrusion of Models object fails"
End If
objBaseProfile.Visible = False
' *** creating a revolved protrusion feature
' creating the ref axis & profile and validating it
Set objRPProfile = objDoc.ProfileSets.Add.Profiles.Add(pRefPlaneDisp:=objDoc.RefPlanes(2))
Call objRPProfile.Circles2d.AddByCenterRadius(x:=0.05, y:=0, Radius:=0.025)
lngStatus = objRPProfile.End(ValidationCriteria:=igProfileClosed)
If (lngStatus <> 0) Then
MsgBox "Profile for the revolved protrusion feature is not closed"
End If
Set objLine = objRPProfile.Lines2d.AddBy2Points(x1:=0, y1:=-0.05, x2:=0, y2:=0.05)
Set objRefAxis = objRPProfile.SetAxisOfRevolution(lineforaxis:=objLine)
' creating the revolved protrusion
Set objRevProt = objBaseModel.RevolvedProtrusions.AddFinite(Profile:=objRPProfile, RefAxis:=objRefAxis, _
profileSide:=igLeft, ProfilePlaneSide:=igSymmetric, AngleOfRevolution:=(2 * PI / 3))
objRPProfile.Visible = False
' getting the status of the revolved protrusion feature
lngStatus = objRevProt.Status
' USER DISPLAY
' Release objects
Set objApp = Nothing
Set objDoc = Nothing
Set objBaseProfile = Nothing
Set objBaseProfileArray(1) = Nothing
Set objBaseModel = Nothing
Set objRPProfile = Nothing
Set objLine = Nothing
Set objRefAxis = Nothing
Set objRevProt = Nothing
End Sub