Hallo und vielen Dank @m.blt für die obige Anweisung, die es mir ermöglicht hat, gute Fortschritte zu machen, und ich würde sagen, dass ich meinen Code (der im Grunde genommen von Ihnen stammt) fast fertiggestellt habe.
Allerdings habe ich immer noch ein Problem, alles funktioniert so, wie ich es möchte, so dass ich die Standard-Blecheinstellungen ändern kann, aber auch die Ersatzeinstellungen bei einem Mehrkörperteil.
Wenn ich das Makro mit einem ein- oder mehrteiligen Blechteil ausführe, funktioniert alles perfekt.
Auf der anderen Seite, als ich es mit einer Assembly zum Laufen gebracht habe, funktioniert der gesamte Verarbeitungsprozess anscheinend gut, aber wenn das Makro fertig ausgeführt wird, bleibt die Datei halb blockiert.
Ich kann z.B. mit einem Rechtsklick nicht mehr die Kontextmenüs anzeigen, und ich bin gezwungen, die Datei zu schließen und erneut zu öffnen, damit sie wieder funktioniert.
Ich verstehe nicht, warum es das mit den Baugruppen macht.
Jede Hilfe wird für mich wertvoll sein, um sie zu verstehen, danke im Voraus.
Hier ist der 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
