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 objTCRefPlane As SolidEdgePart.RefPlane
Dim objTCProfile As SolidEdgePart.Profile
Dim objTCRefAxis As SolidEdgePart.RefAxis
Dim objTCRevProt As SolidEdgePart.RevolvedProtrusion
Dim objTCLine As SolidEdgeFrameworkSupport.Line2d
Dim objBCRefPlane As SolidEdgePart.RefPlane
Dim objBCProfile As SolidEdgePart.Profile
Dim objBCRefAxis As SolidEdgePart.RefAxis
Dim objBCRevProt As SolidEdgePart.RevolvedProtrusion
Dim objBCLine As SolidEdgeFrameworkSupport.Line2d
Dim dblAngle As Double
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:=(PI))
objProfileArray(1).Visible = False
If (objModel.RevolvedProtrusions(1).Status <> igFeatureOK) Then
MsgBox "AddFiniteRevolvedProtrusion method of the Models object fails"
End If
' *** creating a revolved protrusion on the base feature
' creating a circular profile on the topcap of the base feature
Set objTCRefPlane = objDoc.RefPlanes.AddParallelByDistance(ParentPlane:=objModel.RevolvedProtrusions(1).TopCap, _
Distance:=0, NormalSide:=igRight, Local:=True)
Set objTCProfile = objDoc.ProfileSets.Add.Profiles.Add(pRefPlaneDisp:=objTCRefPlane)
Call objTCProfile.Circles2d.AddByCenterRadius(x:=0, y:=0, Radius:=0.02)
lngStatus = objTCProfile.End(ValidationCriteria:=igProfileClosed)
If (lngStatus <> 0) Then
MsgBox "profile for the revolved protrusion on top cap feature is not closed"
End If
Set objTCLine = objTCProfile.Lines2d.AddBy2Points(x1:=0.05, y1:=-0.05, x2:=0.05, y2:=0.05)
Set objTCRefAxis = objTCProfile.SetAxisOfRevolution(LineForAxis:=objTCLine)
' creating the revolved protrusion feature and validating it
Set objTCRevProt = objModel.RevolvedProtrusions.AddFinite(Profile:=objTCProfile, _
RefAxis:=objTCRefAxis, profileSide:=igLeft, ProfilePlaneSide:=igRight, AngleOfRevolution:=(PI / 6))
objTCProfile.Visible = False
If (objModel.RevolvedProtrusions(2).Status <> igFeatureOK) Then
MsgBox "AddFinite method of the RevolvedProtrusions object fails"
End If
' *** creating a revolved protrusion on the base feature
' creating a circular profile on the bottomcap of the base feature
Set objBCRefPlane = objDoc.RefPlanes.AddParallelByDistance(ParentPlane:=objModel.RevolvedProtrusions(1).BottomCap, _
Distance:=0, NormalSide:=igRight, Local:=True)
Set objBCProfile = objDoc.ProfileSets.Add.Profiles.Add(pRefPlaneDisp:=objBCRefPlane)
Call objBCProfile.Circles2d.AddByCenterRadius(x:=0, y:=0, Radius:=0.02)
lngStatus = objBCProfile.End(ValidationCriteria:=igProfileClosed)
If (lngStatus <> 0) Then
MsgBox "profile for the revolved protrusion on bottom cap feature is not closed"
End If
Set objBCLine = objBCProfile.Lines2d.AddBy2Points(x1:=-0.05, y1:=-0.05, x2:=-0.05, y2:=0.05)
Set objBCRefAxis = objBCProfile.SetAxisOfRevolution(LineForAxis:=objBCLine)
' creating the revolved protrusion feature and validating it
Set objBCRevProt = objModel.RevolvedProtrusions.AddFinite(Profile:=objBCProfile, _
RefAxis:=objBCRefAxis, profileSide:=igLeft, ProfilePlaneSide:=igRight, AngleOfRevolution:=(PI / 6))
objBCProfile.Visible = False
If (objModel.RevolvedProtrusions(3).Status <> igFeatureOK) Then
MsgBox "AddFinite method of the RevolvedProtrusions object fails"
End If
' *** creating a Revolved Cutout in the Base Feature
' 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
' reordering the revolved cutout feature to place it after the revolved protrusion on bottomcap of base feature
Call objRevCutout.Reorder(TargetFeature:=objTCRevProt, InsertBefore:=False)
' checking whether the revolved cutout feature has been properly reordered
If Not (objModel.Features(3) Is objRevCutout) Then
MsgBox "Reorder method failed to place the revolved cutout feature after the revolved protrusion feature"
End If
' 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 objProfileArray(2) = Nothing
Set objRevCutout = Nothing
Set objCutoutProfile = Nothing
Set objCutoutLine = Nothing
Set objCutoutRefAxis = Nothing
Set objTCRefPlane = Nothing
Set objTCProfile = Nothing
Set objTCRefAxis = Nothing
Set objTCRevProt = Nothing
Set objTCLine = Nothing
Set objBCRefPlane = Nothing
Set objBCProfile = Nothing
Set objBCRefAxis = Nothing
Set objBCRevProt = Nothing
Set objBCLine = Nothing
End Sub