Solid Edge Part Type Library
SetProfiles Method
Specifies the number of profiles in the Profiles array.
Contains the profiles for the referenced object.
Description
Sets the profiles associated with the referenced feature object.
Syntax
Visual Basic
Public Sub SetProfiles( _
   ByVal NumProfiles As Long, _
   ByRef Profiles() As Object _
) 
Parameters
NumProfiles
Specifies the number of profiles in the Profiles array.
Profiles
Contains the profiles for the referenced object.
Example
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 objRPProfile As solidEdgePart.Profile
    Dim objRPProfCollection As solidEdgePart.Profiles
    Dim objSetProfCollection As solidEdgePart.Profiles
    Dim objLine As solidEdgeFrameworkSupport.Line2d
    Dim objRefAxis As solidEdgePart.RefAxis
    Dim objRevProt As solidEdgePart.RevolvedProtrusion
    Dim objProfileArray(1 To 2) As solidEdgePart.Profile
    Dim objProfileArrayASet(1 To 4) As solidEdgePart.Profile
    Dim objMultFinRevProt As solidEdgePart.RevolvedProtrusion
    Dim objLines As solidEdgeFrameworkSupport.Lines2d
    Dim objRelns As solidEdgeFrameworkSupport.Relations2d
    Dim lngStatus As Long
    Dim i As Single
    Dim lngNoOfProfiles 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"
        Exit Sub
    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 (objBaseModel.ExtrudedProtrusions(1).Status <> igFeatureOK) Then
        MsgBox "AddFiniteExtrudedProtrusion method of the Models object fails"
    End If
    objBaseProfile.Visible = False
    ' *** Creating a Revolved Protrusion on the base feature towards the left side
    ' Creating the profile for the revolved protrusion feature
    Set objRPProfile = objDoc.ProfileSets.Add.Profiles.Add(pRefPlaneDisp:=objDoc.RefPlanes(3))
    Call objRPProfile.Circles2d.AddByCenterRadius(x:=0.05, y:=-0.035, Radius:=0.015)
    Call objRPProfile.Circles2d.AddByCenterRadius(x:=0.05, y:=0.035, Radius:=0.015)
    Set objLine = objRPProfile.Lines2d.AddBy2Points(x1:=0, y1:=-0.05, x2:=0, y2:=0.05)
    Set objRefAxis = objRPProfile.SetAxisOfRevolution(lineforaxis:=objLine)
    lngStatus = objRPProfile.End(ValidationCriteria:=igProfileClosed)
    If (lngStatus <> 0) Then
        MsgBox "Profile for the revolved protrusion feature is not closed"
        Exit Sub
    End If
    'Get the Profile Array
    Set objRPProfCollection = objRPProfile.Parent.Profiles
    For i = 1 To objRPProfCollection.Count
        Set objProfileArray(i) = objRPProfCollection(i)
        objProfileArray(i).Visible = False
    Next i
    ' Creating the revolved protrusion feature with multiple profiles
    Set objMultFinRevProt = objBaseModel.RevolvedProtrusions.AddFiniteMulti(NumberOfProfiles:=2, ProfileArray:=objProfileArray, _
                                                                            RefAxis:=objRefAxis, ProfilePlaneSide:=igLeft, _
                                                                            AngleOfRevolution:=PI)
    'Change the profile
    Set objRPProfile = objDoc.ProfileSets.Add.Profiles.Add(pRefPlaneDisp:=objDoc.RefPlanes(3))

    Call objRPProfile.Circles2d.AddByCenterRadius(x:=0.05, y:=-0.035, Radius:=0.01)
    Call objRPProfile.Circles2d.AddByCenterRadius(x:=0.075, y:=0, Radius:=0.01)
    Call objRPProfile.Circles2d.AddByCenterRadius(x:=0.05, y:=0.035, Radius:=0.01)
    Call objRPProfile.Circles2d.AddByCenterRadius(x:=0.025, y:=0, Radius:=0.01)
    If objRPProfile.End(igProfileClosed) Then
        MsgBox "Profiles must be closed"
    End If
    Set objSetProfCollection = objRPProfile.Parent.Profiles
    For i = 1 To objSetProfCollection.Count
        Set objProfileArrayASet(i) = objSetProfCollection(i)
        objProfileArrayASet(i).Visible = False
    Next i
    Call objMultFinRevProt.SetProfiles(NumProfiles:=objSetProfCollection.Count, Profiles:=objProfileArrayASet)
    ' USER DISPLAY
    ' Release objects
    Set objApp = Nothing
    Set objDoc = Nothing
    Set objBaseProfile = Nothing
    Set objBaseProfileArray(1) = Nothing
    Set objBaseModel = Nothing
    Set objRPProfile = Nothing
    Set objRPProfCollection = Nothing
    Set objLine = Nothing
    Set objRefAxis = Nothing
    Set objRevProt = Nothing
    Set objProfileArray(1) = Nothing
    Set objProfileArrayASet(1) = Nothing
    Set objMultFinRevProt = Nothing
    Set objLines = Nothing
    Set objRelns = Nothing
End Sub
See Also

RevolvedProtrusion Object  | RevolvedProtrusion Members

Send comments on this topic.