Macro pour ajout/suppression propriété

Bonjour,

j ai actuellement plus d une centaine de catpart créer.
Mais aucune n'a de propriéte de type chaine (exemple classe feu fumée) à remplir avec des données que j'ai dans un fichier excel.
donc je cherche a créer une macro qui complète les propriété de la part.


merci pour votre aide

Bonjour Raphaël,

Voici déjà un début de code (VBA) pour rajouter la propriété à ta CATPart:

Code:

Sub CATMain()

Set iProduct = CATIA.ActiveDocument.Product
Set parameters1 = iProduct.UserRefProperties
Set iparameter1 = parameters1.CreateString("Nom de la Propriété", "Valeur de la propriété")

End Sub

Bonjour Lumpazepfel,

impeccable pour ajouter des lignes de propriété. mais pour ceux qui existe, pour les compléter?


Cdt,


Raphael

Merci pour cette aide hyper rapide

voila solution avec tes données
iProduct.PartNumber = "totoooo"
iProduct.Revision = "tataoo"
iProduct.Nomenclature = "titioo"
iProduct.Definition = "oooo"
iProduct.DescriptionRef = "toutout"

OK de rien, javais pas compris que tu voulais aussi renommé les autres propriétés.

As tu trouvé tout ce qu'il te faut?
Comment va tu lier ta liste de CATPart a traiter avec tes valeurs de propriété?

bonjour,

j ai mis du temps a répondre car je suis sur un autre projet et bien entendu ds ce dernier il utilise aussi ce type de macro.
Pour répondre à ta question je vais travailler via un fichier excel avec toutes mes données. *a travers la macro, elle va récupérer les fichiers d'un dossier en les ouvrant automatique.
Maintenant  j utilise des produits de visserie que j'ai récupérer via des fournisseurs mais leurs propriétés ne sont pas top donc je veux toutes les effacer et y mettre les miens.


j ai soucis pour effacer d un bloc les quelques 60 ligne de pro perso. Pour le moment j effectue une boucle


voila un morceau du code :

Code:


Sub CatMain()


Dim fichier As Document
Dim Catia As Object
Dim Dossier
Dim Partdoc
Dim Propriete As String
Dim Nb_prop As Integer, Dep_nb As Integer


On Error Resume Next

Set Catia = GetObject(, "CATIA.Application")

If Err.Number <> 0 Then
    MsgBox ("pas de session catia trouvée")
Else


Dossier = ActiveSheet.Range("A1")



Set fichier = Catia.Documents.Open(Dossier & ActiveSheet.Range("A2"))



Set Partdoc = Catia.ActiveDocument.Product

Nb_prop = Partdoc.UserRefProperties.Count

For Dep_nb = 1 To Nb_prop
    Propriete = Partdoc.UserRefProperties.Item(1).Name
    Partdoc.UserRefProperties.Remove (Propriete)
Next Dep_nb


Partdoc.PartNumber = "totoooo"
Partdoc.Revision = "tataoo"
Partdoc.Nomenclature = "titioo"
Partdoc.Definition = "oooo"
Partdoc.DescriptionRef = "toutout"




End If

End Sub




Salut Raphaël,
 
La solution avec la boucle me paraît pas si mal. J’ai essayé avec une sélection genre :
 
selection1 = oProduct.Selection
selection1.Search "(UserRefProperties, all)"
 
mais je n’ai pas réussi, les sélections c’est pas trop mon truc.

Bonjour

Merci pour vos infos, très utile pour insérer des propriétés dans un part
Avez vous une solution pour faire un nettoyage ou plutôt une suppression des anciennes "autres propriétés" avant de mettre de nouvelles.

Salut,
Ci dessous un petit code pour supprimer TOUTES les "autres propriétés":

Code:

'code VBA
'suppression de toutes les Propriétés utilisateur d'un document
'01/2017 Marc
'http://catiav5.forumactif.org/t1407-macro-pour-ajout-suppression-propriete#6895

