Private Sub Form_Load()
Dim objApp As SolidEdgeFramework.Application
Dim objDoc As SolidEdgepart.PartDocument
Dim objBaseProfile As SolidEdgepart.Profile
Dim objBaseProfArray(1 To 2) As SolidEdgepart.Profile
Dim objBase As SolidEdgepart.Model
Dim objRegHoleData As SolidEdgepart.HoleData
Dim objRP As SolidEdgepart.RefPlane
Dim objRegHoleProfile As SolidEdgepart.Profile
Dim objRegHole As SolidEdgepart.Hole
Dim objHDApp As SolidEdgeFramework.Application
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 an extruded protrusion base feature
' creating a circular 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.1)
lngStatus = objBaseProfile.End(ValidationCriteria:=igProfileClosed)
If (lngStatus <> 0) Then
MsgBox "Profile for the base feature is not closed"
End If
' creating the extruded protrusion and validating it
Set objBaseProfArray(1) = objBaseProfile
Set objBase = objDoc.Models.AddFiniteExtrudedProtrusion(NumberOfProfiles:=1, _
ProfileArray:=objBaseProfArray, ProfilePlaneSide:=igSymmetric, ExtrusionDistance:=0.05)
objBaseProfile.Visible = False
If (objBase.ExtrudedProtrusions(1).Status <> igFeatureOK) Then
MsgBox "AddFiniteExtrudedProtrusion method of models object fails"
End If
' *** creating a Regular Hole using the Holedatacollection object
' creating the holedata
Set objRegHoleData = objDoc.HoleDataCollection.Add(HoleType:=igRegularHole, _
HoleDiameter:=0.01, BottomAngle:=90)
' creating the profile for the hole and validating it
Set objRP = objDoc.RefPlanes.AddParallelByDistance(parentplane:=objDoc.RefPlanes(1), _
distance:=0.025, normalside:=igRight)
Set objRegHoleProfile = objDoc.ProfileSets.Add.Profiles.Add(pRefPlaneDisp:=objRP)
Call objRegHoleProfile.Holes2d.Add(xcenter:=0, ycenter:=0)
lngStatus = objRegHoleProfile.End(ValidationCriteria:=igProfileClosed)
If lngStatus <> 0 Then
MsgBox " profile for the hole is not closed"
End If
' creating the hole
Set objRegHole = objBase.Holes.AddFinite(Profile:=objRegHoleProfile, _
ProfilePlaneSide:=igLeft, FiniteDepth:=0.02, Data:=objRegHoleData)
If (objRegHole.Status <> igFeatureOK) Then
MsgBox "AddFinite method of the Holes object fails"
End If
objRegHoleProfile.Visible = False
' getting the application object of the HoleData object
Set objHDApp = objRegHoleData.Application
' USER DISPLAY
' Release objects
Set objApp = Nothing
Set objDoc = Nothing
Set objBaseProfile = Nothing
Set objBaseProfArray(1) = Nothing
Set objBase = Nothing
Set objRegHoleData = Nothing
Set objRP = Nothing
Set objRegHoleProfile = Nothing
Set objRegHole = Nothing
Set objHDApp = Nothing
End Sub