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 objCBoreHoleData As SolidEdgepart.HoleData
Dim objRP As SolidEdgepart.RefPlane
Dim objCBoreHoleProfile As SolidEdgepart.Profile
Dim objCBoreHole As SolidEdgepart.Hole
Dim dblCBDepth 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 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 CounterBore Hole using the HoleDataCollection object
' creating the hole data for a counter bore hole
Set objCBoreHoleData = objDoc.HoleDataCollection.Add(HoleType:=igCounterboreHole, _
HoleDiameter:=0.01, CounterboreDiameter:=0.02, CounterboreDepth:=0.01, BottomAngle:=0)
' creating a profile for the counter bore hole and validating it
Set objRP = objDoc.RefPlanes(1)
Set objCBoreHoleProfile = objDoc.ProfileSets.Add.Profiles.Add(pRefPlaneDisp:=objRP)
Call objCBoreHoleProfile.Holes2d.Add(xcenter:=0.05, ycenter:=0)
lngStatus = objCBoreHoleProfile.End(ValidationCriteria:=igProfileClosed)
If (lngStatus <> 0) Then
MsgBox "Profile for the regular hole is not closed"
End If
' creating the counter bore hole on the base feature and validating it
Set objCBoreHole = objBase.Holes.AddFinite(Profile:=objCBoreHoleProfile, _
ProfilePlaneSide:=igLeft, FiniteDepth:=0.03, Data:=objCBoreHoleData)
If (objCBoreHole.Status <> igFeatureOK) Then
MsgBox "AddFinite method of the Holes object fails"
End If
objCBoreHoleProfile.Visible = False
' reading and modifying the counterbore depth of the counter bore hole
dblCBDepth = objCBoreHoleData.CounterboreDepth
objCBoreHoleData.CounterboreDepth = dblCBDepth + 0.005
' USER DISPLAY
' Release objects
Set objApp = Nothing
Set objDoc = Nothing
Set objBaseProfile = Nothing
Set objBaseProfArray(1) = Nothing
Set objBase = Nothing
Set objCBoreHoleData = Nothing
Set objRP = Nothing
Set objCBoreHoleProfile = Nothing
Set objCBoreHole = Nothing
End Sub