Acceder aux parametre de tolerie sur piece multicorps avec VBA

Bonjur à tous,

Je cherche a acceder aux parametre de pliage de tolerie sur une piece multicorps, j’ai bien ce code qui je pensais pouvais résoudre mes probleme.
Mais quand je le lance, il me donne des valeurs qui sont identique partout est ne sont pas les bon rayon et épaisseur.

Code :

Dim swApp As SldWorks.SldWorks
Dim myModel As SldWorks.ModelDoc2
Dim featureMgr As SldWorks.FeatureManager
Dim feat As SldWorks.Feature
Dim sheetMetalFolder As SldWorks.sheetMetalFolder
Dim featArray As Variant
Dim i As Long
Dim swBaseFlangeFeat As SldWorks.BaseFlangeFeatureData
Option Explicit

Sub main()

    Set swApp = Application.SldWorks
    Set myModel = swApp.ActiveDoc
    Set featureMgr = myModel.FeatureManager
   

    Set sheetMetalFolder = featureMgr.GetSheetMetalFolder
    Set feat = sheetMetalFolder.GetFeature
    Debug.Print "Sheet metal folder name: " & feat.Name
    Debug.Print "  Number of sheet metal features in the folder: " & sheetMetalFolder.GetSheetMetalCount
    featArray = sheetMetalFolder.GetSheetMetals
    For i = LBound(featArray) To UBound(featArray)
        Set feat = featArray(i)
        Debug.Print "    " & feat.Name
        Set swBaseFlangeFeat = myModel.FeatureManager.CreateDefinition(swFmBaseFlange)
        swBaseFlangeFeat.OverrideDefaultSheetMetalParameters = True
    'swBaseFlangeFeat.Thickness = 0.065
    'swBaseFlangeFeat.OverrideRadius = False
    
    'swBaseFlangeFeat.BendRadius = 1
    Debug.Print swBaseFlangeFeat.BendRadius
    Debug.Print swBaseFlangeFeat.Thickness
    Next i

End Sub

Voici un de mes parametre de tolerie:
Screenshot_54

Et voici le résultat du code ci dessus :

Sheet metal folder name: Tôlerie
  Number of sheet metal features in the folder: 4
    Tôlerie3
 0.00015 
 0.0005 
    Tôlerie12
 0.00015 
 0.0005 
    Tôlerie14
 0.00015 
 0.0005 
    Tôlerie34
 0.00015 
 0.0005 

Pouvez vous me dire pourquoi je n’ai pas les bonne valeur ?
Je ne comprend pas pourquoi j’ai toujours 0.00015, qui correspond a 0.15mm
et 0.0005 qui correspond a 0.5 mm.

Bonsoir @treza88

L’erreur vient des fonctions de ces deux lignes :

Set swBaseFlangeFeat = myModel.FeatureManager.CreateDefinition(swFmBaseFlange)
        swBaseFlangeFeat.OverrideDefaultSheetMetalParameters = True

La première crée une structure de données de tôlerie avec des paramètres par défaut .
La seconde force le remplacement dans la structure du corps de tôlerie en cours.
Ce qui explique qu’elles soient toutes identiques…

La macro jointe utilise la méthode Set swSheetMetalData = swFeat.GetDefinition pour récupérer les données du corps de tôlerie et les afficher.

ParametresTolerie.swp (51,5 Ko)

1 « J'aime »

Super merci @m_blt pour le code il fonctionne parfaitement.

Si j’osais abuser, pourrais tu me dire comment je pourrais utiliser ce code dans un assemblage et boucler sur toutes les pièces de ce même assemblage ?

Bonsoir,

La macro ci-dessous devrait répondre à cette question « abusive ». :wink:
Elle parcourt la totalité de l’arbre de l’assemblage pour rechercher les pièces, identifie pour chacune s’il s’agit d’une pièce de tôlerie, et si oui affiche ses propriétés.
Les autres pièces (non tôlerie) sont ignorées.

La macro prétend également fonctionner sur un document de pièce.

ParametresTolerieAssemb.swp (64,5 Ko)

Un grand merci c’est super sympa de ta part, le code fonctionne parfaitement dans un assemblage et dans un fichier pièce. J’aimerais bien être aussi à l’aise que toi avec le VBA Solidworks.

Je vais analyser ce code, et j’essayerais de le modifier pour qu’il puisse détecter si dans l’assemblage principale il y a des assemblages enfants.

Ton code à l’air suffisamment clair pour que j’y arrive, et au cas ou je reviendrai sur le forum.
Je vais valider ta réponse et je l’annulerai si je dois revenir poser des questions

