Wielkie podziękowania @m_blt za całą pomoc, której mi udzieliliście.
Oto mój ostateczny kod (głównie Twój @m_blt ), jeśli może się komuś przydać:
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
