Macro pour ajout/suppression propriété

Page 2 sur 2 Précédent  1, 2

Voir le sujet précédent Voir le sujet suivant Aller en bas

R?solu Re: Macro pour ajout/suppression propriété

Message par lumpazepfel le Jeu 2 Fév 2017 - 7:06

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.
avatar
lumpazepfel
actif
actif

Messages : 148
Date d'inscription : 03/11/2015
Localisation : Ensisheim

Revenir en haut Aller en bas

R?solu Re: Macro pour ajout/suppression propriété

Message par lgesl1catia le Jeu 2 Fév 2017 - 8:47

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?
avatar
lgesl1catia
actif
actif

Messages : 33
Date d'inscription : 24/11/2016
Localisation : orne

Revenir en haut Aller en bas

R?solu Re: Macro pour ajout/suppression propriété

Message par lumpazepfel le Jeu 2 Fév 2017 - 23:48

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.
avatar
lumpazepfel
actif
actif

Messages : 148
Date d'inscription : 03/11/2015
Localisation : Ensisheim

Revenir en haut Aller en bas

R?solu Re: Macro pour ajout/suppression propriété

Message par Contenu sponsorisé


Contenu sponsorisé


Revenir en haut Aller en bas

Page 2 sur 2 Précédent  1, 2

Voir le sujet précédent Voir le sujet suivant Revenir en haut


 
Permission de ce forum:
Vous ne pouvez pas répondre aux sujets dans ce forum