Sub CATMain()

Dim myDocument As Document
Set myDocument = CATIA.ActiveDocument

Set myProduct = myDocument.Product
Set myUserProps = myProduct.UserRefProperties

For i = myUserProps.Count To 1 Step -1
    myUserProps.Remove (i)
Next

End Sub

Bonjour

Merci Marc, super pratique...
Aurais-tu la même chose avec la compilation suppression des propriétés et suppression des paramètres.

Voici le code modifié pour supprimer également les paramètres:

Code:

'code VBA
'suppression de toutes les Propriétés utilisateur d'un document
'01/2017 Marc
'http://catiav5.forumactif.org/t1407-macro-pour-ajout-suppression-propriete#6895

Sub CATMain()

Dim myDocument As Document
Set myDocument = CATIA.ActiveDocument

'suppression des "Autres proriétés"
Set myProduct = myDocument.Product
Set myUserProps = myProduct.UserRefProperties

For i = myUserProps.Count To 1 Step -1
    myUserProps.Remove (i)
Next

'suppression des paramètres
Dim oParams As Parameters
If TypeName(myDocument) = "PartDocument" Then
    Set oParams = myDocument.Part.Parameters
    Set oParams = oParams.RootParameterSet.DirectParameters
ElseIf TypeName(myDocument) = "ProductDocument" Then
    Set oParams = myDocument.Product.Parameters
    Set oParams = oParams.RootParameterSet.DirectParameters
ElseIf TypeName(myDocument) = "DrawingDocument" Then
    Set oParams = myDocument.Parameters
    Set oParams = oParams.RootParameterSet.DirectParameters
Else
    MsgBox "Pas de fichier en session"
    Exit Sub
End If
For i = oParams.Count To 1 Step -1
    oParams.Remove (i)
Next
End Sub

Merci Marc

J'ai encore un soucis, je m'excuse d'abuser de tes super macros, mais il faudrait que je puisse
supprimer les relations, j'ai voulu transformer en reprenant la base de ta macro sur les paramètres mais cela ne fonctionne pas. Je débute, donc je galère

Voila le code avec la suppression des relations que j'ai placée en premier.
ATTENTION : Dans le cas d'un Product, les relations du product et des Part sont supprimées

Code:

'code VBA
'suppression de toutes les Propriétés utilisateur d'un document
'01/2017 Marc
'http://catiav5.forumactif.org/t1407-macro-pour-ajout-suppression-propriete#6895

Sub CATMain()

Dim oRelations As Relations
Dim myUserProps As Parameters
Dim oParams As Parameters
Dim myDocument As Document

Set myDocument = CATIA.ActiveDocument


'If TypeName(myDocument) <> "DrawingDocument" Then

If TypeName(myDocument) = "PartDocument" Then
    Set myProduct = myDocument.Product
    Set myUserProps = myProduct.UserRefProperties
    Set oRelations = myDocument.Part.Relations
    Set oParams = myDocument.Part.Parameters
    Set oParams = oParams.RootParameterSet.DirectParameters
   
ElseIf TypeName(myDocument) = "ProductDocument" Then
    Set myProduct = myDocument.Product
    Set myUserProps = myProduct.UserRefProperties
    'ATTENTION : Dans le cas dans Product, les relations du product et des Part sont supprimées
    Set oRelations = myProduct.ReferenceProduct.Relations
    Set oParams = myDocument.Product.Parameters
    Set oParams = oParams.RootParameterSet.DirectParameters

ElseIf TypeName(myDocument) = "DrawingDocument" Then
    Set oRelations = myDocument.DrawingRoot.Relations
    Set oParams = myDocument.Parameters
    Set oParams = oParams.RootParameterSet.DirectParameters

Else
    MsgBox "Pas de fichier en session"
    Exit Sub
End If

