CAAKiiMechanismCreation.CATScript'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)
' 
End Sub