Bonjour Gawel, J'ai essayé cette boucle mais je n'ai pas de résultat satisfaisant : :( aucun message d'erreur mais les contraintes ne sont pas supprimées ! quand je la passe en mode pas à pas, ConstraintsProduits.Count contient bien le nombre de contraintes (5) mais .remove n'a aucun effet. Je pense que cela provient de ProduitEnCours. Faut-il rendre le produit actif ? ou autre méthode pour bien prendre en compte le produit avant de faire la "connection" de la collection de contraintes. :casstet: voici mon code conernant le traitement des contraintes
Option Base 1
Sub Fixation(ByRef ProduitEnCours As Product, _
ByVal NB_sous_produits As Integer, ByVal niveau As Integer)
'
'On Error GoTo ErrorHandler
'
'-----------------------------------------------------------------------------------------
'Déclaration des variables
'-----------------------------------------------------------------------------------------
Dim TABLE_reference() As Reference '
Dim ConstraintsProduits As Variant '
Dim ConstraintsAeffacer As Constraints '
Dim TABLE_constraint() As Constraint '
Dim ListeDesContraintesAEffacer() As Variant '
Dim NOM_REF As String '
Dim i As Integer '
Dim NUMEROPART As String '
Dim NOM As String '
Dim INSTANCE As String '
Dim NomDuProduitEncours As String '
Dim NumContrainte As Variant '
'
'-----------------------------------------------------------------------------------------
'Initialisation des variables
'-----------------------------------------------------------------------------------------
Set ConstraintsProduits = ProduitEnCours.Connections("CATIAConstraints")
Set ConstraintsAeffacer = ProduitDocumentActif.Product.Connections("CATIAConstraints")
ReDim TABLE_reference(NB_sous_produits)
ReDim TABLE_constraint(NB_sous_produits)
NomDuProduitEncours = ProduitEnCours.Name
Debug.Print NomDuProduitEncours
'
'-----------------------------------------------------------------------------------------
'Suppression des contraintes existantes
'-----------------------------------------------------------------------------------------
' _______________________________________________________________________
' Vérifie si on se trouve dans le niveau de tete
If niveau = 1 Then
Debug.Print "Traitment des contraintes du niveau 1"
Debug.Print "Tete de l'assemblage"
ReDim ListeDesContraintesAEffacer(ConstraintsAeffacer.Count)
' _________________________________________________________________
' Recuperation de la liste des contraintes
For NumContrainte = 1 To ConstraintsAeffacer.Count
ListeDesContraintesAEffacer(NumContrainte) = ConstraintsAeffacer.ITEM(NumContrainte).Name
Next NumContrainte
' _________________________________________________________________
' Effacement des contraintes de la liste
For NumContrainte = 1 To UBound(ListeDesContraintesAEffacer)
f.WriteLine "suppression de la contrainte " & ListeDesContraintesAEffacer(NumContrainte)
ConstraintsAeffacer.Remove (ListeDesContraintesAEffacer(NumContrainte))
Next NumContrainte
' _______________________________________________________________________
' Traitement de tous les autres niveaux
Else
Debug.Print "Traitment des contraintes du niveau " & niveau
ReDim ListeDesContraintesAEffacer(ConstraintsProduits.Count)
' _________________________________________________________________
' Recuperation de la liste des contraintes
'For NumContrainte = 1 To ConstraintsProduits.Count
' LENom = ConstraintsProduits.ITEM(NumContrainte).Name
' ListeDesContraintesAEffacer(NumContrainte) = LENom
'Next NumContrainte
' _________________________________________________________________
' Effacement des contraintes de la liste
'For NumContrainte = 1 To UBound(ListeDesContraintesAEffacer)
' f.WriteLine "suppression de la contrainte " & ListeDesContraintesAEffacer(NumContrainte)
' ConstraintsProduits.Remove (ListeDesContraintesAEffacer(NumContrainte))
'Next NumContrainte
'Dim i As Integer
'Dim ConstraintsProduits As Variant
'===============================
'test de Gawel
'===============================
For i = 1 To ConstraintsProduits.Count
ConstraintsProduits.Remove (ConstraintsProduits.Count)
Next
'
'
' TEST d'une autre facon, qui ne marche par non plus
'For NB = NB_Contrainte To 1 Step -1
' ConstraintsProduits.Remove (NB)
'Next NB
'
' TEST d'une autre facon, qui ne marche par non plus
'A = 0
'While ConstraintsProduits.Count <> 0
' A = A + 1
' 'f.WriteLine "suppression de la contrainte " & ConstraintsProduits.ITEM(ConstraintsProduits.Count).Name
' ConstraintsProduits.Remove (ConstraintsProduits.Count)
' NB_Contrainte = ConstraintsProduits.Count
' Debug.Print A & ", " & ConstraintsProduits.Count
'Wend
'
'
End If
'
'-----------------------------------------------------------------------------------------
'Création des nouvelles contraintes : Ancres
'-----------------------------------------------------------------------------------------
' _______________________________________________________________________
' Vérification de la collection de contraintes : elle doit être vide
If ConstraintsProduits.Count <> 0 Then
Err.Raise 9000, "Programme.ConstraintsProduits.Remove", "Les contraintes n'ont pas été supprimé !"
End If
'
For i = 1 To ProduitEnCours.Products.Count
' _______________________________________________________________________
' Récupération des paramètres du produit en cours
Debug.Print "Encrage n°" & i
NUMEROPART = ProduitEnCours.Products.ITEM(i).PartNumber '
Debug.Print "PartNumber : " & NUMEROPART
INSTANCE = ProduitEnCours.Products.ITEM(i).Name '
Debug.Print "Instance : " & INSTANCE
' _______________________________________________________________________
' Ecriture de la Référence de la nouvelle contrainte
NOM_REF = NomDuProduitEncours & "/" & INSTANCE & "/!" & NomDuProduitEncours & "/" & INSTANCE & "/"
Debug.Print NOM_REF
' _______________________________________________________________________
' Insertion de la référence dans la liste des nouvelles contraintes
Set TABLE_reference(i) = ProduitEnCours.CreateReferenceFromName(NOM_REF)
' _______________________________________________________________________
' Création de la nouvelle contrainte
Set TABLE_constraint(i) = ConstraintsProduits.AddMonoEltCst(catCstTypeReference, TABLE_reference(i))
' _______________________________________________________________________
' Modification du type de contrainte
' Fixité absolue : catCstRefTypeFixInSpace
' Fixité relative : catCstRefTypeRelative
TABLE_constraint(i).ReferenceType = catCstRefTypeFixInSpace
'
Debug.Print ""
'
Next
'
Exit Sub
'
'-----------------------------------------------------------------------------------------
'Traitement des erreurs
'-----------------------------------------------------------------------------------------
ErrorHandler:
'
If Err.Number = 91 Or Err.Number = -2147418113 Or Err.Number = -2147467259 Then
Resume Next
Else
'
Debug.Print "Erreur numéro :" & Err.Number
Debug.Print Err.Description
REPONSE = MsgBox("Erreur numéro :" & Err.Number & Chr(13) & Err.Description & Chr(13) & Chr(13) _
& "erreur sur le fichier n°" & i & Chr(13) & Chr(13) & "Ok pour continuer, Cancel pour Terminer.", vbOKCancel, "Attention")
'
' MsgBox REPONSE
If REPONSE = 1 Then
Resume Next
Else
MsgBox "Opération annulée"
Exit Sub
End If
End If
'
End Sub
et pour vérifier la déclaration du produit en cours voici le code concernant la boucle récursive
' ****************************************************************
' * Programme CATIA VBA V5R14 *
' * Auteur : Hervé Sabatou *
' * Société : © CEMA - Groupe ALEMA *
' * *
' ****************************************************************
' ---------------------------------
' Scanner + ancrage automatique
' ---------------------------------
'
' - Fonction : Ce programme scanne un assemblage complet
' Il supprime l'ensemble des contraintes de
' chaque produit et les remplace par des ancres
'
' - Version : 1.0
' - Date : juillet 2005
'
'-----------------------------------------------------------------------------------------
'Déclaration des variables publics
'-----------------------------------------------------------------------------------------
Public f, fso, fso2 'Variable Filesystem pour création du fichier
Public ProduitDeTete As String 'Nom du produit de tete
Public RepertoireBase As String 'Chemin du produit de tete
Public ProduitDocumentActif As ProductDocument 'Document actif de tete
'
'
Sub CATMain()
'-----------------------------------------------------------------------------------------
'Déclaration des variables
'-----------------------------------------------------------------------------------------
Dim documents1 As Documents
Set documents1 = CATIA.Documents
'
'-----------------------------------------------------------------------------------------
'Sélection du document actif
'-----------------------------------------------------------------------------------------
Set ProduitDocumentActif = CATIA.ActiveDocument
ProduitDeTete = ProduitDocumentActif.Name
RepertoireBase = ProduitDocumentActif.Path
'
'-----------------------------------------------------------------------------------------
'Programme
'-----------------------------------------------------------------------------------------
CreationFichierTexte 'Ouvre un fichier trace dans le %TEMP%
'
analyse ProduitDocumentActif.Product, 0 'Lance la boucle récursive et traite les actions
'
FermeFichierTexte 'Ferme le fichier trace dans le %TEMP%
'
'
End Sub
Sub analyse(ProduitEnCours As Product, ByVal niveau As Integer)
'
'-----------------------------------------------------------------------------------------
'Déclaration des variables
'-----------------------------------------------------------------------------------------
Dim tabulation, tabulation2 As String
tabulation = Space(5 * niveau)
niveau = niveau + 1
'
'-----------------------------------------------------------------------------------------
'Charge le composant
'-----------------------------------------------------------------------------------------
ProduitEnCours.ActivateDefaultShape
'
'-----------------------------------------------------------------------------------------
'Ecriture du nom du produit dans le fichier trace
'-----------------------------------------------------------------------------------------
chaine = tabulation & "Niveau " & niveau & _
" : " & ProduitEnCours.Name & " - " & _
ProduitEnCours.DescriptionRef
f.WriteLine chaine
Debug.Print chaine
'
tabulation2 = tabulation & Space(5)
'
'-----------------------------------------------------------------------------------------
'Je lance le programme spécifique d'ancrage des éléments du produit en cours
'-----------------------------------------------------------------------------------------
Fixation ProduitEnCours, ProduitEnCours.Products.Count, niveau
'
'-----------------------------------------------------------------------------------------
'Je passe en revue tous les articles du produits
'-----------------------------------------------------------------------------------------
For i = 1 To ProduitEnCours.Products.Count
NB_Item = ProduitEnCours.Products.ITEM(i).Products.Count
' _________________________________________________________________
' Si l'article est un produit alors on relance la boucle
If ProduitEnCours.Products.ITEM(i).Products.Count <> 0 Then
analyse ProduitEnCours.Products.ITEM(i), niveau
Else
' _________________________________________________________________
' Sinon je descends d'un niveau et je traite la part
ProduitEnCours.Products.ITEM(i).ActivateDefaultShape
chaine = tabulation2 & "Niveau " & niveau + 1 & _
" : " & "Part " & i & _
" : " & ProduitEnCours.Products.ITEM(i).Name & " - " & _
ProduitEnCours.Products.ITEM(i).DescriptionRef
f.WriteLine chaine
Debug.Print chaine
End If
Next i
'
'-----------------------------------------------------------------------------------------
'J'écris une ligne vide à la fin du produit
'-----------------------------------------------------------------------------------------
Debug.Print
f.WriteLine ""
'
'
End Sub
merci d'avance Amicalement Hervé [Edité le 6/8/2005 par mooneck]
