Access multibody sheet metal settings with VBA

Good morning,

I'm looking to access the sheet metal folding parameters on a multibody part, I have this code that I thought could solve my problems.
But when I launch it, it gives me values that are identical everywhere and are not the right radius and thickness.

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

Here is one of my sheet metal settings:
Screenshot_54

And here is the result of the code above:

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 

Can you tell me why I don't have the right values?
I don't understand why I always have 0.00015, which corresponds to 0.15mm
and 0.0005 which corresponds to 0.5 mm.

Good evening @treza88

The error comes from the functions of these two lines:

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

The first creates a sheet metal data structure with default settings.
The second requires the replacement of the current sheet metal body structure in the structure.
Which explains why they are all identical...

The attached macro uses the method Set swSheetMetalData = swFeat.GetDefinition to retrieve data from the sheet metal body and display it.

SettingsTolerie.swp (51.5 KB)

1 Like

Great thanks @m.blt for the code, it works perfectly.

If I dared to abuse, could you tell me how I could use this code in an assembly and loop on all the parts of this same assembly?

Good evening

The macro below should answer this " abusive " question. :wink:
It scans the entire assembly tree to find the parts, identifies for each part if it is a sheet metal part, and if so, displays its properties.
The other parts (non-sheet metal) are ignored.

The macro also claims to work on a part document.

SettingsSheet MetalAssemb.swp (64.5 KB)

A big thank you it's super nice of you, the code works perfectly in an assembly and in a part file. I'd like to be as comfortable with the VBA Solidworks as you are.

I'm going to analyze this code, and I'd try to modify it so that it can detect if in the main assembly there are any child assemblies.

Your code seems clear enough for me to get there, and in case I come back to the forum.
I'll validate your answer and I'll cancel it if I have to come back to ask questions

In principle, the macro already responds to the deep exploration of the assembly tree.
It traverses the first level of the main assembly in the " main " procedure, but also subassemblies, regardless of their level, in the " BrowseComponents " procedure, which operates recursively.

The last " SheetPart " function is almost identical to the one in my previous shipment, to display the sheet metal settings of the part.

Thank you @m.blt I tested it and it works perfectly.

On the other hand I tried to modify the bend radius by adding:

swSheetMetalData.BendRadius = 2.06 / 1000

But it doesn't work, how do I change the radius value?

Hello

In the " SheetPart " function of my macro, the " swSheetMetalData " variable of type " SheetMetalFeatureData " contains the parameters of the sheet metal ("swFeat ") function.
The " AccessSelections " method of this class allows you to access the parameters of this data structure, and to change its values.
Subsequently, the " ModifyDefinition " method of the sheet metal feature (" swFeat ") causes the change.

If you open the SolidWorks API Help (at the bottom of page https://help.solidworks.com/), and search for the " ISheetMetalFeatureData " class, you will find the suggested example " Change Bend Radius of Sheet Metal Part (VBA) " that answers your question exactly.

image

In general, the help of the APIs is indigestible but very complete, and offers many examples to draw inspiration from.
Good afternoon...

Sorry I'm clumsy, but I modified the code as follows:

I added, which apparently allows access to " BendRadius ":

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

Referring to the example, but it still doesn't work, though:
" swSheetMetalData " is indeed defined as the object of " swFeat.GetDefinition ", as in the example?

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

To validate the changes, this statement must be added after the values have been defined, and before the series of displays...

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

Unless I'm mistaken, the change is made to the default radius value of the " Sheet metal" function.
It seems that it is also necessary to have checked the box " Override settings..."  for the change to be effective.

image

The change has no effect on the radii of the folds created by the successive functions, if they have been defined with specific radii (Transition Fold, Sketched Fold, Edge-Folded Sheet, etc.). In this case, it is necessary to access each of these particular functions. Galley...
See this example from the API help:
Get All Sheet Metal Feature Data Example (VBA)

Thank you really for your explanations which remains affordable for me as a partially neophyte.

That's also why I apparently thought wrongly that I had to validate the following property (in post#1) to be able to override the default bend radius:

swBaseFlangeFeat.OverrideDefaultSheetMetalParameters = True

So it couldn't be easier to access the modification of these bending radii.

But if you have to go through all this "Get All Sheet Metal Feature Data Example (VBA)" code, it's incredibly complex, just to change a bend radius on all components or bodies.


EDIT: "Get All Sheet Metal Feature Data Example (VBA)" does not allow modification, but only serves to acquire the data. There is no such thing as a " Set Sheet Metal Feature Data "?


One might think that as long as one accesses the component or body which is an object with properties of which the bend radius is part of it.
You can modify the base radius of the bend which is part of the properties of this same object.

But apparently this is not the case?

I hope you can follow my reasoning (not necessarily logical), which is based on objects and their properties.

The instruction that allows you to check/uncheck the " Replace parameters..." box would be this one, placed before validating the modifications. To be tested.

swSheetMetalData.SetOverrideDefaultParameter2 swSheetMetalOverrideDefaultParameters_BendParameters, True

As for functions that use particular rays, I don't see any other solution than to search for the functions in question in the tree one by one.

Not monstrous insofar as it is very repetitive, the key being to know the names used by Solidworks. Hence the interest of the example " Get All Sheet Metal..." »

Hello and thank you @m.blt for the above instruction which allowed me to make good progress and I would say to almost complete my code (which is basically yours).

However, I still have a problem, everything works as I want it to, so I can change the default sheet metal settings, but also the replacement settings in the case of a multibody part.
When I run the macro with a single or multibody sheet metal part, everything works perfectly.
On the other hand when I made it work with an assembly the whole processing process works fine apparently, but when the macro has finished running, the file remains semi-blocked.
I can no longer with a right click for example to display the context menus, and I am forced to close the file and reopen it, for it to work again.

I don't understand why with the assemblies it does that.
Any help will be precious to me to understand, thank you in advance.

Here's the 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

Hello

The problem is related to the parameters passed to the two methods AccessSelections() and ModifyDefinition(), which are different depending on whether the main document is a PART or an ASSEMBLY.
API help highlights this issue in its footnotes, and indicates that confusion does not block execution, but can result in " unexpected " behavior. :laughing:

In the first case, you have to pass the ModeleDoc of the sheet metal part, in the second you have to pass the ModelDoc of the assembly and the sheet metal component concerned by the change.

The correction must be made in the 3 places where these methods appear, by testing whether the main document is a part or an assembly.
The construction tree of the assembly then returns to normal behavior...

Version corrected in the attached document.
The validity of the treatment from the point of view of sheet metal work remains to be tested.

FoldWallet2.swp (93 KB)

1 Like

A big thank you @m.blt for all the help you gave me.

Here is my final code (mostly yours @m.blt ), if it can be useful to anyone:

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 Like