Option Explicit
' COPYRIGHT DASSAULT SYSTEMES 2004
' *****************************************************************************
' Purpose: Add/List/Remove internal flows to reference component.
' Languages: VBScript
' Locales: English
' CATIA Level: V5R15
' *****************************************************************************
Sub CATMain()
' -------------------------------------------------------------------------
' Optional: allows to find the sample wherever it's installed
dim sDocPath As String
sDocPath=CATIA.SystemService.Environ("CATDocView")
If (Not CATIA.FileSystem.FolderExists(sDocPath)) Then
Err.Raise 9999,sDocPath,"No Doc Path Defined"
End If
' -------------------------------------------------------------------------
' Open the schematic document
Dim sFilePath
sFilePath = CATIA.FileSystem.ConcatenatePaths(sDocPath, _
"online\CAAScdSchUseCases\samples\CAASCH_Detail02.CATProduct")
Dim objSchDoc As Document
Set objSchDoc = CATIA.Documents.Open(sFilePath)
Dim strMessage As String
strMessage = _
"--------------------------------------------------------------------" & vbCr
strMessage = strMessage & _
"Output traces from CAASchInternalFlow.CATScript" & vbCrLf
' Find the top node of the schematic object tree - schematic root.
Dim objPrdRoot As Product
Dim objSchRoot As SchematicRoot
If ( Not ( objSchDoc Is Nothing ) ) Then
Set objPrdRoot = objSchDoc.Product
If ( Not ( objPrdRoot Is Nothing ) ) Then
Set objSchRoot = objPrdRoot.GetTechnologicalObject("SchematicRoot")
End If
End If
Dim objLCompRefs As SchListOfObjects
Dim objLCntr As SchListOfObjects
Dim objCompRef As SchComponent
Dim objCntbl As SchAppConnectable
Dim objCompFlow As SchCompFlow
Dim objSchTempListFact As SchTempListFactory
If ( Not ( objSchRoot Is Nothing ) ) Then
Set objSchTempListFact = objSchRoot.GetTemporaryListFactory
End If
If ( Not ( objSchRoot Is Nothing ) And _
Not (objSchTempListFact Is Nothing ) ) Then
'-----------------------------------------------------------------------
' Find a list of reference component in the model
'-----------------------------------------------------------------------
Set objLCompRefs = objSchRoot.GetRefComponents
If ( Not ( objLCompRefs Is Nothing ) ) Then
Set objCompRef = objLCompRefs.Item (1,"CATIASchComponent")
If ( Not ( objCompRef Is Nothing ) ) Then
Set objCompFlow = objSchRoot.GetInterface ( _
"CATIASchCompFlow",objCompRef)
Set objCntbl = objSchRoot.GetInterface ( _
"CATIASchAppConnectable",objCompRef)
End If
If ( Not ( objCntbl Is Nothing ) And _
Not ( objCompFlow Is Nothing ) ) Then
'-----------------------------------------------------------------
' Find all the connectors associated with the reference
' component
'-----------------------------------------------------------------
Dim objLFilter As SchListOfBSTRs
Set objLFilter = Nothing
Set objLCntr = objCntbl.AppListConnectors (objLFilter)
'-----------------------------------------------------------------
' Add internal flow to the reference component.
' 2 pairs:
' Flow 1: connector 1 to connector 2
' Flow 2: connector 1 to connector 3
'-----------------------------------------------------------------
Dim intNbCntr As Integer
Dim objFlow1 As SchInternalFlow
Dim objFlow2 As SchInternalFlow
Dim objCntr1 As SchAppConnector
Dim objCntr2 As SchAppConnector
Dim objCntr3 As SchAppConnector
Dim objLCntr1 As SchListOfObjects
Dim objLCntr2 As SchListOfObjects
Dim objLFlow As SchListOfObjects
intNbCntr = objLCntr.Count
Set objLCntr1 = objSchTempListFact.CreateListOfObjects
Set objLCntr2 = objSchTempListFact.CreateListOfObjects
Set objCntr1 = Nothing
Set objCntr2 = Nothing
Set objCntr3 = Nothing
If ( intNbCntr > 0 ) Then Set objCntr1 = objLCntr.Item(1,"CATIASchAppConnector")
If ( intNbCntr > 1 ) Then Set objCntr2 = objLCntr.Item(2,"CATIASchAppConnector")
If ( intNbCntr > 2 ) Then Set objCntr3 = objLCntr.Item(3,"CATIASchAppConnector")
Set objFlow1 = Nothing
If ( Not objLCntr1 Is Nothing ) Then
If ( Not ( objCntr1 Is Nothing ) And _
Not ( objCntr2 Is Nothing ) ) Then
objLCntr1.Append (objCntr1)
objLCntr1.Append (objCntr2)
Set objFlow1 = objCompFlow.AddInternalFlow (objLCntr1)
If ( Not ( objFlow1 Is Nothing ) ) Then
strMessage = strMessage & _
"Internal flow between connector 1 and 2 created " & vbCr
End If
End If
End If '--- If ( Not objLCntr1 Is Nothing...
Set objFlow2 = Nothing
If ( Not objLCntr2 Is Nothing ) Then
If ( Not ( objCntr1 Is Nothing ) And _
Not ( objCntr3 Is Nothing ) ) Then
objLCntr2.Append (objCntr1)
objLCntr2.Append (objCntr3)
Set objFlow2 = objCompFlow.AddInternalFlow (objLCntr2)
If ( Not ( objFlow2 Is Nothing ) ) Then
strMessage = strMessage & _
"Internal flow between connector 1 and 3 created " & vbCr
End If
End If
End If '--- If ( Not objLCntr1 Is Nothing...
'-----------------------------------------------------------------
' Return a list of all the internal flows
' associated to the reference component. There should be 2.
'-----------------------------------------------------------------
Set objLFlow = objCompFlow.ListInternalFlows
Dim intNbFlow As Integer
If ( Not ( objLFlow Is Nothing ) ) Then
intNbFlow = objLFlow.Count
strMessage = strMessage & "Number of internal flows = " & intNbFlow & vbCr
If ( Not ( objFlow2 Is Nothing ) ) Then
'-----------------------------------------------------------------
' Remove "Flow 2" from the reference component
'-----------------------------------------------------------------
objCompFlow.RemoveInternalFlow objFlow2
End If
End If
'-----------------------------------------------------------------
' Return a list of all the internal flows
' associated to the reference component. There should be 1.
'-----------------------------------------------------------------
Set objLFlow = Nothing
Set objLFlow = objCompFlow.ListInternalFlows
If ( Not ( objLFlow Is Nothing ) ) Then
intNbFlow = objLFlow.Count
strMessage = strMessage & "Number of internal flows after calling RemoveInternalFlow"
strMessage = strMessage & " = " & intNbFlow & vbCr
End If
End If
End If
End If '--- If ( Not ( objSchRoot Is Nothing )...
strMessage = strMessage & _
"--------------------------------------------------------------------" & vbCr
MsgBox strMessage
End Sub