Private Sub Form_Load()
Dim objApp As SolidEdgeFramework.Application
Dim objDoc As SolidEdgePart.PartDocument
Dim objProfile As SolidEdgePart.Profile
Dim objLine As SolidEdgeFrameworkSupport.Line2d
Dim objRefAxis As SolidEdgePart.RefAxis
Dim objModel As SolidEdgePart.Model
Dim objProfileArray(1 To 2) As SolidEdgePart.Profile
Dim objRevCutout As SolidEdgePart.RevolvedCutout
Dim objCutoutProfile As SolidEdgePart.Profile
Dim objCutoutLine As SolidEdgeFrameworkSupport.Line2d
Dim objCutoutRefAxis As SolidEdgePart.RefAxis
Dim objRCAxis As SolidEdgePart.RefAxis
Dim objRefAxis1 As SolidEdgePart.RefAxis
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 (Revolved Protrusion)
' creating the cross-section profile and the reference axis for the base feature
Set objProfile = objDoc.ProfileSets.Add.Profiles.Add(pRefPlaneDisp:=objDoc.RefPlanes(2))
Call objProfile.Circles2d.AddByCenterRadius(x:=0.05, y:=0, Radius:=0.025)
lngStatus = objProfile.End(ValidationCriteria:=igProfileClosed)
If (lngStatus <> 0) Then
MsgBox "Profile for the base feature is not closed"
End If
Set objLine = objProfile.Lines2d.AddBy2Points(x1:=0, y1:=-0.05, x2:=0, y2:=0.05)
Set objRefAxis = objProfile.SetAxisOfRevolution(LineForAxis:=objLine)
' creating the revolved protrusion feature and validating it
Set objProfileArray(1) = objProfile.Parent.Profiles(1)
Set objModel = objDoc.Models.AddFiniteRevolvedProtrusion(NumberOfProfiles:=1, ProfileArray:=objProfileArray, _
ReferenceAxis:=objRefAxis, ProfilePlaneSide:=igSymmetric, AngleOfRevolution:=(3 * PI / 2))
objProfileArray(1).Visible = False
If (objModel.RevolvedProtrusions(1).Status <> igFeatureOK) Then
MsgBox "AddFiniteRevolvedProtrusion method of the Models object fails"
End If
' *** creating a Revolved Cutout in the Base Feature towards right
' creating the cross-section and the reference axis for the revolved cutout feature
Set objCutoutProfile = objDoc.ProfileSets.Add.Profiles.Add(pRefPlaneDisp:=objDoc.RefPlanes(2))
Call objCutoutProfile.Circles2d.AddByCenterRadius(x:=0.05, y:=0, Radius:=0.01)
lngStatus = objCutoutProfile.End(ValidationCriteria:=igProfileClosed)
If (lngStatus <> 0) Then
MsgBox "profile for the revolved cutout feature is not closed"
End If
Set objCutoutLine = objCutoutProfile.Lines2d.AddBy2Points(x1:=0, y1:=-0.05, x2:=0, y2:=0.05)
Set objCutoutRefAxis = objCutoutProfile.SetAxisOfRevolution(LineForAxis:=objCutoutLine)
' creating the revolved cutout feature and validating it
Set objRevCutout = objModel.RevolvedCutouts.AddFinite(Profile:=objCutoutProfile, _
RefAxis:=objCutoutRefAxis, profileSide:=igLeft, ProfilePlaneSide:=igSymmetric, AngleOfRevolution:=(3 * PI / 4))
objCutoutProfile.Visible = False
If (objModel.RevolvedCutouts(1).Status <> igFeatureOK) Then
MsgBox "AddFinite method of the RevolvedCutouts object fails"
End If
' getting the axis object of the revolved cutout feature
Set objRCAxis = objRevCutout.Axis
' creating another axis for revolution
'Create a New Line to be set as ReferenceAxis
objLine.Delete
Set objLine = Nothing
Set objLine = objCutoutProfile.Lines2d.AddBy2Points(x1:=-0.05, y1:=-0.05, x2:=-0.05, y2:=0.05)
Set objRefAxis1 = objCutoutProfile.SetAxisOfRevolution(LineForAxis:=objLine)
objRevCutout.Axis = objRefAxis1
' USER DISPLAY
' Release objects
Set objApp = Nothing
Set objDoc = Nothing
Set objProfile = Nothing
Set objLine = Nothing
Set objRefAxis = Nothing
Set objModel = Nothing
Set objProfileArray(1) = Nothing
Set objRevCutout = Nothing
Set objCutoutProfile = Nothing
Set objCutoutLine = Nothing
Set objCutoutRefAxis = Nothing
Set objRefAxis1 = Nothing
Set objRCAxis = Nothing
End Sub