'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