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 objProfile As SolidEdgePart.Profile
Dim objLine As SolidEdgeFrameworkSupport.Line2d
Dim objRefAxis As SolidEdgePart.RefAxis
Dim objCrossSection As SolidEdgeFrameworkSupport.Circle2d
Dim objCSArray(1 To 2) As SolidEdgePart.Profile
Dim objHelixProt As SolidEdgePart.HelixProtrusion
Dim objHPParent As SolidEdgePart.Model
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"
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 (objDoc.Models(1).ExtrudedProtrusions(1).Status <> igFeatureOK) Then
MsgBox "AddFiniteExtrudedProtrusion method of the Models object fails"
End If
objBaseProfile.Visible = False
' *** creating the Helix Protrusion feature with the Ref Axis and Cross Section in the same plane
' creating the cross-section and the reference axis
Set objProfile = objDoc.ProfileSets.Add.Profiles.Add(pRefPlaneDisp:=objDoc.RefPlanes(2))
Set objLine = objProfile.Lines2d.AddBy2Points(x1:=0, y1:=-0.05, x2:=0, y2:=0.05)
Set objRefAxis = objProfile.SetAxisOfRevolution(LineForAxis:=objLine)
Set objCrossSection = objProfile.Circles2d.AddByCenterRadius(x:=0.05, y:=-0.05, Radius:=0.01)
lngStatus = objProfile.End(ValidationCriteria:=igClosed)
If (lngStatus <> 0) Then
MsgBox "Cross-section for the helix protrusion feature is not closed"
End If
' creating the helix protrusion and validating it
Set objCSArray(1) = objProfile
Set objHelixProt = objDoc.Models(1).HelixProtrusions.AddFinite(HelixAxis:=objRefAxis, _
AxisStart:=igStart, NumCrossSections:=1, CrossSectionArray:=objCSArray, _
ProfileSide:=igRight, Height:=0.1, Pitch:=0.05, NumberOfTurns:=2, HelixDir:=igRight)
objProfile.Visible = False
If (objHelixProt.Status <> igFeatureOK) Then
MsgBox "AddFinite method of the HelixProtrusions object fails"
End If
' getting the parent object for the helix protrusion feature
Set objHPParent = objHelixProt.Parent
' USER DISPLAY
' Release objects
Set objApp = Nothing
Set objDoc = Nothing
Set objProfile = Nothing
Set objLine = Nothing
Set objRefAxis = Nothing
Set objCrossSection = Nothing
Set objCSArray(1) = Nothing
Set objHelixProt = Nothing
Set objBaseProfile = Nothing
Set objBaseModel = Nothing
Set objBaseProfileArray(1) = Nothing
Set objHPParent = Nothing
End Sub