Macro de renommage des instances

Salut à tous,

Ci joint une macro qui renomme les instances dans un CATProduct.
On peut en trouver plusieurs versions dans les différents forums, mais celle ci permet de renommer les instances à tous les niveaux du CATProduct (sous produit et composant).
Source : http://www.eng-tips.com/viewthread.cfm?qid=365400

Code:


Option Explicit 'ensures all variables have been declared

'declare global variables
'source http://www.eng-tips.com/viewthread.cfm?qid=365400
Dim objActiveProductDoc As ProductDocument
Dim objCurrentProduct As Product
Dim strList() As String
Dim lngLstCtr As Long
Dim lngIntCtr As Long
Dim lngQtyCtr As Long
Dim objTempCurrentProduct As Product
Dim strTempList() As String
Dim lngTempLstCtr As Long
Dim lngTempIntCtr As Long
Dim lngTempQtyCtr As Long

Public Sub CATMain()
    
    'initialize global variables
    Set objActiveProductDoc = Nothing
    Set objCurrentProduct = Nothing
    lngLstCtr = -1
    lngIntCtr = 0
    lngQtyCtr = 0
    Set objTempCurrentProduct = Nothing
    lngTempLstCtr = -1
    lngTempIntCtr = 0
    lngTempQtyCtr = 0
    
    On Error Resume Next 'tell the processing to go to the next line if an error occurs
        Set objActiveProductDoc = CATIA.ActiveDocument 'attempt to store the active product doc
        If Err.Number <> 0 Then 'check if an error has been thrown from the above line
            CATIA.StatusBar = "The active document must be a product."
            MsgBox ("Le document actif doit être un CATProduct."), vbExclamation 'if it cant find an active product doc then throw an error msg
            CATIA.StatusBar = ""
            End 'end processing
        End If
    On Error GoTo 0 'go back to handling errors normally instead of suppressing them by using Resume Next
    
    'call a procedure to give temporary names to all instances
    Call RenameTemporary(objActiveProductDoc.Product)

    'call a recursive procedure to sort through the current product doc
    Call SortThroughProductList(objActiveProductDoc.Product)

    CATIA.StatusBar = "Done renaming." 'upadte the status bar

    'set the catia application interactivity to true in order to refresh the tree and viewer
    'CATIA.RefreshDisplay does not work unless it is within a VB script module within the product tree using KWA
    'CATIA.ActiveWindow.ActiveViewer.Update does not work to refresh the product tree
    CATIA.Interactive = True
            
End Sub

Public Sub RenameTemporary(ByRef objTempCurrentProduct)
    
    'declare local variables
    Dim objTempChildProduct As Product
    
    'loop through all of the components in the current product
    For Each objTempChildProduct In objTempCurrentProduct.Products
    
        'store part number in an array
        lngTempLstCtr = lngTempLstCtr + 1
        ReDim Preserve strTempList(lngTempLstCtr)
        strTempList(lngTempLstCtr) = objTempChildProduct.PartNumber
        
        'get appropriate instance number
        lngTempQtyCtr = 0
        For lngTempIntCtr = 0 To lngTempLstCtr
            If strTempList(lngTempIntCtr) = objTempChildProduct.PartNumber Then
                lngTempQtyCtr = lngTempQtyCtr + 1
            End If
        Next
        
        'if this product has already been looped through then rename this instance but skip its components
        If lngTempQtyCtr > 1 And objTempChildProduct.Products.Count > 0 Then
            objTempChildProduct.Name = "Renaming" & "." & (UBound(strTempList) + 1)
            CATIA.StatusBar = "Renaming" & "." & (UBound(strTempList) + 1)
        Else
            objTempChildProduct.Name = "Renaming" & "." & (UBound(strTempList) + 1)
            CATIA.StatusBar = "Renaming" & "." & (UBound(strTempList) + 1)
            If objTempChildProduct.Products.Count > 0 Then 'if there are components in the child then loop through them
                Call RenameTemporary(objTempChildProduct.ReferenceProduct) 'call the temp rename procedure from within itself
            End If
        End If
        
    Next

End Sub

Public Sub SortThroughProductList(ByRef objCurrentProduct)
    
    'declare local variables
    Dim objChildProduct As Product
    
    'loop through all of the components in the current product
    For Each objChildProduct In objCurrentProduct.Products
    
        'store part number in an array
        lngLstCtr = lngLstCtr + 1
        ReDim Preserve strList(lngLstCtr)
        strList(lngLstCtr) = objChildProduct.PartNumber
        
        'get appropriate instance number
        lngQtyCtr = 0
        For lngIntCtr = 0 To lngLstCtr
            If strList(lngIntCtr) = objChildProduct.PartNumber Then
                lngQtyCtr = lngQtyCtr + 1
            End If
        Next
        
        'if this product has already been looped through then rename this instance but skip its components
        If lngQtyCtr > 1 And objChildProduct.Products.Count > 0 Then
            objChildProduct.Name = objChildProduct.PartNumber & "." & lngQtyCtr
            CATIA.StatusBar = objChildProduct.PartNumber & "." & lngQtyCtr
        Else
            objChildProduct.Name = objChildProduct.PartNumber & "." & lngQtyCtr
            CATIA.StatusBar = objChildProduct.PartNumber & "." & lngQtyCtr
            If objChildProduct.Products.Count > 0 Then 'if there are components in the child then loop through them
                Call SortThroughProductList(objChildProduct.ReferenceProduct) 'call the procedure from within itself
            End If
        End If
        
    Next

End Sub