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 objRPItem As solidEdgePart.RevolvedProtrusion
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.025)
lngStatus = objBaseProfile.End(ValidationCriteria:=igProfileClosed)
If (lngStatus <> 0) Then
MsgBox "Profile for the base feature is not closed"
Exit Sub
End If
' creating the base extruded protrusion 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 method of the Models object fails"
Exit Sub
End If
objBaseProfile.Visible = False
' *** creating a Revolved Protrusion on the base feature towards the left side
' creating the profile for the revolved protrusion feature
Set objRPProfile = objDoc.ProfileSets.Add.Profiles.Add(pRefPlaneDisp:=objDoc.RefPlanes(3))
Call objRPProfile.Circles2d.AddByCenterRadius(x:=0.05, y:=0, Radius:=0.015)
Set objLine = objRPProfile.Lines2d.AddBy2Points(x1:=0, y1:=-0.05, x2:=0, y2:=0.05)
Set objRefAxis = objRPProfile.SetAxisOfRevolution(lineforaxis:=objLine)
lngStatus = objRPProfile.End(ValidationCriteria:=igProfileClosed)
If (lngStatus <> 0) Then
MsgBox "Profile for the revolved protrusion feature is not closed"
Exit Sub
End If
' creating the revolved protrusion feature and validating it
Set objRevProt = objBaseModel.RevolvedProtrusions.AddFinite(Profile:=objRPProfile, _
RefAxis:=objRefAxis, ProfileSide:=igLeft, ProfilePlaneSide:=igLeft, _
AngleOfRevolution:=PI)
objRPProfile.Visible = False
If (objRevProt.Status <> igFeatureOK) Then
MsgBox "AddFinite method of the Revolved Protrusions object fails"
End If
' getting a particular item from the revolved protrusions collection object
Set objRPItem = objBaseModel.RevolvedProtrusions.Item(1)
' 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
Set objRPItem = Nothing
End Sub