Private Sub Form_Load()
Dim objApp As SolidEdgeFramework.Application
Dim objDoc As SolidEdgePart.PartDocument
Dim objEPProfile As SolidEdgePart.Profile
Dim objEPProfArray(1 To 2) As SolidEdgePart.Profile
Dim objEPModel As SolidEdgePart.Model
Dim objRPProfile As SolidEdgePart.Profile
Dim objRPProfArray(1 To 2) As SolidEdgePart.Profile
Dim objRPLine As SolidEdgeFrameworkSupport.Line2d
Dim objRPRAxis As SolidEdgePart.RefAxis
Dim objRPCSection As SolidEdgeFrameworkSupport.Circle2d
Dim objRPModel As SolidEdgePart.Model
Dim lngStatus As Long
Dim lngCount 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 first model
' creating the profile for an extruded protrusion feature
Set objEPProfile = objDoc.ProfileSets.Add.Profiles.Add(pRefPlaneDisp:=objDoc.RefPlanes(1))
Call objEPProfile.Circles2d.AddByCenterRadius(x:=0, y:=0, Radius:=0.025)
lngStatus = objEPProfile.End(ValidationCriteria:=igProfileClosed)
If (lngStatus <> 0) Then
MsgBox "Profile for the base feature is not closed"
End If
objEPProfile.Visible = False
' creating the base extruded protrusion
Set objEPProfArray(1) = objEPProfile
Set objEPModel = objDoc.Models.AddFiniteExtrudedProtrusion(NumberOfProfiles:=1, _
ProfileArray:=objEPProfArray, ProfilePlaneSide:=igSymmetric, _
ExtrusionDistance:=0.1)
If (objEPModel.ExtrudedProtrusions(1).Status <> igFeatureOK) Then
MsgBox "AddFiniteExtrudedProtrusion method fails"
End If
' *** creating the second model
' creating a reference axis and a cross-section for a revolved protrusion feature
Set objRPProfile = objDoc.ProfileSets.Add.Profiles.Add(pRefPlaneDisp:=objDoc.RefPlanes(2))
Set objRPLine = objRPProfile.Lines2d.AddBy2Points(x1:=0, y1:=-0.05, x2:=0, y2:=0.05)
Set objRPRAxis = objRPProfile.SetAxisOfRevolution(lineforaxis:=objRPLine)
Set objRPCSection = objRPProfile.Circles2d.AddByCenterRadius(x:=0.1, y:=0, Radius:=0.025)
lngStatus = objRPProfile.End(ValidationCriteria:=igProfileNoSelfIntersect)
If lngStatus <> 0 Then
MsgBox "Profile for the revolved protrusion is self-intersecting"
End If
objRPProfile.Visible = False
' creating the base revolved protrusion
Set objRPProfArray(1) = objRPProfile
Set objRPModel = objDoc.Models.AddFiniteRevolvedProtrusion(NumberOfProfiles:=1, _
ProfileArray:=objRPProfArray, ReferenceAxis:=objRPRAxis, _
ProfilePlaneSide:=igRight, AngleOfRevolution:=3 * PI / 2)
' getting the number of model objects in the models collection
lngCount = objDoc.Models.Count
' USER DISPLAY
' Release objects
Set objApp = Nothing
Set objDoc = Nothing
Set objEPProfile = Nothing
Set objEPProfArray(1) = Nothing
Set objEPModel = Nothing
Set objRPProfile = Nothing
Set objRPLine = Nothing
Set objRPRAxis = Nothing
Set objRPProfArray(1) = Nothing
Set objRPCSection = Nothing
Set objRPModel = Nothing
End Sub