Macro pour ajout/suppression propriété

Salut,

Je n'arrive pas à reproduire ton erreur, mais j'ai découvert un autre problème avec la fonction FindPart, je suis donc revenu en arrière sur la structure précédente:

Code:

'*******************************************************************************************
'   Macro d'affectation d'une matière catalogue et/ou d'une propriété utilsateur matière
'   en fonction de la couleur de la part
'   Il faut un CATProduct actif, et définir:
'   -le chemin du catalogue matière dans la variable installpath
'   -le nom du catalogue matière dans la variable catalogfile
'   -le nom des matériaux souhaités pour chaque couleur
'   Marc 01/2017
'   http://catiav5.forumactif.org/t1407-macro-pour-ajout-suppression-propriete#6926
'*******************************************************************************************
Public mypart  As Part

Sub CATMain()
Dim productDocument1 As ProductDocument

Set productDocument1 = CATIA.ActiveDocument

Dim selection1 As Selection
Set selection1 = productDocument1.Selection

'Cyan-->Aluminium
selection1.Search "Color='(0,255,255)',all"
For i = 1 To selection1.Count
    Set myselected = selection1.Item(i).Value
    Do  'remonte vers la PART à partir de l'élément sélectionné
        Set myselected = myselected.Parent
    Loop Until TypeName(myselected) = "Part" Or TypeName(myselected) = "Application"
    If TypeName(myselected) = "Part" Then
        Set mypart = myselected '.Part
        If Not mypart Is Nothing Then
            Call CreateMatProp(mypart, "Aluminium") '--> pour créer une propriété utilisateur
            'Call ApplyMat(mypart, "Métaux", "Aluminium") '--> pour affecter une matière du catalogue
        End If
    End If
Next
selection1.Clear

'Rouge-->Acier
selection1.Search "Color='(255,0,0)',all"
For i = 1 To selection1.Count
    Set myselected = selection1.Item(i).Value
    Do  'remonte vers la PART à partir de l'élément sélectionné
        Set myselected = myselected.Parent
    Loop Until TypeName(myselected) = "Part" Or TypeName(myselected) = "Application"
    If TypeName(myselected) = "Part" Then
        Set mypart = myselected '.Part
        If Not mypart Is Nothing Then
            Call CreateMatProp(mypart, "Acier")
            'Call ApplyMat(mypart, "Métaux", "Acier")
        End If
    End If
Next
selection1.Clear

'Vert-->Laiton
selection1.Search "Color='(0,255,0)',all"
For i = 1 To selection1.Count
    Set myselected = selection1.Item(i).Value
    Do  'remonte vers la PART à partir de l'élément sélectionné
        Set myselected = myselected.Parent
    Loop Until TypeName(myselected) = "Part" Or TypeName(myselected) = "Application"
    If TypeName(myselected) = "Part" Then
        Set mypart = myselected '.Part
        If Not mypart Is Nothing Then
            Call CreateMatProp(mypart, "Laiton")
            'Call ApplyMat(mypart, "Métaux", "Laiton")
        End If
    End If
Next

selection1.Clear

'compléter avec autant de couleur que nécessaire

End Sub
' ---------------------------------------------
' *** Pocédure appliq. la matière à la part ***
' ---------------------------------------------
Sub ApplyMat(mypart As Part, myfamily As String, mymaterial As String)

'Nom du catalogue de matière :
Const catalogfile = "Catalog.CATMaterial"
'Chemin de localisation du catalogue de matière :
installpath = "D:\catiaV5\r22sp3\win_b64\startup\materials\French\"
Dim oMaterial As MaterialDocument
Set oMaterial = CATIA.Documents.Read(installpath & catalogfile)

Dim mymatfamily As MaterialFamily
Set mymatfamily = oMaterial.Families.Item(myfamily)

Dim mymat_list As Materials
Set mymat_list = mymatfamily.Materials

Dim mymat As Material
Set mymat = mymat_list.Item(mymaterial)

Set oManager = mypart.GetItem("CATMatManagerVBExt")
LinkMode = 0

oManager.ApplyMaterialOnPart mypart, mymat, LinkMode

End Sub
' ----------------------------------------------------------
' *** Pocédure créer une propriété utilisateur "Matière" ***
' ----------------------------------------------------------
Sub CreateMatProp(mypart As Part, mymaterial As String)

Set parameters1 = mypart.Parent.Product.UserRefProperties
On Error Resume Next
test = parameters1.Item("Matière").Value
If Err.Number = 0 Then
    parameters1.Item("Matière").Value = mymaterial
Else
    Set iparameter1 = parameters1.CreateString("Matière", mymaterial)
End If

Err.Clear
On Error GoTo 0

End Sub


Si tu as une erreur, précise STP la ligne où elle se produit.
Poste également le code si tu fais des modifications.

Salut Marc

Merci beaucoup pour le développement, la macro fonctionne parfaitement.

Pour mon info personnel, a quoi sert la première ligne "Public mypart As Part" avant "Sub CATMain()

Combien de temps pour faire une telle macro?

Salut,

1."Public" permet de déclarer une variable qui sera visible dans toutes les procédures et fonctions d'un projet VBA, contrairement à "Dim" qui ne déclare la variable que dans la procédure où elle est utilisée.
Dans notre cas, la déclaration en public n'est plus nécessaire:

Code:

'*******************************************************************************************
'Public mypart  As Part --> utilisable dans toutes les procédures

Sub CATMain()
Dim mypart  As Part '--> utilisable que dans la procédure où elle est déclarée (ici CATMain)
Dim productDocument1 As ProductDocument


2.Le temps pour faire une macro est très variable, je ne suis pas programmeur et on peut rapidement tomber sur un os. Il faut commencer par définir précisément ce qu'on veut faire.