Private Sub Form_Load()
Dim objApp As SolidEdgeFramework.Application
Dim objDoc As SolidEdgePart.PartDocument
Dim objModel As SolidEdgePart.Model
Dim objProfile As SolidEdgePart.Profile
Dim objExtCutout As SolidEdgePart.ExtrudedCutout
Dim objEdges As Object
Dim objEdgeArray(1 To 1) As SolidEdgeGeometry.Edge
Dim objRounds As SolidEdgePart.Rounds
Dim objRound As SolidEdgePart.Round
Dim dblRadiusArray(1 To 1) As Double
Dim lngStatus As Long
Const TESTFILE = "T:\vbtests\testcases\cube.par"
' 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
Call objDoc.Close
' opening the test case file
Set objDoc = objApp.Documents.Open(TESTFILE)
Set objModel = objDoc.Models(1)
' *** Create a simple cutout
' Create a profile for the extruded cutout feature and validate it
Set objProfile = objDoc.ProfileSets.Add.Profiles.Add(pRefPlaneDisp:=objDoc.RefPlanes(1))
Call objProfile.Circles2d.AddByCenterRadius(x:=0.015, y:=0.015, Radius:=0.005)
lngStatus = objProfile.End(ValidationCriteria:=igClosed)
If lngStatus <> 0 Then
MsgBox "Profile for the Extruded Cutout feature is not closed"
End If
' Create the Extruded Cutout feature and validate it
Set objExtCutout = objModel.ExtrudedCutouts.AddFinite(Profile:=objProfile, _
ProfileSide:=igLeft, ProfilePlaneSide:=igRight, Depth:=0.05)
objProfile.Visible = False
If objExtCutout.Status <> igFeatureOK Then
MsgBox "AddFinite method of ExtrudedCutouts object failed"
End If
' *** creating a simple round on a single edge
' defining the radius for rounding an edge
Set objRounds = objModel.Rounds
Set objEdges = objModel.ExtrudedProtrusions(1).Edges(edgetype:=igQueryAll)
Set objEdgeArray(1) = objEdges(1)
dblRadiusArray(1) = 0.005
' Create the round feature and validate it
Set objRound = objRounds.Add(NumberOfEdgeSets:=1, EdgeSetArray:=objEdgeArray, _
RadiusArray:=dblRadiusArray)
If objRound.Status <> igFeatureOK Then
MsgBox "Round feature failed"
End If
'Reorder the round feature ahead of cutout feature
Call objRound.Reorder(TargetFeature:=objModel.Features(1), InsertBefore:=False)
' USER DISPLAY
' Release objects
Set objApp = Nothing
Set objDoc = Nothing
Set objModel = Nothing
Set objEdges = Nothing
Set objEdgeArray(1) = Nothing
Set objRounds = Nothing
Set objRound = Nothing
End Sub