Option Explicit
' COPYRIGHT DASSAULT SYSTEMES 2004
' *****************************************************************************
' Purpose: Scale and move component instances in a network.
' Languages: VBScript
' Locales: English
' CATIA Level: V5R15
' *****************************************************************************
'------------------------------------------------------------------------------
' These variables are visible to private Sub and CATMain
'------------------------------------------------------------------------------
Dim objLGRR_g As SchListOfObjects
Dim objLCntbl_g As SchListOfObjects
Dim objLSelected_g As SchListOfObjects
Sub CATMain()
' -------------------------------------------------------------------------
' Optional: allows to find the sample wherever it's installed
dim sDocPath As String
sDocPath=CATIA.SystemService.Environ("CATDocView")
strMessage = strMessage & "sDocPath = " & sDocPath
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_Network01.CATProduct")
Dim objSchDoc As Document
Set objSchDoc = CATIA.Documents.Open(sFilePath)
Dim strMessage As String
strMessage = _
"--------------------------------------------------------------------" & vbCr
strMessage = strMessage & _
"Output traces from CAASchNetworkTransf.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 objSchBaseFact As SchBaseFactory
Dim objSchTempListFact As SchTempListFactory
Dim objLNetWork As SchListOfObjects
If ( Not ( objSchRoot Is Nothing ) ) Then
'-----------------------------------------------------------------------
' Get all the necessary factories.
'-----------------------------------------------------------------------
Set objSchBaseFact = objSchRoot.GetSchBaseFactory
Set objSchTempListFact = objSchRoot.GetTemporaryListFactory
If ( Not ( objSchBaseFact Is Nothing ) And _
Not ( objSchTempListFact Is Nothing ) ) Then
Set objLCntbl_g = objSchTempListFact.CreateListOfObjects
Set objLGRR_g = objSchTempListFact.CreateListOfObjects
Set objLSelected_g = objSchTempListFact.CreateListOfObjects
If ( Not ( objLCntbl_g Is Nothing ) And _
Not ( objLGRR_g Is Nothing ) And _
Not ( objLSelected_g Is Nothing ) ) Then
'-----------------------------------------------------------------
' The following "Sub" will populate objLCntbl_g and objLGRR_g and
' objLSelected_g
'-----------------------------------------------------------------
FindNetworkComponentInst objSchRoot
Set objLNetWork = objSchBaseFact.CreateNetwork (objLCntbl_g, _
objLGRR_g)
End If
End If '--- If ( Not ( objSchBaseFact Is Nothing )...
End If '--- If ( Not ( objSchRoot Is Nothing )...
If ( Not ( objLNetWork Is Nothing ) ) Then
Dim objSchNet As SchMovable
Dim Db2Vector (2) As CATSafeArrayVariant
Dim DbScaleFactor As Double
Dim intNbNet As Integer
Db2Vector(0) = 50.0
Db2Vector(1) = 0.0
DbScaleFactor = 1.5
intNbNet = objLNetWork.Count
strMessage = strMessage & "number of network found = " & intNbNet & vbCr
If ( intNbNet > 0 ) Then
Set objSchNet = objLNetWork.Item (1,"CATIASchMovable")
If ( Not ( objSchNet Is Nothing ) ) Then
'-----------------------------------------------------------------
' Translate the first network by (50.0, 0.0)
'-----------------------------------------------------------------
objSchNet.Translate Db2Vector
strMessage = strMessage & "Successfully translate network by " _
& Db2Vector(0) & "," & Db2Vector(1) & vbCr
'-----------------------------------------------------------------
' Scale a component (the one with "_Scale" in its name) that is in
' the network. Objects directly connected to this component will
' be adjusted according until a route is reached. The latter will
' be "reshaped".
' objLSelected_g is set in FindNetworkComponentInst
'-----------------------------------------------------------------
Dim intSelected As Integer
intSelected = objLSelected_g.Count
If ( intSelected > 0 ) Then
objSchNet.ScaleSelectedObjects objLSelected_g, DbScaleFactor
strMessage = strMessage & "Successfully scale a connectable in the network by " _
& DbScaleFactor & vbCr
End If
End If
End If
End If '--- If ( Not ( objLNetWork Is Nothing ) ...
strMessage = strMessage & _
"--------------------------------------------------------------------" & vbCr
MsgBox strMessage
End Sub
' -----------------------------------------------------------------------------
' | Find components and their images to be used to compute a network.
' | Input: objSchRootArg: the root of the document.
' | Returns: objLCntbl_g: a list of component instance objects
' | objLGRR_g: a list of component instance image objects
' -----------------------------------------------------------------------------
Private Sub FindNetworkComponentInst (objSchRootArg As SchematicRoot)
If ( objLCntbl_g Is Nothing ) Then Exit Sub
If ( objLGRR_g Is Nothing ) Then Exit Sub
Dim objLCompInst As SchListOfObjects
Dim intNbComp As Integer
If ( Not ( objSchRootArg Is Nothing ) ) Then
Set objLCompInst = objSchRootArg.GetComponents
If ( Not ( objLCompInst Is Nothing ) ) Then
intNbComp = objLCompInst.Count
End If
End If
Dim intIndex As Integer
Dim intNbFlow As Integer
Dim objCntbl As SchConnectable
Dim objGRR As SchGRR
Dim objPrd As Product
Dim strInstName As String
Dim intFound As Integer
Dim intNbFound As Integer
Dim intSelected As Integer
If (Not ( objLCompInst Is Nothing ) ) Then
'------------------------------------------------------------------------
' Loop through the members in the list and find components that
' have "network" as part of the product instance names
'------------------------------------------------------------------------
intNbFound = 0
For intIndex = 1 To intNbComp
strInstName = ""
intFound = 0
Set objCntbl = objLCompInst.Item (intIndex,"CATIASchAppConnectable")
If ( Not ( objCntbl Is Nothing ) ) Then
Set objPrd = objSchRootArg.GetInterface ( _
"CATIAProduct", objCntbl)
If ( Not ( objPrd Is Nothing ) ) Then
strInstName = objPrd.Name
intFound = Instr (1, strInstName, "_network_scale", 1)
End If
If ( intFound > 0 ) Then
Dim ObjSchCompGraph As SchCompGraphic
Set objSchCompGraph = objSchRootArg.GetInterface ( _
"CATIASchCompGraphic",objCntbl)
Set objGRR = GetComponentImage (objSchCompGraph)
If ( ( Not ObjGRR Is Nothing ) ) Then
objLCntbl_g.Append objCntbl
objLGRR_g.Append objGRR
intSelected = objLSelected_g.Count
If (intSelected = 0) Then objLSelected_g.Append objCntbl
intNbFound = intNbFound + 1
End If
End If
End If '--- If ( Not ( objCntbl Is Nothing ) ...
Next
End If '--- If (Not ( objLCompInst Is Nothing ) ...
End Sub
' -----------------------------------------------------------------------------
' | Find the first symbol used for the input schematic component.
' | Input: objSchCompGraph: the schematic component
' | (a CATIASchCompGraphic interface handle).
' | Returns: the component image (the symbol instance)
' -----------------------------------------------------------------------------
Private Function GetComponentImage (objSchCompGraphArg As SchCompGraphic) As SchGRR
Dim objSchLSymbols As SchListOfObjects
If ( Not ( objSchCompGraphArg Is Nothing ) ) Then
Set objSchLSymbols = objSchCompGraphArg.ListGraphicalImages
If ( Not ( objSchLSymbols Is Nothing ) ) Then
Set GetComponentImage = objSchLSymbols.Item (1,"CATIASchGRR")
End If
End If
End Function