Macro; Reload sheet format but not scale

Macro
1

Hello everyone

I read the content of this forum with enthusiasm, which is why I thought that I was in good hands with my problem here.

Quick info in advance: I'm a macro newbie!

I use SoWo 2021 SP5.1 Standard and have included a macro to reload the sheet format. This works well, except for the leaf scale. The macro always resets him to 1:1, although he e.g. 5:1.
What should the macro look like in order to « exclude » the sheet scale?

Can someone help me with this?

I thank you in advance for your effort :-)

tippe oder füge den Code hier einDim swApp As Object

Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc
boolstatus = Part.Extension.SelectByID2("Blatt1", "SHEET", 0.280273244100153, 0.269057755102041, 0, False, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Blattformat1", "SHEET", 0, 0, 0, False, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Blattformat1", "SHEET", 0, 0, 0, False, 0, Nothing, 0)
Part.ClearSelection2 True
boolstatus = Part.SetupSheet5("Blatt1", 12, 12, 5, 1, True, "DIN A3, V2.slddrt", 0.42, 0.297, "Standard", False)
boolstatus = Part.SetupSheet5("Blatt1", 12, 12, 5, 1, True, "DIN A3, V2.slddrt", 0.42, 0.297, "Standard", False)

' Zoom To Fit
Part.ViewZoomtofit2

' Zoom To Fit
Part.ViewZoomtofit2

' Zoom To Fit
Part.ViewZoomtofit2

' Save
Dim swErrors As Long
Dim swWarnings As Long
boolstatus = Part.Save3(1, swErrors, swWarnings)
End Sub
2

Hello

The ReloadTemplate method must be used.
Below is an example that reloads the basemaps of each page, returns to page 1 and then saves.

Sub Reload_Template()
Dim swApp           As SldWorks.SldWorks
Dim swModel         As SldWorks.ModelDoc2
Dim swDraw          As SldWorks.DrawingDoc
Dim vSheetNameArr   As Variant
Dim vSheetName      As Variant
Dim swSheet         As SldWorks.Sheet
Dim bRet            As Boolean
Dim lErrors         As Long
Dim lWarnings       As Long

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
vSheetNameArr = swDraw.GetSheetNames
For Each vSheetName In vSheetNameArr
    bRet = swDraw.ActivateSheet(vSheetName): Debug.Assert bRet
    Set swSheet = swDraw.GetCurrentSheet
    swSheet.ReloadTemplate (False)
Next
bRet = swDraw.ActivateSheet(vSheetNameArr(0)): Debug.Assert bRet
bRet = swModel.Save3(swSaveAsOptions_Silent, lErrors, lWarnings)
End Sub
3 Likes
3

Hi Cyril,

wow that was fast. Thank you very much in advance for your quick feedback and help. The macro works beautifully.

I have adjusted your macro a bit so that I can load another sheet format at the same time. Here's the macro, in case it helps someone else.

Thank you for everything.

Sub Reload_Template()
Dim swApp           As SldWorks.SldWorks
Dim swModel         As SldWorks.ModelDoc2
Dim swDraw          As SldWorks.DrawingDoc
Dim vSheetNameArr   As Variant
Dim vSheetName      As Variant
Dim swSheet         As SldWorks.Sheet
Dim bRet            As Boolean
Dim lErrors         As Long
Dim lWarnings       As Long

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc
boolstatus = Part.Extension.SelectByID2("Blatt1", "SHEET", 0.280273244100153, 0.269057755102041, 0, False, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Blattformat1", "SHEET", 0, 0, 0, False, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Blattformat1", "SHEET", 0, 0, 0, False, 0, Nothing, 0)
Part.ClearSelection2 True
boolstatus = Part.SetupSheet5("Blatt1", 12, 12, 5, 1, True, "DIN A3, V2.slddrt", 0.42, 0.297, "Standard", False)
boolstatus = Part.SetupSheet5("Blatt1", 12, 12, 0, 0, True, "DIN A3, V2.slddrt", 0.42, 0.297, "Standard", False)

Set swModel = swApp.ActiveDoc
Set swDraw = swModel
vSheetNameArr = swDraw.GetSheetNames
For Each vSheetName In vSheetNameArr
    bRet = swDraw.ActivateSheet(vSheetName): Debug.Assert bRet
    Set swSheet = swDraw.GetCurrentSheet
    swSheet.ReloadTemplate (False)
Next
bRet = swDraw.ActivateSheet(vSheetNameArr(0)): Debug.Assert bRet
bRet = swModel.Save3(swSaveAsOptions_Silent, lErrors, lWarnings)
End Sub
1 Like