Ou sinon changer le fond de plan par un autre déjà modifié. Via intégration ou au besoin macro ci-jointe (il faut modifier le chemin des fonds de plan) a tester sur un plan puis via + intégration pour lancer la macro sur chaque fond de plan.
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 = "U:\Entreprise\Service BE\1-Commun service\Solidworks\Configuration\Modèle de documents\Modèle SW 2020\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