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 objProfile As solidEdgePart.Profile
Dim objRPProfile1 As solidEdgePart.Profile
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 and validating it
Set objRevProt = objBaseModel.RevolvedProtrusions.AddFinite(Profile:=objRPProfile, RefAxis:=objRefAxis, _
profileSide:=igLeft, ProfilePlaneSide:=igSymmetric, AngleOfRevolution:=(2 * PI / 3))
objRPProfile.Visible = False
If (objRevProt.Status <> igFeatureOK) Then
MsgBox "AddFiniteRevolvedProtrusion method of the Models object fails"
End If
' getting the Profile object of the revolved protrusion feature
Set objProfile = objRevProt.Profile
' creating a new profile for the revolved protrusion feature
Set objRPProfile1 = objDoc.ProfileSets.Add.Profiles.Add(pRefPlaneDisp:=objDoc.RefPlanes(2))
Call objRPProfile1.Lines2d.AddBy2Points(x1:=0.02, y1:=-0.03, x2:=0.08, y2:=-0.03)
Call objRPProfile1.Lines2d.AddBy2Points(x1:=0.08, y1:=-0.03, x2:=0.08, y2:=0.03)
Call objRPProfile1.Lines2d.AddBy2Points(x1:=0.08, y1:=0.03, x2:=0.02, y2:=0.03)
Call objRPProfile1.Lines2d.AddBy2Points(x1:=0.02, y1:=0.03, x2:=0.02, y2:=-0.03)
Call objRPProfile1.Relations2d.AddKeypoint(Object1:=objRPProfile1.Lines2d(1), Index1:=igLineEnd, Object2:=objRPProfile1.Lines2d(2), Index2:=igLineStart)
Call objRPProfile1.Relations2d.AddKeypoint(Object1:=objRPProfile1.Lines2d(2), Index1:=igLineEnd, Object2:=objRPProfile1.Lines2d(3), Index2:=igLineStart)
Call objRPProfile1.Relations2d.AddKeypoint(Object1:=objRPProfile1.Lines2d(3), Index1:=igLineEnd, Object2:=objRPProfile1.Lines2d(4), Index2:=igLineStart)
Call objRPProfile1.Relations2d.AddKeypoint(Object1:=objRPProfile1.Lines2d(4), Index1:=igLineEnd, Object2:=objRPProfile1.Lines2d(1), Index2:=igLineStart)
lngStatus = objRPProfile1.End(ValidationCriteria:=igProfileClosed)
If (lngStatus <> 0) Then
MsgBox "Profile for the revolved protrusion feature is not closed"
End If
Set objLine = objRPProfile1.Lines2d.AddBy2Points(x1:=0, y1:=-0.1, x2:=0, y2:=0.1)
Set objRefAxis = objRPProfile1.SetAxisOfRevolution(lineforaxis:=objLine)
objRPProfile1.Visible = False
' setting the new profile to the revolved protrusion feature
objRevProt.Profile = objRPProfile1
' getting the Profile object of the revolved protrusion feature
Set objProfile = objRevProt.Profile
' 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 objProfile = Nothing
Set objRPProfile1 = Nothing
End Sub