Makro; Ponownie załaduj format arkusza, ale nie skaluj

Witam wszystkich

Z entuzjazmem przeczytałem zawartość tego forum, dlatego pomyślałem, że jestem w dobrych rękach ze swoim problemem tutaj.

Szybkie informacje z góry: Jestem nowicjuszem w makro!

Używam SoWo 2021 SP5.1 Standard i dołączyłem makro do ponownego załadowania formatu arkusza. Działa to dobrze, z wyjątkiem łuski liściowej. Makro zawsze resetuje go do 1:1, choć on np. 5:1.
Jak powinno wyglądać makro, aby « wykluczyć » skalę arkusza?

Czy ktoś może mi w tym pomóc?

Z góry dziękuję za wysiłek :-)

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

Witam

Należy użyć metody ReloadTemplate.
Poniżej znajduje się przykład, który ponownie wczytuje mapy bazowe każdej strony, powraca do strony 1, a następnie zapisuje.

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 polubienia

Cześć Cyryl,

wow, to było szybkie. Z góry bardzo dziękuję za szybką informację zwrotną i pomoc. Makro działa pięknie.

Dostosowałem nieco twoje makro, aby móc załadować inny format arkusza w tym samym czasie. Oto makro, na wypadek, gdyby pomogło komuś innemu.

Dziękuję za wszystko.

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 polubienie