Perfectionnement macro changement face déplié sur tôlerie

Macro
1

Bonjour,
Je cherches à perfectionner une macro utilisé très régulièrement.
Cette macro est très fonctionnel sur toutes les pièces récents de tôlerie mais ne fonctionne pas sur les pièces plus ancienne (sans dossier tôlerie)
Si quelqu’un à une idée pour la rendre fonctionnel pour les 2 tôles ci-jointe.

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim selManager As SldWorks.SelectionMgr


Sub main()

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set selManager = swModel.SelectionManager
    
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'code
    
    
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim swFace1 As Face2
    Do While swFace1 Is Nothing
        Set swFace1 = selManager.GetSelectedObject6(1, -1)
        DoEvents
    Loop
    
    set_fixed_face get_flat_feature(swFace1.GetBody), swFace1
    
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'code

    
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''

End Sub
Public Function get_flat_feature(bod As Body2) As Feature
    Dim featurmgr As FeatureManager
    Set featurmgr = swModel.FeatureManager
    Dim flatpaternfolder As FlatPatternFolder
    Set flatpaternfolder = featurmgr.GetFlatPatternFolder()
    Dim flatfeatures As Variant
    flatfeatures = flatpaternfolder.GetFlatPatterns()
    Dim sFlatPatternFeatureData As FlatPatternFeatureData
    Dim face As Face2
    Dim feat As Variant
    For Each feat In flatfeatures
        Set sFlatPatternFeatureData = feat.GetDefinition()
        Set face = sFlatPatternFeatureData.FixedFace2
        If face.GetBody.Name = bod.Name Then
            Set get_flat_feature = feat
            Exit Function
        End If
    Next
End Function

Public Sub set_fixed_face(feat As Feature, face As Face2)
    Dim sFlatPatternFeatureData As FlatPatternFeatureData
    Set sFlatPatternFeatureData = feat.GetDefinition()
    sFlatPatternFeatureData.AccessSelections swModel, Nothing
    sFlatPatternFeatureData.FixedFace2 = face
    feat.ModifyDefinition sFlatPatternFeatureData, swModel, Nothing
End Sub

Le sujet d’origine ou @Lynkoa15 m’avais trouvé la solution actuelle fonctionnelle à 92% reste les 8% de pièce plus ancienne.
Nouvelle.SLDPRT (245,2 Ko)
Ancienne.SLDPRT (578,4 Ko)
Dans les pièces n’ayant pas le dossier Etat déplié:
image
J’ai beau chercher je n’arrive pas à faire ma sélection de feat pour lui appliqué ensuite la face.

2

Aucune idée de si ça peut aider, mais impossible de déplier à la main chez moi (SW 2024 SP01) sans passer par la fonction « Déplier », habituellement on préfère la fonction « Mettre à Plat » mais non fonctionnelle dans le cas présent. Même en convertissant ton ficher à ma version actuelle.

image
image942×321 23.6 KB

image
image873×362 33.1 KB

1 « J'aime »
3

Bonjour @sbadenis
En effet la fonction get_flat_feature() cible directement le dossier fonctions déplié (afin d’optimiser les performances) cependant ce dossier ne semble pas exister pour ces anciennes pièces, je vous propose de traverser toutes les fonctions en utilisant cette fonction,

Public Function get_flat_feature2(bod As Body2) As Feature
    Dim featurmgr As FeatureManager
    Set featurmgr = swModel.FeatureManager
    
    Dim sFlatPatternFeatureData As FlatPatternFeatureData
    Dim face As Face2
    
    Dim feat As Feature
    Set feat = swModel.FirstFeature
    While Not feat Is Nothing
        If feat.GetTypeName2() = "FlatPattern" Then
            Set sFlatPatternFeatureData = feat.GetDefinition()
            Set face = sFlatPatternFeatureData.FixedFace2
            If face.GetBody.Name = bod.Name Then
                Set get_flat_feature2 = feat
                Exit Function
            End If
        End If
        
        Set feat = feat.GetNextFeature
    Wend
End Function
4

Romain, essayez d’annuler la suppression des plis (parfois sw ne le fait pas automatiquement en sélectionnant état déplié)
Capture (testé sw22)

2 « J'aime »
5

ça fonctionne, chapeau bas !

image
image1045×669 83.1 KB

2 « J'aime »
6

Oui ma macro en mode debug avait supprimer ces fonctions. Rien de bien grave.

7

Merci @Lynkoa15 j’avais tenté quelque chose d’approchant mais sans réussir à le faire fonctionner.
Pour le coup c’est désormais parfaitement fonctionnel.
Ma mise en plan automatique pour les pièces de tôlerie, comprend désormais une corde de plus à son arc.
Merci!

1 « J'aime »