Makro; Blattformat neu laden aber maßstab nicht

Macro
1

Hallo zusammen,

ich lese mit Begeisterung den Inhalt dieses Forums, weshalb ich dachte das ich mit meinem Problem hier gut aufgehoben bin.

Kurze Info vorab: Ich bin ein Makro-Neuling!

Ich nutze SoWo 2021 SP5.1 Standard und habe ein Makro aufgenommen um das Blattformat neu zu Laden. Das funktioniert gut, bis auf den Blattmaßstab. Das Makro setzt ihn immer auf 1:1 zurück, obwohl er bspw. 5:1 war.
Wie sollte das Makro aussehen um den Blattmaßstab « auszuklammern »?

Kann mir hierbei jemand helfen?

Ich bedanke mich jetzt schonmal im Vorfeld für eure Mühe :- )

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

Hallo

Die ReloadTemplate-Methode muss verwendet werden.
Im Folgenden finden Sie ein Beispiel, in dem die Grundkarten jeder Seite neu geladen werden, zu Seite 1 zurückkehren und dann gespeichert werden.

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 „Gefällt mir“
3

Hi Cyril,

wow das ging ja schnell. Vielen Dank schonmal für deine schnelle Rückmeldung und hilfe. Das Makro funktioniert wunderbar.

Ich habe dein Makro noch etwas angepasst damit ich gleichzeit noch ein anderes Blattformat laden kann. Hier das Makro, falls es jemand anderem auch hilft.

Vielen Dank für alles.

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 „Gefällt mir“