What am I doing wrong here!?! (Renaming instances)

[CheeseMaker13]

HI Guys,

Pulling my hair out here, because whatever I do I cannot get instances within a component to rename.

Essentially I have a product with a component at the end of the tree with loads more parts inserted in there.

This code drills down to it and then renames them sequentially:

Sub CATMain()

    Set oDocument = CATIA.ActiveDocument
    Set oProduct = oDocument.Product
    Set oProducts = oProduct.Products

    Set oProducts = oProduct.Products.Item(oProduct.Products.Count).Products

    'Rename Instances Sequentially
    For i = 1 To oProducts.Count
        Set ProductRename = oProducts.Item(i)
        ProductRename.Name = i
    Next

End Sub

However, nothing happens. No error, no nothing. Not even " ProductRename.Name = "TEST" " results in anything!!!

    'Rename Instances Sequentially
    For i = 1 To oProducts.Count
        Set ProductRename = oProducts.Item(i)
        ProductRename.Name = i
    Next

Works perfectly at the upper level (Set oProducts = oProduct.Products).

Any thoughts on what I'm doing wrong?

 

[ntweisen]

Try adding ReferenceProduct:

Set oDocument = CATIA.ActiveDocument
Set oProduct = oDocument.Product
Set oProducts = oProduct.Products

Set product2 = oProducts.Item(2).Referenceproduct
MsgBox product2.Name
product2.PartNumber = "rename test"

Add something like this to your loop:

Set oProdToRename = Selection.Item(I).Value.ReferenceProduct
oProdToRename.PartNumber = "new part number"

http://excelspreadsheetshelp.blogspot.com

-

http://scripting4v5.com

 

[CheeseMaker13]

Thanks. That worked a treat.

My code is now:

Sub Test()

    Set oDocument = CATIA.ActiveDocument
    Set oProduct = oDocument.Product
    Set oProducts = oProduct.Products
    Set oSelection = oDocument.Selection
    Set oConstraints = oProduct.Connections("CATIAConstraints")
    Set oProducts = oProduct.Products.Item(oProduct.Products.Count).ReferenceProduct

    'Rename Instances Sequentially
    For i = 1 To oProducts.Count
        Set ProductRename = oProducts.Item(i)
        ProductRename.Name = "Item." & i
    Next

    '***** Refix Everything *****
    For i = 1 To oProducts.Count
        Set oReference = oProduct.CreateReferenceFromName(oProducts.Item(i).Name & "/!")
        Set oNewFix = oConstraints.AddMonoEltCst(catCstTypeReference, oReference)
        Set oConstraintName = oConstraints.Item(i)
        oConstraintName.Name = "Fix." & i
    Next

End Sub

This works nicely if I'm fixing the root of the product (Set oProducts = oProduct.Products) but it hangs at "Set oNewFix = oConstraints.AddMonoEltCst(catCstTypeReference, oReference)" when using this (Set oProducts = oProduct.Products.Item(oProduct.Products.Count).ReferenceProduct).

Ideas?

Thanks guys!

 

[MarcL68]

Hello,

I found this script ant it renames all Instances even in sub products and/or components

Public sPN() As String
Public lCount() As Long
Public lnn As Long
Public bExist As Boolean
Public stempPartNumber As String
Public sPartNumberCache() As String
Public lPartNumberCacheSize As Long
Public bExistInCache As Boolean
          '************************************************************
          '***  Macro de renommage automatique des instances        ***
          '************************************************************
Sub CATMain()
lnn = 1
ReDim sPN(lnn)
ReDim lCount(lnn)
sPN(0) = ""
sPN(1) = ""
lCount(0) = 0
lCount(1) = 0
bExist = False
stempPartNumber = ""
lPartNumberCacheSize = 1

ReDim sPartNumberCache(lPartNumberCacheSize)
sPartNumberCache(0) = ""
sPartNumberCache(1) = ""
bExistInCache = False
'Vérifie que le document actif soit un CATProduct
Dim monDocument As Document
On Error Resume Next
Set monDocument = CATIA.ActiveDocument
If Err.Number <> 0 Then
    MsgBox "La fenêtre active doit être un CATProduct"
    Exit Sub
End If
On Error GoTo 0
If TypeName(monDocument) <> "ProductDocument" Then
    MsgBox "La fenêtre active doit être un CATProduct"
    Exit Sub
End If
Dim monProduit As Product
Set monProduit = monDocument.Product
If monProduit.Products.Count > 0 Then
        Call fSetProductName(monProduit, monDocument)
        lPartNumberCacheSize = 1
        ReDim sPartNumberCache(lPartNumberCacheSize)
        sPartNumberCache(0) = ""
        sPartNumberCache(1) = ""
        bExistInCache = False
Else
        MsgBox "Ce produit est vide!"
End If
End Sub

Function fSetProductName(monProduit As Product, monDocument As Document)
On Error Resume Next
Dim otempProduct As AnyObject
For i = 1 To monProduit.Products.Count
    stempPartNumber = monProduit.Products.Item(i).PartNumber
        For j = 1 To lnn
            If stempPartNumber = sPN(j) Then
            lCount(j) = lCount(j) + 1
            monProduit.Products.Item(i).Name = stempPartNumber & "." & CStr(lCount(j))
            bExist = True
            Exit For
        End If
    Next
    If bExist = False Then
        lnn = lnn + 1
        ReDim Preserve sPN(lnn)
        ReDim Preserve lCount(lnn)
        sPN(lnn) = stempPartNumber
        lCount(lnn) = 1
        monProduit.Products.Item(i).Name = stempPartNumber & "." & CStr(lCount(lnn))
    End If
    bExist = False
Next
lnn = 1
ReDim sPN(lnn)
ReDim lCount(lnn)
sPN(0) = ""
sPN(1) = ""
lCount(0) = 0
lCount(1) = 0
stempPartNumber = ""
For i = 1 To monProduit.Products.Count
    If monProduit.Products.Item(i).Products.Count > 0 Then
        stempPartNumber = monProduit.Products.Item(i).PartNumber
        For j = 1 To lPartNumberCacheSize
            If sPartNumberCache(j) = stempPartNumber Then
                bExistInCache = True
                Exit For
            End If
        Next
        If bExistInCache = False Then
            lPartNumberCacheSize = lPartNumberCacheSize + 1
            ReDim Preserve sPartNumberCache(lPartNumberCacheSize)
            sPartNumberCache(lPartNumberCacheSize - 1) = stempPartNumber
            On Error Resume Next
            Set otempProduct = monDocument.GetItem(stempPartNumber)
            Call fSetProductName(otempProduct, monDocument)
            On Error GoTo 0
        End If
        stempPartNumber = ""
        bExistInCache = False
    End If
Next
End Function

Marc

 

[CheeseMaker13]

Hi MarcL68,

My script for renaming instances works fine.

It's adding the fixes again!!