'suppression des "Autres proriétés"
If (Not (myUserProps Is Nothing)) Then 'Pour les drawing
    For i = myUserProps.Count To 1 Step -1
        myUserProps.Remove (i)
    Next
End If

'suppression des relations
For i = oRelations.Count To 1 Step -1
    oRelations.Remove (i)
Next
'suppression des paramètres
For i = oParams.Count To 1 Step -1
    oParams.Remove (i)
Next

End Sub

Bonjour

Merci Marc, c'est impeccable, cela fonctionne parfaitement
je te remercie.

Bonjour a tous

Je souhaite informer une valeur a une autre propriété "Matiere" suivant une couleur
Ma méthode pour le moment est:

Selection de produits
Rechercher dans le product partout la couleur (exemple bleu turquoise)
Je renseigne ma propriété matière "Aluminium"

Je fait la même chose avec une autre couleur, ainsi les matières sont rapidement renseignées

Je suis passé par l'enregistrement de macros Catia, mais cela me crée une macro avec le product et les parts que j'utilise, donc je ne peux pas la faire fonctionner sur un autre product

Voici début de code:

Sub CATMain()

Dim productDocument1 As ProductDocument
Set productDocument1 = CATIA.ActiveDocument

Dim selection1 As Selection
Set selection1 = productDocument1.Selection

selection1.Search "Color='(0,255,255)',all"

Dim documents1 As Documents
Set documents1 = CATIA.Documents

Salut Laurent,

Je pense que tu devrais créer un nouveau sujet.

A quel niveau est appliquée la couleur : sur la part, sur le corps ou sur les extrusions...?
Est ce que la règle est identique pour toutes les Part?

Salut Marc

Donc pour répondre à ta question, la couleur est appliquée sur le corps de pièce
toutes mes pièces sont conçues de la même manière

Pour info, le début de macro que j'ai noté ci dessus jusqu'à:
selection1.Search "Color='(0,255,255)',all"

la sélection fonctionne correctement, par contre je n'arrive pas a donner la valeur
texte "aluminium" a mes propriétés.

Merci a+

Salut,

encore une petite question : tu veux renseigner une propriété utilisateur de ta part ou bien affecter à la part une matière issus d'un CATMaterial?

Salut Marc

Je souhaite renseigner une propriété utilisateur dans "autre propriété"

Je suis entrain de relire ma demande, et dans la façon de faire actuellement
il manque des précisions, quand je dis que je fais une sélection, j'active la sélection de part de catia (engrenage+flèche), pour la recherche c'est avec "Rechercher" et dans la fenêtre rechercher, il y a la couleur, je choisis ma couleur et ensuite pré-sélection

Ainsi plusieurs part sont sélectionnés en même temps, je fais propriété et donne une valeur
à la propriété matière et tous mes parts de cette même couleur ont la même matière en l'ayant écrit une seule fois.

J'espère que c'est plus claire,.... tu as raison j'aurai du faire un autre sujet, comment fais-tu pour importer la fenêtre code?

Merci

Salut,

Pour insérer un code il faut cliquer sur l'icone "Code" puis faire un copier coller de ton code entre les deux textes "code" (entre crochets


Pour ta demande, j'étais parti dans une autre direction mais je la poste quand même, ça peut toujours servir:
La macro recherche dans tout le CATProduct des couleurs. En fonction de ces couleurs (à l'intérieur des part), elle va appliquer une matière issue d'un CATMaterial.
Paramètres à adapter dans le code en fonction de l’installation Catia et du Catalogue matière:

Résultat:

Code:

Code:

Sub CATMain()
Dim productDocument1 As ProductDocument
Dim mypart  As Part
Set productDocument1 = CATIA.ActiveDocument

Dim selection1 As Selection
Set selection1 = productDocument1.Selection

    selection1.Search "CATPrtSearch.BodyFeature,all"
'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) = "PartDocument" Or TypeName(myselected) = "Application"
    If TypeName(myselected) = "PartDocument" Then
        Set mypart = myselected.Part
        Call applymat(mypart, "Métaux", "Aluminium")
    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) = "PartDocument" Or TypeName(myselected) = "Application"
    If TypeName(myselected) = "PartDocument" Then
        Set mypart = myselected.Part
        Call applymat(mypart, "Métaux", "Acier")
    End If
