'---------------------------------------------------------------------------
'COPYRIGHT DASSAULT SYSTEMES 2011
' ****************************************************************************
'
' Purpose: To edit standard openings craeted using the Offset-Offset strategy.
'
' Assumptions: The Part document CAASfmEditStdOpening.CATPart should be active
'
' Author:
' Languages: VBScript
' Version: V5R21
' Locales: English
' CATIA Level: V5R21
'
' ****************************************************************************
Sub CATMain()
Dim Part1 As Part
Set Part1 = CATIA.ActiveDocument.Part
Dim plate As SfmSuperPlate
Set plate = Part1.FindObjectByName("Deck_002")
Dim plateref As Reference
Set plateref = Part1.CreateReferenceFromObject(plate)
'Get the Factory and Managers
Dim Factory As SfmFunctionFactory
Set Factory = Part1.GetCustomerFactory("SfmFunctionFactory")
Dim ObjSfmContourMgr As SfmOpeningContoursMgr
Set ObjSfmContourMgr = Factory.GetOpeningMgr(Part1, "SfmOpeningContoursMgr")
Dim ObjSfmPosStrategyMgr As SfmPositioningStrategyManager
Set ObjSfmPosStrategyMgr = Factory.GetOpeningMgr(Part1, "SfmPositioningStrategyManager")
'Define The Contour
Dim oListContourNames() As Variant
ObjSfmContourMgr.GetAvailableStdOpeningContours oListContourNames
Dim NbOfContour As Long
NbOfContour = UBound(oListContourNames)
Dim i As Integer
'For i = 0 To NbOfContour
'MsgBox oListContourNames(i)
'Next
'Select Contour from List
Dim oListCkeParms As SfmStandardContourParameters
Set oListCkeParms = ObjSfmContourMgr.GetStdOpeningContourParams("Sfm_Rect")
'Display List of Parameters for Selected Contour
Dim NbOfParam As Long
NbOfParam = oListCkeParms.Count
Dim ContourParam As Parameter
Dim ContourParamName As String
For i = 1 To NbOfParam
Set ContourParam = oListCkeParms.Item(i)
ContourParamName = oListCkeParms.Item(i).Name
'MsgBox ContourParamName
'Set Contour Parameter Values
If ContourParamName = "Sfm_Width" Then
ContourParam.ValuateFromString ("1500mm")
End If
If ContourParamName = "Sfm_Height" Then
ContourParam.ValuateFromString ("2000mm")
End If
If ContourParamName = "Sfm_CornerRadius" Then
ContourParam.ValuateFromString ("10mm")
End If
Next
'Prepare a List of U & V Reference
Dim UrefList As SfmReferences
Dim Uref1, Uref2, Uref3, Uref4 As Reference
Set Uref1 = Part1.FindObjectByName("CROSS.95")
Set Uref2 = Part1.FindObjectByName("CROSS.50")
Set Uref3 = Part1.FindObjectByName("CROSS.25")
Set Uref4 = Part1.FindObjectByName("CROSS.40")
Set UrefList = Factory.SfmReferences
UrefList.Add Uref1
UrefList.Add Uref2
UrefList.Add Uref3
UrefList.Add Uref4
Dim VrefList As SfmReferences
Dim Vref1 As Reference
Set Vref1 = Part1.FindObjectByName("LONG.0")
Set VrefList = Factory.SfmReferences
VrefList.Add Vref1
Dim NbofURef As Long
NbofURef = UrefList.Count
Dim NbofVRef As Long
NbofVRef = VrefList.Count
'Define The Postition Strategy
Dim PositionStrategyParms As SfmStandardPosStrategyParameters
Set PositionStrategyParms = ObjSfmPosStrategyMgr.GetPositioningStrategyParams("CATSfmPosOffsetOffset")
Dim StdOpening As SfmStandardOpening
Dim URefListint As SfmReferences
Set URefListint = Factory.SfmReferences
Dim nUrefCnt As Integer
For nUrefCnt = 1 To NbofURef
URefListint.Add UrefList.Item(nUrefCnt)
PositionStrategyParms.SetPosParamData "CATSfmPosOffsetOffset", 20, URefListint, 1, VrefList, 2
Set StdOpening = Factory.CreateStandardOpening("FunctionalOpening", "Sfm_Rect", oListCkeParms, "CATSfmPosOffsetOffset", PositionStrategyParms, plateref)
URefListint.ClearList
Part1.Update
Next
'****************************************
Dim GetName As String
Dim GetParam As SfmStandardContourParameters
StdOpening.GetContour GetName, GetParam
Dim Nb As Long
Nb = GetParam.Count
Dim ParamName1 As String
Dim ParamValue1 As Parameter
For i = 1 To Nb
Set ParamValue1 = GetParam.Item(i)
ParamName1 = ParamValue1.Name
If ParamName1 = "Sfm_Width" Then
ParamValue1.ValuateFromString ("1000mm")
End If
If ParamName1 = "Sfm_Height" Then
ParamValue1.ValuateFromString ("1000mm")
End If
If ParamName1 = "Sfm_CornerRadius" Then
ParamValue1.ValuateFromString ("25mm")
End If
Next
StdOpening.SetContour GetName, GetParam
'****************************************
Dim pName As String
Dim pStrategyParams As SfmStandardPosStrategyParameters
StdOpening.GetPositioningStrategy pName, pStrategyParams
Dim UrefNew As Reference
Set UrefNew = Part1.FindObjectByName("CROSS.70")
Dim URefListint1 As SfmReferences
Set URefListint1 = Factory.SfmReferences
URefListint1.Add UrefNew
pStrategyParams.SetPosParamData "CATSfmPosOffsetOffset", 40, URefListint1, 25, VrefList, 30
StdOpening.SetPositioningStrategy pName, pStrategyParams
'****************************************
part1.Update
End Sub