Bonjour @all,
Je cherche un moyen de remplacer les formats de feuille existants par un format de feuille différent en fonction de la taille (A0, A1, A2, etc.) en série pour tous les dessins d’un dossier.
Je suis surpris de ne pas avoir pu trouver l’option dans MyCadTools.
Merci d’avance.
Salutations Andreas
Tu peux remplacer/recharger un fond de plan avec intégration pour un lot de mise en plan:
Sinon possibilité de le faire par macro (ici on recharge le même format avec un nouveau template-> a modifier pour tes formats):
Option Explicit
'Site avec exemple: https://www.lynkoa.com/forum/mises-en-plan/modifier-une-note-sur-un-fond-de-plan-solidworks-avec-une-macro
Public Enum swDocumentTypes_e
swDocNONE = 0 ' Used to be TYPE_NONE
swDocPART = 1 ' Used to be TYPE_PART
swDocASSEMBLY = 2 ' Used to be TYPE_ASSEMBLY
swDocDRAWING = 3 ' Used to be TYPE_DRAWING
End Enum
Dim swSheet As SldWorks.Sheet
Dim swApp As Object
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swModelDocExt As ModelDocExtension
Dim sTemplate As String
Dim stemplatepath As String
Dim Count As Integer
Dim vSheetNameArr As Variant
Dim vSheetName As Variant
Dim vSheetProps As Variant
Dim bRet As Boolean
Dim tolerie As Boolean
Dim swView As SldWorks.View
Dim userName As String
Dim cDirTemplate As String
Dim cTemplateA4 As String
Dim cTemplateA4_Laser As String
Dim cTemplateA3 As String
Dim cTemplateA2 As String
Dim cTemplateA1 As String
Dim cTemplateA0 As String
Dim cTemplateA0plus As String
Option Explicit
'Site avec exemple: https://www.lynkoa.com/forum/mises-en-plan/modifier-une-note-sur-un-fond-de-plan-solidworks-avec-une-macro
Public Enum swDocumentTypes_e
swDocNONE = 0 ' Used to be TYPE_NONE
swDocPART = 1 ' Used to be TYPE_PART
swDocASSEMBLY = 2 ' Used to be TYPE_ASSEMBLY
swDocDRAWING = 3 ' Used to be TYPE_DRAWING
End Enum
Dim swSheet As SldWorks.Sheet
Dim swApp As Object
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swModelDocExt As ModelDocExtension
Dim sTemplate As String
Dim stemplatepath As String
Dim Count As Integer
Dim vSheetNameArr As Variant
Dim vSheetName As Variant
Dim vSheetProps As Variant
Dim bRet As Boolean
Dim tolerie As Boolean
Dim swView As SldWorks.View
Dim userName As String
Dim cDirTemplate As String
Dim cTemplateA4 As String
Dim cTemplateA4_Laser As String
Dim cTemplateA3 As String
Dim cTemplateA2 As String
Dim cTemplateA1 As String
Dim cTemplateA0 As String
Dim cTemplateA0plus As String
Sub main()
'Variable à remplacer lors d'un changement de fond de plan
'Constantes à remplacer lors de changement de fond de plan
cDirTemplate = " C:\xxx\xxx\Fond de plan C\" 'Mettre le chemin d'accès aux fonds de plans sous ce format: C:\xxx\xxx\
cTemplateA4 = "a4-c.slddrt" 'A renommer si vos templates s'appelle autrement
cTemplateA4_Laser = "a4-DECOUPE-c.slddrt"
cTemplateA3 = "a3-c.slddrt"
cTemplateA2 = "a2-c.slddrt"
cTemplateA1 = "a1-c.slddrt"
cTemplateA0 = "A0-c.slddrt"
cTemplateA0plus = "A0+-c.slddrt"
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
MsgBox ("Pas de document ouvert")
Else
If swModel.GetType <> 3 Then
MsgBox ("Il ne s'agît pas d'une mise en plan")
Else
Set swDraw = swModel
Set swModelDocExt = swModel.Extension
vSheetNameArr = swDraw.GetSheetNames
For Each vSheetName In vSheetNameArr
Debug.Print vSheetName
bRet = swDraw.ActivateSheet(vSheetName): Debug.Assert bRet
Set swSheet = swDraw.GetCurrentSheet
'Ajout SD test nom template pas utile dans la macro (pour version future?):
Set swSheet = swDraw.GetCurrentSheet
sTemplate = Mid(swSheet.GetTemplateName, InStrRev(swSheet.GetTemplateName, "\") + 1)
Debug.Print sTemplate
Set swView = swDraw.GetFirstView
Set swView = swView.GetNextView
'On récupère le nom de la config de la vue
Debug.Print "Nom de la vue" & swView.Name
Debug.Print "Configuration" & swView.ReferencedConfiguration
vSheetProps = swSheet.GetProperties
Debug.Print "vSheetProps(0)=" & vSheetProps(0)
If vSheetProps(0) = "7" And swView.ReferencedConfiguration Like "*FLAT-PATTERN" Then 'A4
stemplatepath = cDirTemplate & cTemplateA3
bRet = swDraw.SetupSheet4(swSheet.GetName, vSheetProps(0), 12, vSheetProps(2), vSheetProps(3), True, stemplatepath, 0#, 0#, "")
stemplatepath = cDirTemplate & cTemplateA4_Laser
bRet = swDraw.SetupSheet4(swSheet.GetName, vSheetProps(0), 12, vSheetProps(2), vSheetProps(3), True, stemplatepath, 0#, 0#, "")
swModel.ForceRebuild3 (False)
ElseIf vSheetProps(0) = "7" Then 'A4
stemplatepath = cDirTemplate & cTemplateA3
bRet = swDraw.SetupSheet4(swSheet.GetName, vSheetProps(0), 12, vSheetProps(2), vSheetProps(3), True, stemplatepath, 0#, 0#, "")
stemplatepath = cDirTemplate & cTemplateA4
bRet = swDraw.SetupSheet4(swSheet.GetName, vSheetProps(0), 12, vSheetProps(2), vSheetProps(3), True, stemplatepath, 0#, 0#, "")
swModel.ForceRebuild3 (False) 'A2
ElseIf vSheetProps(0) = "8" Then 'A3
stemplatepath = cDirTemplate & cTemplateA4
bRet = swDraw.SetupSheet4(swSheet.GetName, vSheetProps(0), 12, vSheetProps(2), vSheetProps(3), True, stemplatepath, 0#, 0#, "")
stemplatepath = cDirTemplate & cTemplateA3
bRet = swDraw.SetupSheet4(swSheet.GetName, vSheetProps(0), 12, vSheetProps(2), vSheetProps(3), True, stemplatepath, 0#, 0#, "")
swModel.ForceRebuild3 (False) 'A2
ElseIf vSheetProps(0) = "9" Then
stemplatepath = cDirTemplate & cTemplateA4
bRet = swDraw.SetupSheet4(swSheet.GetName, vSheetProps(0), 12, vSheetProps(2), vSheetProps(3), True, stemplatepath, 0#, 0#, "")
stemplatepath = cDirTemplate & cTemplateA2
bRet = swDraw.SetupSheet4(swSheet.GetName, vSheetProps(0), 12, vSheetProps(2), vSheetProps(3), True, stemplatepath, 0#, 0#, "")
swModel.ForceRebuild3 (False)
ElseIf vSheetProps(0) = "10" Then 'A1
stemplatepath = cDirTemplate & cTemplateA4
bRet = swDraw.SetupSheet4(swSheet.GetName, vSheetProps(0), 12, vSheetProps(2), vSheetProps(3), True, stemplatepath, 0#, 0#, "")
stemplatepath = cDirTemplate & cTemplateA1
bRet = swDraw.SetupSheet4(swSheet.GetName, vSheetProps(0), 12, vSheetProps(2), vSheetProps(3), True, stemplatepath, 0#, 0#, "")
swModel.ForceRebuild3 (False)
ElseIf vSheetProps(0) = "11" Then 'A0
stemplatepath = cDirTemplate & cTemplateA4
bRet = swDraw.SetupSheet4(swSheet.GetName, vSheetProps(0), 12, vSheetProps(2), vSheetProps(3), True, stemplatepath, 0#, 0#, "")
stemplatepath = cDirTemplate & cTemplateA0
bRet = swDraw.SetupSheet4(swSheet.GetName, vSheetProps(0), 12, vSheetProps(2), vSheetProps(3), True, stemplatepath, 0#, 0#, "")
swModel.ForceRebuild3 (False)
ElseIf vSheetProps(0) = "11" Then 'A0+
stemplatepath = cDirTemplate & cTemplateA4
bRet = swDraw.SetupSheet4(swSheet.GetName, vSheetProps(0), 12, vSheetProps(2), vSheetProps(3), True, stemplatepath, 0#, 0#, "")
stemplatepath = cDirTemplate & cTemplateA0plus
bRet = swDraw.SetupSheet4(swSheet.GetName, vSheetProps(0), 12, vSheetProps(2), vSheetProps(3), True, stemplatepath, 0#, 0#, "")
swModel.ForceRebuild3 (False)
ElseIf vSheetProps(0) <> "7" Then 'Pour les formats un peu exotiques non gérés
If vSheetProps(0) <> "8" Then
If vSheetProps(0) <> "9" Then
If vSheetProps(0) <> "10" Then
If vSheetProps(0) <> "11" Then
If vSheetProps(0) <> "12" Then
MsgBox "Le fond de plan ne correspond à aucune trame connue" & vbCrLf & "Aucun changement appliqué"
Exit Sub
End If: End If: End If: End If: End If
End If
Next
End If
End If
swModel.Save2 (True) 'Sauvegarde des changements
End Sub
Pour appliquer la macro sur un lot de mise en plan, possibilité de le faire par Intégration
Avec une condition sur Systématique puis l’opération sur Divers lancement d’une macro.
Après avoir éliminé quelques erreurs d’application de ma part, il a parfaitement fonctionné.
Merci beaucoup et meilleures salutations de la part de la Forêt-Noire / Allemagne
Andreas
Par curiosité quel solution as-tu retenu?
Macro
Macro + Intégration
Intégration seul