Next
selection1.Clear
'Vert-->Acier
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) = "PartDocument" Or TypeName(myselected) = "Application"
    If TypeName(myselected) = "PartDocument" Then
        Set mypart = myselected.Part
        Call applymat(mypart, "Métaux", "Laiton")
    End If
Next
selection1.Clear

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


merci pour les infos, de fait, tu as fait du super boulot avec la matière catalogue, je pense que cela va donner des idées....

Salut Laurent,

J'ai un peu retravaillé la macro et rajouté une fonction pour créer la propriété utilisateur.
- CreateMatProp : rajoute la propriété utilisateur
- ApplyMat : Affecte la matière
Tu peux lancer l'une ou l'autre ou les deux, suivant le besoins.

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"
Call FindPart(selection1)
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
selection1.Clear

'Rouge-->Acier
selection1.Search "Color='(255,0,0)',all"
Call FindPart(selection1)
If Not mypart Is Nothing Then
    Call CreateMatProp(mypart, "Acier")
    Call ApplyMat(mypart, "Métaux", "Acier")
End If
selection1.Clear

'Vert-->Laiton
selection1.Search "Color='(0,255,0)',all"
Call FindPart(selection1)
If Not mypart Is Nothing Then
    Call CreateMatProp(mypart, "Laiton")
    Call ApplyMat(mypart, "Métaux", "Laiton")
End If
selection1.Clear

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

End Sub
Sub FindPart(myselection As Selection)
'Dim mypart  As Part
For i = 1 To myselection.Count
    Set myselected = myselection.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
    End If
Next

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


Salut Marc

J'ai utilisé ta macro, j'ai fait quelques essais et je m'aperçois que si je change la couleur des parts et que relance la macro, il n'y a pas de modification, je pense que le fait de passer par le catalogue qui créer un paramètre matière empêche la modification.

Je pensais a quelque chose de plus simple, ma propriété "matière" étant déjà créée dans toutes mes parts (je ne veux pas créer une propriété) mais la renseigner comme tu nous as appris
Set parameters1 = iProduct.UserRefProperties
iProduct.Matiere = "Aluminium"

Donc je voulais compiler la recherche puis le renseignement de la propriété sur toutes les parts d'un product, quand penses tu?

Salut,
Pour ma part les tests effectués fonctionnent après modification de la couleur , la matière est mise à jour, attention la couleur dans être appliquée dans la Part ( point 2 sur l'image) et non pas au niveau de la part dans le product (point 1  sur l'image ci dessous):


Si tu ne veux pas appliquer de matière Catalogue supprime les lignes :
   

Code:

Call ApplyMat(mypart, "Métaux", "Aluminium")

La fonction CreateMatProp vérifie l'existence de la propriété : si elle existe, elle lui redonne une valeur sinon elle en créée une. Dans la fonction CreateMatProp met bien le nom de ta propriété à la place de Matière

Code:

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

A l'occasion, j'essayerais ta méthode, mais il faut que je reprenne tout...

Salut Marc

J'avais pas compris que ta macro pouvait soit créer une propriété ou donner la valeur de la matière, c'est parfait, ne te lances pas a en faire une autre.

J'arrive bien a faire fonctionner la première macro qui applique la matériau et lorsque je modifie la couleur le matériau se modifie correctement, par contre je n'arrive pas a faire fonctionner la macro qui crée le matériau et la propriété ? erreur "ByRef argument type mismatch", je ne comprends pas car ça bug sur le début de la macro alors que cette partie de la macro fonctionne correctement sur la première macro?

A plus