'COPYRIGHT DASSAULT SYSTEMES 2005
Option Explicit
Dim Language as String
Language="VBSCRIPT"
''*****************************************************************************
' Purpose: This macro creates a dressup on a sub mechanism
' in a specific product document
' Assumptions: The product document used is called "integrator_level.CATProduct" .
' It contains a root product called achitect_level.Product containing a
' wireframe mechanism, and a list of 3D products
' Author:
' Languages: VBScript
' Version: V5R16
' Locales: US English
'*****************************************************************************
Sub CATMain()
' =========================
' Retrieve the root product
' =========================
Dim RootProd as Product
Set RootProd = CATIA.ActiveDocument.Product
' ==================================================
' Retrieve Dressups collection from the Root Product
' ==================================================
Dim MyDressups as Dressups
Set MyDressups = RootProd.GetTechnologicalObject("Dressups")
' ========================================================
' Retrieve all the mechanisms including the sub-mechanisms
' ========================================================
Dim PossibleMecList as Mechanism
PossibleMecList = MyDressups.ListPossibleMechanisms()
' ========================================================
' Retrieve All the mechanism's contexts
' ========================================================
Dim MecContextList as Product
MecContextList = MyDressups.ListMechanismsContext()
' ===========================================
' Compute the maximum rank of PossibleMecList
' ===========================================
Dim iMax as Integer
iMax = ubound(PossibleMecList)
Dim i as Integer
Dim Meca as Mechanism
Dim MecaContext as Product
' =================================================
' Loop for automatic dressup creation only for sub-mechanisms
' =================================================
For i= 0 To iMax
Set Meca = PossibleMecList(i)
Set MecaContext = MecContextList(i)
if MecaContext.Name<>RootProd.Name then
AutomaticDressup RootProd , MyDressups , Meca , MecaContext
end if
Next
End Sub
' ================================================================================
' ================================================================================
' This Subroutine creates automatically a new dressup
' ================================================================================
' ================================================================================
Sub AutomaticDressup(iRootProduct as Product, iDressups as Dressups, iMechanism as Mechanisms ,iContext as Product)
' =============================================================
' Retrieve all the first level products under the root product
' =============================================================
Dim FirsLevelProducts as Products
Set FirsLevelProducts=iRootProduct.Products
' ===================================================
' Create a new dressup object associated to iMechanism
' ===================================================
Dim NewDressup as Dressup
Set NewDressup = iDressups.Add(iMechanism,iContext)
' =========================================
' Loop on all the products of the mechanism
' =========================================
Dim NbLink as Integer
NbLink = iMechanism.NbProducts
Dim NbProduct as Integer
NbProduct = FirsLevelProducts.Count
Dim i as Integer
For i = 1 To NbLink
Dim Link as Product
Set Link = iMechanism.GetProduct(i)
' ===============================
' Loop on all first level Product
' ===============================
Dim ComparisonOK as Boolean
Dim Product_j as Product
Dim j as integer
For j = 1 To NbProduct
' ==========================================
' Name comparison between link and Product_j
' ==========================================
Set Product_j = FirsLevelProducts.item(j)
ComparisonOK = ComparProductName(Link,Product_j )
if ComparisonOK=True then
' =============================
' Link is attached to Product_j
' =============================
call NewDressup.Attach(Link,Product_j)
end if
Next
Next
End Sub
' ================================================================================
' ================================================================================
' This function compares the name between two products.
' iLink is a part of mechanism. All the mcechanism's Parts are suffixed by "_wireframe.1"
' iProduct is OK for comparison if it contains the previous name without its suffix.
' For instance, The comparison is OK for :
' fix_wireframe.1 and designer_level_fix.1
' ================================================================================
' ================================================================================
Function ComparProductName ( iLink as Product , iProduct as Product ) as Boolean
' ============================
' Return value is initialized
' ===========================
ComparProductName = False
' =======================
' suffix string definition
' =======================
Dim suffix as String
suffix = "_wireframe.1"
' ==================================
' Compute the suffix string position
' ==================================
Dim LinkNameWithOutsuffix as String
Dim suffixPos as Integer
suffixPos = InStr ( iLink.Name,suffix)
' ======================
' Suffix existence test
' ======================
if ( suffixPos > 1 ) then
' =======================================
' Compute the name of the link without its suffix
' =======================================
LinkNameWithOutsuffix = Left (iLink.Name, suffixPos-1)
Dim LinkNamePos as Integer
' ============================================================
' Does the product name contain the name without its suffix ?
' ============================================================
LinkNamePos = InStr ( iProduct.Name,LinkNameWithOutsuffix)
if ( LinkNamePos = 0 ) then
ComparProductName = True
end if
end if
End Function