Bonjour à tous,
Savez vous comment accéder en VBA à l’élément pli dérivé pour annuler sa suppression avant de l’exporter en DXF (photo ci dessous) ?
Ceci en passant par une boucle qui vérifie l’état de suppression.
je sais acceder à l’état déplié avec le code suivant.
Dim swFlatPattern As SldWorks.FlatPatternFeatureData
Set swFlatPatternFeat = vFlatPatternFeats(i)
Mais pas au niveau en dessous pour arriver au pli dérivé.
Merci d’avance
Pioche la dedans en espérant que ça puisse t’aider 
Sub AccederPliDeriveEtAnnulerSuppression()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.Model
Dim swFlatPatternFeat As SldWorks.FlatPatternFeatureData
Dim vFlatPatternFeats As Variant
Dim i As Integer
Dim swDerivedFoldFeat As SldWorks.Feature
Dim swFoldFeat As SldWorks.Feature
' Initialisation de l'application SolidWorks
Set swApp = Application.SldWorks
' Sélection du modèle actif
Set swModel = swApp.ActiveDoc
' Récupération des fonctionnalités de type "Flat Pattern"
vFlatPatternFeats = swModel.GetFeaturesOfType(SldWorks.swFeatureType_e.swFlatPattern)
' Boucle pour chaque fonctionnalité "Flat Pattern"
For i = 0 To UBound(vFlatPatternFeats)
Set swFlatPatternFeat = vFlatPatternFeats(i)
' Itération à travers les fonctionnalités enfants pour trouver le "Pli dérivé"
For Each swFoldFeat In swFlatPatternFeat.GetChildren
' Vérification du type de fonctionnalité (Adapter le type si nécessaire)
If swFoldFeat.GetTypeName = "Fold" Then ' ou "DerivedFold" selon votre version/nomenclature
Set swDerivedFoldFeat = swFoldFeat
' Vérifier l'état de suppression
If swDerivedFoldFeat.IsDeleted Then
' Annuler la suppression (Note: Cette action peut nécessiter des adaptations en fonction de la version de SolidWorks et de vos besoins spécifiques)
' **Attention : L'exécution de cette ligne peut avoir des conséquences sur votre modèle. Testez dans un environnement contrôlé.**
' swDerivedFoldFeat.SetDelete False ' (Décommenter et adapter si nécessaire)
' Affichage d'un message pour indiquer que le "Pli dérivé" était marqué pour suppression
MsgBox "Le Pli dérivé de la fonctionnalité " & swFlatPatternFeat.Name & " était marqué pour suppression."
End If
End If
Next swFoldFeat
Next i
' Nettoyage
Set swDerivedFoldFeat = Nothing
Set swFoldFeat = Nothing
Set swFlatPatternFeat = Nothing
Set swModel = Nothing
Set swApp = Nothing
End Sub
Ok merci max59,
je vais regarder ce code, mais il y a l’air d’avoir des choses intéressante.
Je vois que la traduction Bing a encore fais des siennes:
VS End sub.
Je ne sais pas si je dois en rire ou en pleurer! 
@Coralie peut-on voir quand il s’agit de code entre balise d’empêcher le traducteur d’entrer en compte.
Edit: et je ne parle pas des déclarations modifiés par le traducteur qui rendent le code inutilisable sans connaissances.
Bonjour,
Je me suis permis d’éditer le post de @max59 pour que le code soit bien entre les balises.
Merci d’avoir remis le code en ordre, mais je n’arrive pas à le faire fonctionner.
@max59 le code que tu as posté etait il fonctionnel ?
Car j’ai un blocage a cette ligne :
vFlatPatternFeats = swModel.GetFeaturesOfType(SldWorks.swFeatureType_e.swFlatPattern)
Erreur : Membre de methode ou de données introuvable
J’ai également modifié :
Dim swModel As SldWorks.Model
en :
Dim swModel As SldWorks.ModelDoc2
Bonjour,
Plutôt essayer ce code:
Dim swApp As SldWorks.SldWorks
Dim myModel As SldWorks.ModelDoc2
Dim featureMgr As SldWorks.FeatureManager
Dim feat As SldWorks.Feature
Dim featArray As Variant
Dim i As Long
Dim j As Long
Dim bret As Boolean
Dim vFeatState As Variant
Option Explicit
Sub main()
Set swApp = Application.SldWorks
Set myModel = swApp.ActiveDoc
Set featureMgr = myModel.FeatureManager
Dim flatPatternFolder As SldWorks.flatPatternFolder
Set flatPatternFolder = featureMgr.GetFlatPatternFolder
Set feat = flatPatternFolder.GetFeature
Debug.Print "Flat-pattern folder name: " & feat.Name
Debug.Print " Number of flat-pattern features in the folder: " & flatPatternFolder.GetFlatPatternCount
featArray = flatPatternFolder.GetFlatPatterns
For i = LBound(featArray) To UBound(featArray)
Set feat = featArray(i)
vFeatState = feat.IsSuppressed2(swAllConfiguration, featArray)
For j = LBound(vFeatState) To UBound(vFeatState)
If vFeatState(j) = True Then
bret = feat.SetSuppression2(1, 2, featArray)
MsgBox "Le Pli dérivé de la fonctionnalité " & feat.Name & " était marqué pour suppression."
End If
Next j
Next i
End Sub
Je n’ai pas fait attention si le code de @max59 a bougé quand je l’ai remis entre les balises mais il y a des lignes avec des fonctions qui n’existent pas sur l’API SW.
Cela fonctionne effectivement beaucoup mieux comme ça.
Une idée @Cyril_f pour vérifier si l’un ou l’autre des plis est supprimés (étage supplémentaire dans la macro):
Je crois qu’il s’arrête à l’état. Je regarde ça si j’ai un peu de temps
Bonsoir @treza88 ,
Après avoir identifié la fonction « Etat déplié » (« FaltPattern »), il faut creuser dans les sous-fonctions pour trouver les esquisses et les plis (« UiBend »).
Plus on descend, plus la doc des API est avare d’informations.
Sub AccederPliDeriveEtAnnulerSuppression()
Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim swFeature As Feature
Dim swFlatPatternFeat As Feature
Dim vSupprStateArr As Variant
Dim bret As Boolean
Set swApp = Application.SldWorks ' Initialisation de l'application SolidWorks
Set swModel = swApp.ActiveDoc ' Sélection du modèle actif
Set swFeature = swModel.FirstFeature ' Récupération des fonctionnalités de type "Flat Pattern"
While Not swFeature Is Nothing
If swFeature.GetTypeName = "FlatPattern" Then ' La fonction est un "état déplié"
If Not swFeature Is Nothing Then
Debug.Print swFeature.GetTypeName, swFeature.Name
Set swFlatPatternFeat = swFeature.GetFirstSubFeature 'Première sous-fonction
Do While Not swFlatPatternFeat Is Nothing
If swFlatPatternFeat.GetTypeName2 = "UiBend" Then ' UiBend est le nom de la fonction pour un dépliage (ProfileFeature pour une esquisse)
Debug.Print swFlatPatternFeat.GetTypeName, swFlatPatternFeat.Name
vSupprStateArr = swFlatPatternFeat.IsSuppressed2(swThisConfiguration, Nothing) ' Test de l'état supprimé
If vSupprStateArr(0) = True Then
bret = swFlatPatternFeat.SetSuppression2(swUnSuppressFeature, swThisConfiguration, Nothing)
End If
End If
Set swFlatPatternFeat = swFlatPatternFeat.GetNextSubFeature ' Sous fonction suivante
Loop
End If
End If
Set swFeature = swFeature.GetNextFeature ' Fonction suivante
Wend
Set swModel = Nothing
Set swApp = Nothing
End Sub
La macro est en pièce jointe…
AccesPliDerive.swp (54,5 Ko)