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 objCSinkHoleData As SolidEdgepart.HoleData
Dim objRP As SolidEdgepart.RefPlane
Dim objCSinkHoleProfile As SolidEdgepart.Profile
Dim objCSinkHole As SolidEdgepart.Hole
Dim dblCSAngle 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 Counter-Sunk Hole using the Holedatacollection object
' creating the hole data for a counter sunk hole
Set objCSinkHoleData = objDoc.HoleDataCollection.Add(HoleType:=igCountersinkHole, _
HoleDiameter:=0.01, CountersinkDiameter:=0.02, CountersinkAngle:=100, BottomAngle:=0)
' creating a profile for the counter sunk hole and validating it
Set objRP = objDoc.RefPlanes(1)
Set objCSinkHoleProfile = objDoc.ProfileSets.Add.Profiles.Add(pRefPlaneDisp:=objRP)
Call objCSinkHoleProfile.Holes2d.Add(xcenter:=0, ycenter:=0.05)
lngStatus = objCSinkHoleProfile.End(ValidationCriteria:=igProfileClosed)
If (lngStatus <> 0) Then
MsgBox "Profile for the counter sunk hole is not closed"
End If
' creating the counter sunk hole on the base feature and validating it
Set objCSinkHole = objBase.Holes.AddThroughAll(Profile:=objCSinkHoleProfile, _
ProfilePlaneSide:=igLeft, Data:=objCSinkHoleData)
If (objCSinkHole.Status <> igFeatureOK) Then
MsgBox "AddFinite method of the Holes object fails"
End If
objCSinkHoleProfile.Visible = False
' reading and modifying the counter sink angle of the countersunk hole
dblCSAngle = objCSinkHoleData.CountersinkAngle
objCSinkHoleData.CountersinkAngle = dblCSAngle + 20
' USER DISPLAY
' Release objects
Set objApp = Nothing
Set objDoc = Nothing
Set objBaseProfile = Nothing
Set objBaseProfArray(1) = Nothing
Set objBase = Nothing
Set objCSinkHoleData = Nothing
Set objRP = Nothing
Set objCSinkHoleProfile = Nothing
Set objCSinkHole = Nothing
End Sub