grimms | Bonjour
Voici une petite contribution
une macro que j'ai cree qui permet de synchroniser les noms de référence et les noms d'instance avec le nom de fichier, ainsi que de renommer les fichiers d'un catproduct en remplaçant une chaines de caractères. Attention la fonction annule ne marche pas.
il ne doit pas y avoir de fichier en mode visualisation.
après utilisation en mode renommage il y as intérêt a faire un envoyer vers car les fichiers avec les anciens noms ne sont pas supprimer.
faite une sauvegarde de vos fichier avant utilisation de la macro.
il faut cree une "listtbox" nommer "part_traite" dans une "userform" nommer "interface"
Merci de ne pas supprimer mon nom ni celui de la personne donc j'ai utiliser un bout de code pour crée la boucle.
si vous vouler le fichier catvba je peut le mettre a disposition
Code :
- '********************************************************
- '********************************************************
- 'By MarkAF, some code borrowed from forums
- 'add rename part and reference By salzard christophe
- '********************************************************
- Public Prefixe As String
- Public Remplacer As String
- Public oList As Variant
- Option Explicit
- Sub CATMain()
- On Error Resume Next
- 'Declarations
- Dim oTopDoc As Document
- Dim oTopProd As ProductDocument
- Dim oCurrentProd As Product
- Dim n As Integer
- 'Check if the active document is an assembly, else exit
- Set oTopDoc = CATIA.ActiveDocument
- If oTopDoc Is Nothing Then
- MsgBox "Must have an assembly open"
- Exit Sub
- End If
-
-
- If Right(oTopDoc.Name, 7) <> "Product" Then
- MsgBox "Active document should be a product"
- Exit Sub
- End If
- Set oCurrentProd = oTopDoc.Product
- Set oList = CreateObject("Scripting.dictionary" )
- CATIA.StatusBar = "Working On" & " " & oCurrentProd.Name
- 'ajout de la boite de dialog
- Dim message, title, defaultValue As String
- Dim msg As String
- ' Set prompt.
- message = "Entree un prefixe" & vbNewLine & "zero pas de prefixe" & vbNewLine & "Cree par salzard christophe"
- ' Set title.
- title = "Prefixe"
- defaultValue = "0" ' Set default value.
- ' Display message, title, and default value.
- msg = InputBox(message, title, defaultValue)
- Prefixe = msg
- ' If user has clicked Cancel, set myValue to defaultValue
- If Prefixe = "0" Then Call RenameSingleLevel(oCurrentProd)
- If Prefixe <> 0 Then
- message = "Remplacer par" & vbNewLine & "zero pas de renommage" & vbNewLine & "Cree par salzard christophe"
- title = "Remplacer"
- defaultValue = "0"
- msg = InputBox(message, title, defaultValue)
- Remplacer = msg
- Call RenameSingleLevel(oCurrentProd) 'Call the subroutine, it is a recursive loop
- CATIA.StatusBar = "Done"
- End If
- End Sub
- Private Sub RenameSingleLevel(ByRef oCurrentProd As Product)
- On Error Resume Next
- 'More declarations
- Dim ItemToRename As Product
- Dim ToRenamePartNumber As String
- Dim ToRenamename As String
- Dim Tmp As String
- Dim NumberOfItems As Long
- Dim RenameArray(2000) As String
- Dim i As Integer
- Dim j As Integer
- Dim k As Integer
- Dim l As Integer
- Dim m As Integer
- Dim n As Integer
- Dim typ As Integer ' typ = 0 product typ = 1 part
- Dim statut As Integer '1 on traite 0 on ne traite pas
- Dim iPartDoc As Document
- 'Dim part_traite As ListBox
- interface.part_traite.Clear
- interface.part_traite.AddItem "test"
- Set oCurrentProd = oCurrentProd.ReferenceProduct 'You have to work with the "ReferenceProduct" object
- NumberOfItems = oCurrentProd.Products.Count
- 'Run through this loop once, to set everything to a dummy name, to avoid naming conflicts
- For i = 1 To NumberOfItems 'Cycle through the assembly's children
- Set ItemToRename = oCurrentProd.Products.Item(i) 'Declare which item we are working on
-
- ToRenamePartNumber = ItemToRename.PartNumber 'Get the Part Number
-
-
- If InStr(ToRenamePartNumber, "-_" ) <> 0 Then 'Check for KT #'s, should exist only in CGRs
- ToRenamePartNumber = Left(ToRenamePartNumber, (InStr(ToRenamePartNumber, "-_" ) - 1))
- End If
-
- RenameArray(i) = ToRenamePartNumber 'Building the list of part names for the numbering loop
-
- k = 0 'Numbering Loop
- For j = 1 To i 'This loop checks and sets the instance number
- If RenameArray(j) = ToRenamePartNumber Then
- k = k + 1
- End If
- Next
-
- ' recuperation du nom de fichier
- typ = 0
- statut = 0
- If Right(ItemToRename.ReferenceProduct.Parent.Name, 8) = ".CATPart" Then
- ToRenamename = Left(ItemToRename.ReferenceProduct.Parent.Name, Len(ItemToRename.ReferenceProduct.Parent.Name) - 8)
- typ = ".CATPart"
- End If
- If Right(ItemToRename.ReferenceProduct.Parent.Name, 11) = ".CATProduct" Then
- ToRenamename = Left(ItemToRename.ReferenceProduct.Parent.Name, Len(ItemToRename.ReferenceProduct.Parent.Name) - 11)
- typ = ".CATProduct"
- End If
-
- ' simple synchro
- If Prefixe = "0" Then
- ItemToRename.PartNumber = ToRenamename
- statut = 1
- GoTo synchro
- End If
- 'on ne renomme pas un fichier deja fait
- For n = 0 To (interface.part_traite.ListCount - 1)
- If ItemToRename.PartNumber = interface.part_traite.List(n) Then GoTo synchro3
- Next
-
- 'detection du texte
- m = Len(ToRenamename) - Len(Prefixe)
- For l = 1 To (m + 1)
- 'mode synchro avec filtrage
- If Prefixe = Mid(ToRenamename, (l), Len(Prefixe)) And Remplacer = "0" Then
- ItemToRename.PartNumber = ToRenamename
- statut = 1
- GoTo synchro1
- End If
- 'mode remplacer
- If Prefixe = Mid(ToRenamename, (l), Len(Prefixe)) And Not Remplacer = "0" And Not Remplacer = Mid(ToRenamename, (l), Len(Remplacer)) Then
- statut = 1
- ToRenamename = Left(ToRenamename, (l - 1)) & Remplacer & Right(ToRenamename, (m))
-
- 'on renomme le fichier
- ItemToRename.PartNumber = ToRenamename
- CATIA.Application.DisplayFileAlerts = False
- Call CATIA.Documents.Item(ItemToRename.ReferenceProduct.Parent.Name).SaveAs(ItemToRename.ReferenceProduct.Parent.Path & "\" & ToRenamename) '& typ
- Call CATIA.Documents.Item(ItemToRename.ReferenceProduct.Parent.Path & "\" & ToRenamename).Close
- CATIA.Application.DisplayFileAlerts = True
-
-
- interface.part_traite.AddItem (ItemToRename.PartNumber)
-
- GoTo synchro2
- End If
- Next
- GoTo saut
- 'synchro
- synchro:
- synchro1:
- synchro2:
- synchro3:
- If statut = 1 Then
- CATIA.StatusBar = ItemToRename.Name & " > " & ToRenamePartNumber & "." & k
- ToRenamePartNumber = ItemToRename.PartNumber
- ItemToRename.Name = ToRenamePartNumber & "TEMP." & k 'Set the new instance name, to a TEMP dummy value
- End If
- saut:
- Next
- 'Run through this loop to set the name finally, then the recursion call
- For i = 1 To NumberOfItems
- Set ItemToRename = oCurrentProd.Products.Item(i)
-
- ToRenamePartNumber = ItemToRename.PartNumber 'Toggle these two lines for testing
- 'ToRenamePartNumber = ItemToRename.DescriptionRef
-
- RenameArray(i) = ToRenamePartNumber
-
- k = 0
- For j = 1 To i
- If RenameArray(j) = ToRenamePartNumber Then
- k = k + 1
- End If
- Next
-
- CATIA.StatusBar = ItemToRename.Name & " > " & ToRenamePartNumber & "." & k
- ItemToRename.PartNumber = ItemToRename.ReferenceProduct '
-
-
- ItemToRename.Name = ToRenamePartNumber & "." & k 'Set the new instance name final
-
- If ItemToRename.Products.Count <> 0 Then 'Recursive Call
- If oList.exists(ItemToRename.PartNumber) Then GoTo Finish
- If ItemToRename.PartNumber = ItemToRename.ReferenceProduct.Parent.Product.PartNumber Then oList.Add ItemToRename.PartNumber, 1
- Call RenameSingleLevel(ItemToRename)
- End If
- Finish:
- Next
- End Sub
|
|