Cze wszystkim
Czy wiesz, jak uzyskać dostęp do pochodnego elementu zagięcia w VBA, aby anulować jego usunięcie przed wyeksportowaniem go do DXF (zdjęcie poniżej)?
Odbywa się to poprzez przejście przez pętlę, która sprawdza stan usuwania.
Wiem, jak uzyskać dostęp do stanu rozwiniętego za pomocą poniższego kodu.
Przyciemnij swFlatPattern jako SldWorks.FlatPatternFeatureData
Set swFlatPatternFeat = vFlatPatternFeats(i)
Ale nie na niższym poziomie, aby dostać się do pochodnej fałdy.
Z góry dziękuję
Podnieś go w nadziei, że może ci pomóc 
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 dziękuję max59,
Zamierzam przyjrzeć się temu kodowi, ale wydaje się, że zawiera on kilka interesujących rzeczy.
Widzę, że tłumaczenie Binga znów zrobiło swoje:
VS Koniec sub.
Nie wiem, czy powinnam się śmiać, czy płakać! 
@Coralie można zauważyć, jeśli chodzi o kod między tagami, aby tłumacz nie brał pod uwagę.
Edit: i nie mówię tu o zmodyfikowanych przez tłumacza deklaracjach, które sprawiają, że kod jest bezużyteczny bez wiedzy.
Dzięki za uporządkowanie kodu, ale nie mogę go zmusić do działania.
@max59 kod, który opublikowałeś, działał?
Bo mam blok na tej linii:
vFlatPatternFeats = swModel.GetFeaturesOfType(SldWorks.swFeatureType_e.swFlatPattern)
Błąd: Nie znaleziono metody lub elementu członkowskiego danych
Zmieniłem też:
Dim swModel As SldWorks.Model
w:
Dim swModel As SldWorks.ModelDoc2
Witam
Zamiast tego wypróbuj ten kod:
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
Nie zwróciłem uwagi, czy kod @max59 poruszył się, gdy włożyłem go z powrotem między tagi, ale są wiersze z funkcjami, które nie istnieją w API oprogramowania.
W rzeczywistości działa to znacznie lepiej w ten sposób.
Pomysł @Cyril_f sprawdzenie, czy jedna lub druga z fałd została usunięta (dodatkowy poziom w makrze):
Myślę, że to się kończy na państwie. Przyjrzę się temu, jeśli będę miał trochę czasu
Dobry wieczór @treza88 ,
Po zidentyfikowaniu funkcji " FaltPattern " , musisz zagłębić się w cechy podrzędne, aby znaleźć szkice i zagięcia (" UiBend ").
Im dalej schodzisz, tym bardziej dokumentacja API jest skąpa w informacje.
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
Makro jest dołączone...
AccesPliDerive.swp (54,5 KB)