Wissen Sie, wie Sie auf das abgeleitete Faltelement in VBA zugreifen können, um das Löschen abzubrechen, bevor Sie es nach DXF exportieren (Foto unten)? Dies geschieht durch das Durchlaufen einer Schleife, die den Löschstatus überprüft.
Ich weiß, wie ich mit dem folgenden Code auf den entfalteten Zustand zugreife. Dim swFlatPattern As SldWorks.FlatPatternFeatureData Set swFlatPatternFeat = vFlatPatternFeats(i)
Aber nicht auf der Ebene darunter, um zur abgeleiteten Faltung zu gelangen.
Holen Sie es sich in der Hoffnung, dass es Ihnen helfen kann
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
Ich sehe, dass die Bing-Übersetzung wieder ihre Sache gemacht hat: VS Ende Sub. Ich weiß nicht, ob ich lachen oder weinen soll! @Coralie zeigt sich, wenn es um Code zwischen Tags geht, um zu verhindern, dass der Übersetzer dies berücksichtigt. Bearbeiten: und ich spreche nicht von den Deklarationen, die vom Übersetzer geändert wurden und den Code ohne Wissen unbrauchbar machen.
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
Ich habe nicht darauf geachtet, ob sich der @max59 Code bewegt hat , als ich ihn wieder zwischen die Tags eingefügt habe, aber es gibt Zeilen mit Funktionen, die in der SW-API nicht vorhanden sind.
So funktioniert es eigentlich viel besser. Eine Idee @Cyril.f , um zu überprüfen, ob die eine oder andere der Falten entfernt wurde (zusätzliche Ebene im Makro):
Nachdem Sie die Funktion " FaltPattern " identifiziert haben, müssen Sie sich in die Unterfunktionen vertiefen, um die Skizzen und Falten zu finden (" UiBend "). Je weiter Sie nach unten gehen, desto geiziger geizt das API-Dokument mit Informationen.
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
Danke @Cyril.f für den ursprünglichen Code und @m.blt für die Unterfunktionsergänzung, die ich einige Zeit vergeblich in den APIs gesucht hatte. Der Code ist perfekt funktionsfähig und kann zu einem meiner Makros hinzugefügt werden.
