Renommer les trous d'une CATPart

Salut à tous,

J'ai écrit une macro qui renomme les trous avec ses dimensions (voir image).
Pour cela j'utilise : "selection2.Search "Type=Trou,sel"".
Le problème est que cette ligne de commande est dépendante de la langue utilisateur.
Existe t il une commande équivalente et indépendante de la langue?

Voici le code:

Code:


' ---------------------------------------------------------
' *** Macro de renommage des trous avec leur dimension  ***
' ***                                                   ***
' ---------------------------------------------------------
Sub CATMain()

Dim oPartDoc As PartDocument
Dim oBody As Body
Dim oHole As Hole
Dim i As Integer
Dim selection1 As Selection
Dim selection2 As Selection
Dim oHolename As String

' --------------------------------------------------------
' ***  Vérifie que le document actif soit une CATPart  ***
' --------------------------------------------------------

On Error Resume Next
Set oPartDoc = CATIA.ActiveDocument
    If (Err.Number <> 0) Then
        MsgBox ("Une CATPart doit être active")
        Exit Sub
    End If
    If TypeName(oPartDoc) <> "PartDocument" Then
        MsgBox "Une CATPart doit être active"
        Exit Sub
    End If
Err.Clear
On Error GoTo 0

Set selection1 = oPartDoc.Selection

selection1.Search "(CATPrtSearch.BodyFeature),all"

For j = 1 To oPartDoc.Part.Bodies.Count

    oPartDoc.Part.InWorkObject = oPartDoc.Part.Bodies.Item(j)
    Set selection2 = oPartDoc.Selection
    'Attention variante suivant langue utilisateur:
    selection2.Search "Type=Trou,sel"
    'selection2.Search "Type=Hole,sel"

    For i = 1 To selection2.Count
        
        Set oHole = selection2.Item(i).Value
        On Error Resume Next
        'Pour trou taraudée :
        oHole.Name = oHole.HoleThreadDescription.ValueAsString ' & "x" & oHole.ThreadPitch.ValueAsString
        'Pour trou lisse :
        If Err.Number <> 0 Then
            oHole.Name = "Trou Ø" & oHole.Diameter.Value
        End If
        Err.Clear
        
    Next i
    selection2.Clear
Next j

End Sub



je vais répondre vite car manque de temps.
d'une part :
pour les commande ... ne pas utiliser le search est une bonne option. ...
le mieux est de balayer chaque opération de ton arbre et de vérifier si c'est un trou et de le traiter en conséquence

deuxièmement, d'un point de vue qualité : le fait de mettre des informations qui ne sont pas "réelle" j'entend par la que si le m6 est changé en m5 et que la macro n'est pas lancée... il y aura erreur

et enfin.... demain, jéssaierai de poster le code que j'ai fait pour renomer les trous ...
bonne soirée

Bonjour Mike,

Il est vrai que la mise à jour n'est pas garantie, mais le but est plus informatif que fonctionnel.
Ceci dit, j'ai suivi ton conseil et ça fonctionne. J'ai donc voulu aller plus loin et rajouter les valeurs de lamages, chanfrein...
Et là nouveau problème : avec les trous chanfreinées en mode "diamètre/angle" et "diamètre/profondeur" , la propriété "HeadDiameter" échoue (à priori quelque soit les types, les propriétés HeadAngle et HeadDepth sont renseignées)!
Une idée?

Code:


' -----------------------------------------------------------
' *** Macro de renommage des trous avec leurs dimensions  ***
' ***                                                     ***
' -----------------------------------------------------------
Sub CATMain()


Dim i As Integer
Dim z As Integer
Dim oNbShape As Integer
Dim oPartDoc As PartDocument
Dim oFeature As Shape

CATIA.DisplayFileAlerts = False

' --------------------------------------------------------
' ***  Vérifie que le document actif soit une CATPart  ***
' --------------------------------------------------------

On Error Resume Next
Set oPartDoc = CATIA.ActiveDocument
    If (Err.Number <> 0) Then
        MsgBox ("Une CATPart doit être active")
        Exit Sub
    End If
    If TypeName(oPartDoc) <> "PartDocument" Then
        MsgBox "Une CATPart doit être active"
        Exit Sub
    End If
Err.Clear
On Error GoTo 0

For j = 1 To oPartDoc.Part.Bodies.Count

    oPartDoc.Part.InWorkObject = oPartDoc.Part.Bodies.Item(j)
        oNbShape = oPartDoc.Part.Bodies.Item(j).Shapes.Count
        For z = 1 To oNbShape
            Set oFeature = oPartDoc.Part.Bodies.Item(j).Shapes.Item(z)
            On Error Resume Next
            oFeatureType = oFeature.Type
            If Err.Number = 0 Then
                      
                If oFeature.ThreadingMode = catThreadedHoleThreading Then
                    'Pour trou taraudée :
                    oFeature.Name = oFeature.HoleThreadDescription.ValueAsString
                Else
                    'Pour trou lisse :
                    oFeature.Name = "Trou Ø" & oFeature.Diameter.Value
                End If
                Select Case oFeatureType
                Case 0
                    'MsgBox "trou simple"
                Case 1
                    'MsgBox "trou conique"
                    oFeature.Name = oFeature.Name & " conique à " & oFeature.HeadAngle.Value & "°"
                Case 2
                    'MsgBox "trou lamé"
                    oFeature.Name = oFeature.Name & " Lamé Ø" & oFeature.HeadDiameter.Value & "x" & oFeature.HeadDepth.Value
                Case 3
                    'MsgBox "trou chanfreiné"
                    If oFeature.CounterSunkMode = catCSModeDepthAngle Then 'chanfrein angle et profondeur
                        oFeature.Name = oFeature.Name & " Ch." & "x" & oFeature.HeadDepth.Value & "x" & oFeature.HeadAngle.Value & "°"
                    ElseIf oFeature.CounterSunkMode = catCSModeAngleDiameter Then 'chanfrein angle et diamètre
                        oFeature.Name = oFeature.Name & " Ch." & oFeature.HeadAngle.Value & "°" & "xØ" ' & oFeature.HeadDiameter.Value & "x"
                    ElseIf oFeature.CounterSunkMode = catCSModeDepthDiameter Then 'chanfrein profondeur et diamètre
                        oFeature.Name = oFeature.Name & "Ch." & oFeature.HeadDepth.Value & "xØ" '& oFeature.HeadDiameter.Value
                    End If

                Case 4
                    'MsgBox "trou lamé chanfreiné"
                    oFeature.Name = oFeature.Name & " Lamé Ø" & oFeature.HeadDiameter.Value & "x" & oFeature.HeadDepth.Value & "x" & oFeature.HeadAngle.Value & "°"
                End Select
            End If
            Err.Clear
            On Error GoTo 0
        Next z
Next j
oPartDoc.Part.InWorkObject = oPartDoc.Part.Bodies.Item(1)
End Sub