Hi all
Do you know how to access the derived fold element in VBA to cancel its deletion before exporting it to DXF (photo below)?
This is done by going through a loop that checks the delete state.
I know how to access the unfolded state with the following code.
Dim swFlatPattern As SldWorks.FlatPatternFeatureData
Set swFlatPatternFeat = vFlatPatternFeats(i)
But not at the level below to get to the derived fold.
Thanks in advance
Pick it up in the hope that it can help you 
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 thank you max59,
I'm going to look at this code, but it seems to have some interesting things.
I see that the Bing translation has done its thing again:
VS End sub.
I don't know if I should laugh or cry! 
@Coralie can be seen when it comes to code between tags to prevent the translator from taking into account.
Edit: and I'm not talking about the declarations modified by the translator that make the code unusable without knowledge.
Thanks for putting the code back in order, but I can't seem to get it to work.
@max59 was the code you posted functional?
Because I have a block on this line:
vFlatPatternFeats = swModel.GetFeaturesOfType(SldWorks.swFeatureType_e.swFlatPattern)
Error: Method or data member not found
I also changed:
Dim swModel As SldWorks.Model
in:
Dim swModel As SldWorks.ModelDoc2
Hello
Try this code instead:
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
I didn't pay attention if the @max59 code moved when I put it back between the tags but there are lines with functions that don't exist on the SW API.
It actually works much better that way.
An idea @Cyril.f to check if one or the other of the folds is removed (extra level in the macro):
I think it stops at the state. I'll look at it if I have some time
Good evening @treza88 ,
After identifying the " FaltPattern " function, you need to dig into the sub-features to find the sketches and folds (" UiBend ").
The further down you go, the more the API doc is stingy with information.
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
The macro is attached...
AccesPliDerive.swp (54.5 KB)