En principe, la macro répond déjà à l’exploration en profondeur de l’arbre de l’assemblage.
Elle parcourt le premier niveau de l’assemblage principal dans la procédure « main », mais également les sous-assemblages, quels que soient leurs niveaux, dans la procédure « ParcourirComposants », qui fonctionne récursivement.

La dernière fonction « SheetPart » est quasi identique à celle de mon envoi précédent, pour afficher les paramètres de tôlerie de la pièce.

Merci @m_blt j’ai testé et ça fonctionne parfaitement.

Par contre j’ai essayé de modifier le rayon de pliage en ajoutant :

swSheetMetalData.BendRadius = 2.06 / 1000

Mais ça ne fonctionne pas, comment dois procéder pour modifier la valeur de rayon ?

Bonjour,

Dans la fonction « SheetPart » de ma macro, la variable « swSheetMetalData » de type « SheetMetalFeatureData » contient les paramètres de la fonction de tôlerie (« swFeat »).
La méthode « AccessSelections » de cette classe permet d’accéder aux paramètres de cette structure de données, et d’en changer les valeurs.
Par la suite, la méthode « ModifyDefinition » de la fonction de tôlerie (« swFeat ») provoque la modification.

Si vous ouvrez l’aide des API SolidWorks (en bas de la page https://help.solidworks.com/), et recherchez la classe « ISheetMetalFeatureData », vous trouverez l’exemple proposé « Change Bend Radius of Sheet Metal Part (VBA) » qui répond exactement à votre question.

De façon générale, l’aide des API est indigeste mais très complète, et propose de nombreux exemples dont on peut s’inspirer.
Bon après-midi…

Désolé je suis lourdingue, mais j’ai modifier le code comme suit :

J’ai rajouter, qui apparemment permet d’acceder a « BendRadius » :

 bRet = swSheetMetalData.AccessSelections(swModel, Nothing): Debug.Assert bRet

En me référant à l’exemple, mais ça ne fonctionne toujours pas, pourtant :
« swSheetMetalData » est bien défini comme objet de « swFeat.GetDefinition », comme dans l’exemple ?

Function SheetPart(swModel As ModelDoc2) As Boolean

    Dim swFeat              As Feature
    Dim vFeatArray          As Variant
    Dim sheetMetalFolder    As sheetMetalFolder
    Dim swSheetMetalData    As SheetMetalFeatureData
    Dim gaugeTableFile      As String
    Dim swCustBend          As CustomBendAllowance
    Dim i                   As Long
    Dim bRet                As Boolean
    Dim lRet                As Long
    

    Set sheetMetalFolder = swModel.FeatureManager.GetSheetMetalFolder
    If sheetMetalFolder Is Nothing Then
        Exit Function
    End If
    
    Set swFeat = sheetMetalFolder.GetFeature
    Debug.Print "-------------------------------------------------"
    Debug.Print "Composant : " & swModel.GetPathName
    Debug.Print "  Nom du dossier de tôlerie : " & swFeat.Name
    Debug.Print "  Nombre de fonctions de tôlerie dans le dossier : " & sheetMetalFolder.GetSheetMetalCount
    Debug.Print ""
    vFeatArray = sheetMetalFolder.GetSheetMetals
    For i = LBound(vFeatArray) To UBound(vFeatArray)
        Set swFeat = vFeatArray(i)
        Set swSheetMetalData = swFeat.GetDefinition
        Set swCustBend = swSheetMetalData.GetCustomBendAllowance
        nbTotal = nbTotal + 1
        bRet = swSheetMetalData.AccessSelections(swModel, Nothing): Debug.Assert bRet
        If swSheetMetalData.Thickness * 1000 = 1.5 And swSheetMetalData.BendRadius * 1000 <> 1.025 Then
            swSheetMetalData.BendRadius = 1.025 / 1000
            swCustBend.Type = 1
            nbModif = nbModif + 1
            Stop
        ElseIf swSheetMetalData.Thickness * 1000 = 2 And swSheetMetalData.BendRadius * 1000 <> 1.5 Then
            swSheetMetalData.BendRadius = 1.5 / 1000
            swCustBend.Type = 1
            nbModif = nbModif + 1
            Stop
        ElseIf (swSheetMetalData.Thickness = 0.003 And swSheetMetalData.BendRadius <> 0.00206) Then
            swSheetMetalData.BendRadius = 2.06 / 1000
            swCustBend.Type = 1
            nbModif = nbModif + 1
            Stop
        ElseIf swSheetMetalData.Thickness * 1000 = 4 And swSheetMetalData.BendRadius * 1000 <> 5.4 Then
            swSheetMetalData.BendRadius = 5.4 / 1000
            swCustBend.Type = 1
            nbModif = nbModif + 1
            Stop
        ElseIf swSheetMetalData.Thickness * 1000 = 5 And swSheetMetalData.BendRadius * 1000 <> 5 Then
            swSheetMetalData.BendRadius = 5 / 1000
            swCustBend.Type = 1
            nbModif = nbModif + 1
            Stop
        End If
        
        Debug.Print "  " & swFeat.Name
        Debug.Print "      Tolérance de pliage        = " & swSheetMetalData.BendAllowance * 1000# & " mm"
        Debug.Print "      Fichier de table de pliage = " & swSheetMetalData.BendTableFile
        Debug.Print "      Epaisseur                  = " & swSheetMetalData.Thickness * 1000# & " mm"
        Debug.Print "      Rayon                      = " & swSheetMetalData.BendRadius * 1000# & " mm"
        Debug.Print "      Perte au pli               = " & swCustBend.BendDeduction * 1000# & " mm"
        Debug.Print "      KFactor                    = " & swSheetMetalData.KFactor
        Debug.Print "      Type de pli                = " & swCustBend.Type
        Debug.Print ""
        
    Next i

End Function

Pour valider les changements, il faut ajouter cette instruction après la définition des valeurs, et avant la série d’affichages…

     bRet = swFeat.ModifyDefinition(swSheetMetalData, swModel, Nothing)

Sauf erreur de ma part, le changement est réalisé sur la valeur par défaut du rayon de la fonction « Tôlerie ».
Il semble qu’il soit également nécessaire d’avoir coché la case « Remplacer les param… » pour que le changement soit effectif.

image

Le changement est sans effet sur les rayons des plis créés par les fonctions successives, s’ils ont été définis avec des rayons spécifiques (Pli de transitions, Pli esquissé, Tôle pliée sur arête…). Il faut dans ce cas accéder à chacune de ces fonctions particulières. Galère…
Voir tout de même cet exemple de l’aide API :
Get All Sheet Metal Feature Data Example (VBA)

Merci vraiment pour tes explications qui reste abordable pour moi en tant que partiellement néophyte.

C’est aussi pour cela que je pensais apparemment a tord que je devais valider la propriété suivante(dans le post#1) pour pouvoir remplacer la valeur par défaut du rayon de pliage :

swBaseFlangeFeat.OverrideDefaultSheetMetalParameters = True

Donc il n’y a pas plus simple pour accéder à la modification de ces rayons de pliage.

Mais si il faut passé par tout ce code " Get All Sheet Metal Feature Data Example (VBA)" c’est d’une incroyable complexité, juste pour modifier un rayon de pliage sur tous les composant ou corps.


EDIT : " Get All Sheet Metal Feature Data Example (VBA)" ne permet pas de modifer, mais ne sert qu’a acquérir les données. Il n’existe pas un « Set Sheet Metal Feature Data » ?


Ont pourrait croire que du moment que l’on accède au composant ou au corps qui est un objet avec des propriétés dont le rayon de pliage en fait partie.
Ont peut modifier le rayon de base de pliage qui fait partie des propriété de ce même objet.

Mais apparemment ce n’est pas le cas ?

J’espere que tu arrive à suivre mon raisonnement (pas forcément logique), qui est basé sur les objets et leurs propriétés.

L’instruction qui permet de cocher/décocher la case « Remplacer les param… » serait celle-ci, placée avant de valider les modifs. A tester.

swSheetMetalData.SetOverrideDefaultParameter2 swSheetMetalOverrideDefaultParameters_BendParameters, True

Quant aux fonctions qui utilisent des rayons particuliers, je ne vois pas d’autre solution que de rechercher une à une les fonctions en question dans l’arbre.

Pas monstrueux dans la mesure où c’est très répétitif, le tout étant de connaître les appellations utilisées par Solidworks. D’où l’intérêt de l’exemple « Get All Sheet Metal… »

Bonjour et merci @m_blt pour l’instruction ci dessus qui m’a permis de bien avancer et je dirais de presque boucler mon code (qui de base est le tien).

Ce pendant j’ai encore un problème, tout fonctionne comme je le veux, j’arrive donc à modifier les paramètres de tôlerie par défaut, mais aussi les paramètres de remplacement dans le cas d’une pièce multicorps.
Quand je fait fonctionner la macro avec une pièce de tôlerie simple ou multicorps, tout fonctionne parfaitement.
Par contre quand je l’a fait fonctionner avec un assemblage Tout le processus de traitement fonctionne correctement apparemment, mais quand la macro a fini de s’exécuter, le fichier reste semi bloqué.
Je n’arrive plus avec un click droit par exemple a afficher les menus contextuel, et je suis obligé de fermer le fichier et de le réouvrir, pour que ça refonctionne.

Je ne comprend pas pourquoi avec les assemblages ça fait ça.
Toute aide me sera précieuse pour comprendre, merci d’avance.

Voici le code :

Dim nbTotalCorps             As Integer
Dim nbTotalDossier          As Integer
Dim nbModifCorps            As Integer
Dim nbModifDossier          As Integer
Dim pieceCorps              As Boolean

Option Explicit


Sub main()
    Dim swApp           As SldWorks.SldWorks
    Dim swModel         As ModelDoc2
    Dim swAssemb        As AssemblyDoc
    Dim swComp          As Component2
    Dim vComponents     As Variant
    Dim i               As Integer
    Dim OK              As Boolean
    
    nbTotalCorps = 0
    nbTotalDossier = 0
    nbModifCorps = 0
    nbModifDossier = 0

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    
    If swModel Is Nothing Then                      ' Si aucun document n'est ouvert
        MsgBox "Un document de pièce ou d'assemblage doit être ouvert.", vbExclamation
        Exit Sub
    
    ElseIf swModel.GetType = swDocPART Then         ' Si c'est une pièce...
        OK = SheetPart(swModel)
        MsgBox nbModifDossier & " rayon de pliage modifier sur " & nbTotalDossier & " de dossier par défaut de tolerie" & vbCrLf & _
        nbModifCorps & " rayon de pliage modifier sur " & nbTotalCorps & " corps de tolerie"
        Exit Sub
    
    ElseIf swModel.GetType = swDocASSEMBLY Then     ' Si c'est un assemblage...
        Set swAssemb = swModel
        vComponents = swAssemb.GetComponents(True)  ' Tableau des composants de niveau 1 de l'assemblage
        For i = 0 To UBound(vComponents)
            Set swComp = vComponents(i)
            ParcourirComposants swComp              ' Parcours des composants (récursif)
        Next i
        MsgBox nbModifDossier & " rayon de pliage modifier sur " & nbTotalDossier & " de dossier par défaut de tolerie" & vbCrLf & _
        nbModifCorps & " rayon de pliage modifier sur " & nbTotalCorps & " corps de tolerie"
        
    End If

End Sub

Sub ParcourirComposants(swComp As SldWorks.Component2)
    
    Dim vChildComponents    As Variant
    Dim swModel             As ModelDoc2
    Dim swChildComp         As SldWorks.Component2
    Dim i                   As Integer
    Dim OK                  As Boolean
    
    Set swModel = swComp.GetModelDoc2                   ' Modèle associé au composant
    If Not swModel Is Nothing Then
        If swModel.GetType = swDocPART Then             ' Si c'est une pièce...
            OK = SheetPart(swModel)
            
        ElseIf swModel.GetType = swDocASSEMBLY Then     ' Si c'est un assemblage...
            vChildComponents = swComp.GetChildren       ' Liste des composants enfants
            For i = 0 To UBound(vChildComponents)
                Set swChildComp = vChildComponents(i)
                ParcourirComposants swChildComp         ' Parcours du composant enfant (récursif)
            Next i
        End If
        
    End If
End Sub


Function SheetPart(swModel As ModelDoc2) As Boolean

    Dim swFeat                  As Feature
    Dim vFeatArray              As Variant
    Dim sheetMetalFolder        As sheetMetalFolder
    Dim swSelMgr                As SldWorks.SelectionMgr
    Dim swSheetMetal            As SldWorks.SheetMetalFeatureData
    Dim swSheetMetalData        As SheetMetalFeatureData
    Dim gaugeTableFile          As String
    Dim swCustBend              As CustomBendAllowance
    Dim i                       As Long
    Dim bRet                    As Boolean
    Dim lRet                    As Long
    Dim errors                  As Long
    Dim overrideParameters      As Boolean
    Dim swFeature               As SldWorks.Feature
    Dim swSheetMetalFeatureData As SldWorks.SheetMetalFeatureData

    
    Set sheetMetalFolder = swModel.FeatureManager.GetSheetMetalFolder
    If sheetMetalFolder Is Nothing Then
        Exit Function
    End If
    
    Set swFeat = sheetMetalFolder.GetFeature
    Debug.Print "-------------------------------------------------"
    Debug.Print "Composant : " & swModel.GetPathName
    Debug.Print "  Nom du dossier de tôlerie : " & swFeat.Name
    Debug.Print "  Nombre de fonctions de tôlerie dans le dossier : " & sheetMetalFolder.GetSheetMetalCount
    Debug.Print ""
    
    'Création du tableau comportant chaque element de tolerie contenu dans le dossier de tolerie
    vFeatArray = sheetMetalFolder.GetSheetMetals
    'Stop
    Debug.Print "  Nom du dossier de tôlerie : " & vFeatArray(0).Name
    
    '
    Set swSheetMetal = swFeat.GetDefinition
    Set swCustBend = swSheetMetal.GetCustomBendAllowance

    'Accession au parametres de tolerie par défaut
    bRet = swSheetMetal.IAccessSelections2(swModel, Nothing): Debug.Assert bRet
    
    pieceCorps = True
    nbTotalDossier = nbTotalDossier + 1
    'Appel de la fonction choixRayonPliageParEpaisseur
    choixRayonPliageParEpaisseur swCustBend, swSheetMetal, pieceCorps
        
    'On valide les modifications des parametres de tolerie par défaut
    bRet = swFeat.ModifyDefinition(swSheetMetal, swModel, Nothing): Debug.Assert bRet
    
    Debug.Print "  Modified bend radius = " & swSheetMetal.BendRadius * 1000# & " mm"
    
    'Boucle sur les elements de tolerie contenu dans le dossier
    For i = LBound(vFeatArray) To UBound(vFeatArray)
        Set swFeat = vFeatArray(i)
        Set swSheetMetalData = swFeat.GetDefinition
        Set swCustBend = swSheetMetalData.GetCustomBendAllowance
        pieceCorps = False
        nbTotalCorps = nbTotalCorps + 1
        
        'verification de l'état "Remplacer les parametres de pliage"
        errors = swSheetMetalData.GetOverrideDefaultParameter2(swSheetMetalOverrideDefaultParameters_e.swSheetMetalOverrideDefaultParameters_BendParameters, overrideParameters)
            Debug.Print ("  Bend parameters: " & overrideParameters)
        
        'Si "remplacer les parametres de pliage" est coché
        If overrideParameters Then
            'On accede au parametres de pliage et à la zone de pliage
            errors = swSheetMetalData.SetOverrideDefaultParameter2(swSheetMetalOverrideDefaultParameters_e.swSheetMetalOverrideDefaultParameters_BendParameters, True)
            errors = swSheetMetalData.SetOverrideDefaultParameter2(swSheetMetalOverrideDefaultParameters_e.swSheetMetalOverrideDefaultParameters_BendAllowance, True)
            
            'Appel de la fonction choixRayonPliageParEpaisseur
            choixRayonPliageParEpaisseur swCustBend, swSheetMetalData, pieceCorps

            'On valide les modifications des parametres de tolerie
            bRet = swFeat.ModifyDefinition(swSheetMetalData, swModel, Nothing): Debug.Assert bRet
            'Stop
            Debug.Print "  Modified bend radius = " & swSheetMetalData.BendRadius * 1000# & " mm"
        End If
        
        Debug.Print "  " & swFeat.Name
        Debug.Print "      Tolérance de pliage        = " & swSheetMetalData.BendAllowance * 1000# & " mm"
        Debug.Print "      Fichier de table de pliage = " & swSheetMetalData.BendTableFile
        Debug.Print "      Epaisseur                  = " & swSheetMetalData.Thickness * 1000# & " mm"
        Debug.Print "      Rayon                      = " & swSheetMetalData.BendRadius * 1000# & " mm"
        Debug.Print "      Perte au pli               = " & swCustBend.BendDeduction * 1000# & " mm"
        Debug.Print "      KFactor                    = " & swSheetMetalData.KFactor
        Debug.Print "      Type de pli                = " & swCustBend.Type
        Debug.Print ""
        
    Next i

End Function

Function choixRayonPliageParEpaisseur(swCustBend As CustomBendAllowance, swSheetMetal As SldWorks.SheetMetalFeatureData, _
pieceCorps As Boolean)

'Test si epaisseur 1.5mm, rayon de pliage 1.5 et utilisation d'une table de pliage
If swSheetMetal.Thickness * 1000 = 1.5 And swSheetMetal.BendRadius * 1000 <> 1.5 _
Or swCustBend.Type <> 1 Then
            swSheetMetal.BendRadius = 1.5 / 1000
            swCustBend.Type = 1
            If pieceCorps Then
                nbModifDossier = nbModifDossier + 1
            Else
                nbModifCorps = nbModifCorps + 1
            End If

'Test si epaisseur 2mm, rayon de pliage 2 et utilisation d'une table de pliage
ElseIf swSheetMetal.Thickness * 1000 = 2 And swSheetMetal.BendRadius * 1000 <> 2 _
Or swCustBend.Type <> 1 Then
            swSheetMetal.BendRadius = 2 / 1000
            swCustBend.Type = 1
            If pieceCorps Then
                nbModifDossier = nbModifDossier + 1
            Else
                nbModifCorps = nbModifCorps + 1
            End If

'Test si epaisseur 3mm, rayon de pliage 3 et utilisation d'une table de pliage
ElseIf (swSheetMetal.Thickness * 1000 = 3 And swSheetMetal.BendRadius * 1000 <> 36) _
Or swCustBend.Type <> 1 Then
            swSheetMetal.BendRadius = 3 / 1000
            swCustBend.Type = 1
            If pieceCorps Then
                nbModifDossier = nbModifDossier + 1
            Else
                nbModifCorps = nbModifCorps + 1
            End If

'Test si epaisseur 4mm, rayon de pliage 4 et utilisation d'une table de pliage
ElseIf swSheetMetal.Thickness * 1000 = 4 And swSheetMetal.BendRadius * 1000 <> 4 _
Or swCustBend.Type <> 1 Then
            swSheetMetal.BendRadius = 4 / 1000
            swCustBend.Type = 1
            If pieceCorps Then
                nbModifDossier = nbModifDossier + 1
            Else
                nbModifCorps = nbModifCorps + 1
            End If
'Test si epaisseur 5mm, rayon de pliage 5 et utilisation d'une table de pliage
ElseIf swSheetMetal.Thickness * 1000 = 5 And swSheetMetal.BendRadius * 1000 <> 5 _
Or swCustBend.Type <> 1 Then
            swSheetMetal.BendRadius = 5 / 1000
            swCustBend.Type = 1
            If pieceCorps Then
                nbModifDossier = nbModifDossier + 1
            Else
                nbModifCorps = nbModifCorps + 1
            End If

        End If
End Function

Bonjour,

Le problème est lié aux paramètres passés aux deux méthodes AccessSelections() et ModifyDefinition(), qui sont différents selon que le document principal est une PIECE ou un ASSEMBLAGE.
L’aide des API souligne bien ce problème dans ses remarques de bas de page, et indique qu’une confusion ne bloque pas l’exécution, mais peut générer un comportement « inattendu ». :laughing:

Dans le premier cas, il faut passer le ModeleDoc de la pièce de tôlerie, dans le second il faut passer le ModelDoc de l’assemblage et le composant de tôlerie concerné par la modification.

La correction doit être apportée aux 3 endroits où apparaissent ces méthodes, en testant si le document principal est une pièce ou un assemblage.
L’arbre de construction de l’assemblage retrouve ensuite un comportement normal…

Version corrigée dans le document joint.
Il reste à tester la validité du traitement du point de vue de la tôlerie.

PliagePortefeuille2.swp (93 Ko)

1 « J'aime »

Un grand merci @m_blt pour toute l’aide que tu m’as apporté.

Voici mon code final ( en grande partie le tiens @m_blt ), si ça peut servir a quelqu’un :

Option Explicit

Dim nbTotalCorps             As Integer
Dim nbTotalDossier          As Integer
Dim nbModifCorps            As Integer
Dim nbModifDossier          As Integer
Dim pieceCorps              As Boolean
Dim swApp           As SldWorks.SldWorks
Dim boolstatus As Boolean
Dim swCustBend2 As CustomBendAllowance
Dim swSheetMetal As SldWorks.SheetMetalFeatureData




Sub main()
    Dim swModel         As ModelDoc2
    Dim swAssemb        As AssemblyDoc
    Dim swComp          As Component2
    Dim vComponents     As Variant
    Dim i               As Integer
    Dim OK              As Boolean
    
    nbTotalCorps = 0
    nbTotalDossier = 0
    nbModifCorps = 0
    nbModifDossier = 0

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    
    If swModel Is Nothing Then                      ' Si aucun document n'est ouvert
        MsgBox "Un document de pièce ou d'assemblage doit être ouvert.", vbExclamation
        Exit Sub
    
    ElseIf swModel.GetType = swDocPART Then         ' Si c'est une pièce...
        OK = SheetPart(Nothing, swModel)
        MsgBox nbModifDossier & " rayon de pliage modifier sur " & nbTotalDossier & " de dossier par défaut de tolerie" & vbCrLf & _
        nbModifCorps & " rayon de pliage modifier sur " & nbTotalCorps & " corps de tolerie"
        Exit Sub
    
    ElseIf swModel.GetType = swDocASSEMBLY Then     ' Si c'est un assemblage...
        Set swAssemb = swModel
        vComponents = swAssemb.GetComponents(True)  ' Tableau des composants de niveau 1 de l'assemblage
        For i = 0 To UBound(vComponents)
            Set swComp = vComponents(i)
            ParcourirComposants swComp              ' Parcours des composants (récursif)
        Next i
        MsgBox nbModifDossier & " rayon de pliage modifier sur " & nbTotalDossier & " de dossier par défaut de tolerie" & vbCrLf & _
        nbModifCorps & " rayon de pliage modifier sur " & nbTotalCorps & " corps de tolerie"
        
    End If
    swModel.ForceRebuild3 (True)

End Sub

Sub ParcourirComposants(swComp As SldWorks.Component2)
    
    Dim vChildComponents    As Variant
    Dim swModel             As ModelDoc2
    Dim swChildComp         As SldWorks.Component2
    Dim i                   As Integer
    Dim OK                  As Boolean
    
    Set swModel = swComp.GetModelDoc2                   ' Modèle associé au composant
    If Not swModel Is Nothing Then
        If swModel.GetType = swDocPART Then             ' Si c'est une pièce...
            OK = SheetPart(swComp, swModel)
            
        ElseIf swModel.GetType = swDocASSEMBLY Then     ' Si c'est un assemblage...
            vChildComponents = swComp.GetChildren       ' Liste des composants enfants
            For i = 0 To UBound(vChildComponents)
                Set swChildComp = vChildComponents(i)
                ParcourirComposants swChildComp         ' Parcours du composant enfant (récursif)
            Next i
        End If
        
    End If
End Sub


Function SheetPart(swComp As Component2, swModel As ModelDoc2) As Boolean

    Dim swFeat                  As Feature
    Dim vFeatArray              As Variant
    Dim sheetMetalFolder        As sheetMetalFolder
    Dim swSelMgr                As SelectionMgr
    Dim swSheetMetalData        As SheetMetalFeatureData
    Dim swCustBend              As CustomBendAllowance
    Dim gaugeTableFile          As String
    
    Dim i                       As Long
    Dim bRet                    As Boolean
    Dim lRet                    As Long
    Dim errors                  As Long
    Dim overrideParameters      As Boolean
    Dim swFeature               As SldWorks.Feature
    
    
    Set sheetMetalFolder = swModel.FeatureManager.GetSheetMetalFolder
    If sheetMetalFolder Is Nothing Then
        Exit Function
    End If
    
    Set swFeat = sheetMetalFolder.GetFeature
    Debug.Print "-------------------------------------------------"
    Debug.Print "Composant : " & swModel.GetPathName
    Debug.Print "  Nom du dossier de tôlerie : " & swFeat.Name
    Debug.Print "  Nombre de fonctions de tôlerie dans le dossier : " & sheetMetalFolder.GetSheetMetalCount
    Debug.Print ""
    
    'Création du tableau comportant chaque element de tolerie contenu dans le dossier de tolerie
    vFeatArray = sheetMetalFolder.GetSheetMetals
    'Stop
    Debug.Print "  Nom du dossier de tôlerie : " & vFeatArray(0).Name
    
    '
    Set swSheetMetalData = swFeat.GetDefinition
    Set swCustBend = swSheetMetalData.GetCustomBendAllowance

    'Accession au parametres de tolerie par défaut
    
    If swApp.ActiveDoc.GetType = swDocPART Then                             ' Si document principal type PIECE
        bRet = swSheetMetalData.AccessSelections(swModel, Nothing)
        
    Else
        bRet = swSheetMetalData.AccessSelections(swApp.ActiveDoc, swComp)   ' ou si type ASSEMBLAGE
       
    End If
    
    pieceCorps = True
    nbTotalDossier = nbTotalDossier + 1

   'Appel de la fonction choixRayonPliageParEpaisseur
            choixRayonPliageParEpaisseur swCustBend, swSheetMetalData, swComp, swModel, swFeat
   
    Debug.Print "  Modified bend radius = " & swSheetMetalData.BendRadius * 1000# & " mm"
    
    'Boucle sur les elements de tolerie contenu dans le dossier

    For i = LBound(vFeatArray) To UBound(vFeatArray)
        Set swFeat = vFeatArray(i)
        Set swSheetMetalData = swFeat.GetDefinition
        Set swCustBend = swSheetMetalData.GetCustomBendAllowance
        pieceCorps = False
        nbTotalCorps = nbTotalCorps + 1

        'verification de l'état "Remplacer les parametres de pliage"
        errors = swSheetMetalData.GetOverrideDefaultParameter2(swSheetMetalOverrideDefaultParameters_BendParameters, overrideParameters)
            Debug.Print ("  Bend parameters: " & overrideParameters)

        'Si "remplacer les parametres de pliage" est coché
        If overrideParameters Then
            'On accede au parametres de pliage et à la zone de pliage
            errors = swSheetMetalData.SetOverrideDefaultParameter2(swSheetMetalOverrideDefaultParameters_BendParameters, True)
            errors = swSheetMetalData.SetOverrideDefaultParameter2(swSheetMetalOverrideDefaultParameters_BendAllowance, True)

            'Appel de la fonction choixRayonPliageParEpaisseur
            choixRayonPliageParEpaisseur swCustBend, swSheetMetalData, swComp, swModel, swFeat

            Debug.Print "  Modified bend radius = " & swSheetMetalData.BendRadius * 1000# & " mm"
        End If

        Debug.Print "  " & swFeat.Name
        Debug.Print "      Tolérance de pliage        = " & swSheetMetalData.BendAllowance * 1000# & " mm"
        Debug.Print "      Fichier de table de pliage = " & swSheetMetalData.bendTablefile
        Debug.Print "      Epaisseur                  = " & swSheetMetalData.Thickness * 1000# & " mm"
        Debug.Print "      Rayon                      = " & swSheetMetalData.BendRadius * 1000# & " mm"
        Debug.Print "      Perte au pli               = " & swCustBend.BendDeduction * 1000# & " mm"
        Debug.Print "      KFactor                    = " & swSheetMetalData.KFactor
        Debug.Print "      Type de pli                = " & swCustBend.Type
        Debug.Print ""

    Next i

End Function

Sub choixRayonPliageParEpaisseur(swCustBend As CustomBendAllowance, swSheetMetalData As SheetMetalFeatureData, _
 swComp As Component2, swModel As ModelDoc2, swFeat As Feature)
'Stop

    Dim bRet                    As Boolean
    Dim epaisseur As Double
    Dim rayon As Double
    Dim tabEpRayon(4, 1) As Double
    Dim j As Integer
    Dim bendTablefile As String
    
    
    tabEpRayon(0, 0) = 1.5
    tabEpRayon(0, 1) = 1.5
    tabEpRayon(1, 0) = 2
    tabEpRayon(1, 1) = 2
    tabEpRayon(2, 0) = 3
    tabEpRayon(2, 1) = 3
    tabEpRayon(3, 0) = 4
    tabEpRayon(3, 1) = 4
    tabEpRayon(4, 0) = 5
    tabEpRayon(4, 1) = 5
    
    bendTablefile = "C:\Program Files\SOLIDWORKS Corp 2022\SOLIDWORKS\lang\french\Sheetmetal Bend Tables\TABLE DE PLIAGE EN MM B.XLS"
    
    epaisseur = swSheetMetalData.Thickness * 1000
    rayon = swSheetMetalData.BendRadius * 1000
    
    For j = 0 To 4

        'Test si epaisseur 1.5mm, rayon de pliage 1.025 et utilisation d'une table de pliage
        If tabEpRayon(j, 0) = epaisseur And tabEpRayon(j, 1) <> rayon Or _
            tabEpRayon(j, 0) = epaisseur And swCustBend.Type <> 1 Or _
            tabEpRayon(j, 0) = epaisseur And swSheetMetalData.bendTablefile <> bendTablefile Then
            'Stop
            swSheetMetalData.BendRadius = tabEpRayon(j, 1) / 1000
            swCustBend.Type = 1
            swSheetMetalData.bendTablefile = bendTablefile
            If pieceCorps Then
                nbModifDossier = nbModifDossier + 1
            Else
            nbModifCorps = nbModifCorps + 1
            End If
        End If
    Next j
   
    Debug.Print swModel.GetType
    Debug.Print swModel.GetTitle
    Debug.Print swComp.GetPathName
    'On valide les modifications des parametres de tolerie
    If swApp.ActiveDoc.GetType = swDocPART Then                                     ' Si document principal type PIECE
        bRet = swFeat.ModifyDefinition(swSheetMetalData, swModel, Nothing)
        'Stop
    Else
        bRet = swFeat.ModifyDefinition(swSheetMetalData, swApp.ActiveDoc, swComp)   ' ou si type ASSEMBLAGE
        'Stop
    End If
        
End Sub


1 « J'aime »