Macro; Bladformaat opnieuw laden, maar niet schalen

Macro
1

Hallo allemaal

Ik heb de inhoud van dit forum met enthousiasme gelezen, waardoor ik dacht dat ik hier met mijn probleem in goede handen was.

Snelle info vooraf: ik ben een macro newbie!

Ik gebruik SoWo 2021 SP5.1 Standard en heb een macro meegeleverd om het bladformaat opnieuw te laden. Dit werkt goed, behalve de bladschaal. De macro zet hem altijd terug op 1:1, hoewel hij bijv. 5:1.
Hoe moet de macro eruit zien om de bladschaal uit te sluiten  ?

Kan iemand mij hierbij helpen?

Ik dank je bij voorbaat voor je moeite :-)

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

De methode ReloadTemplate moet worden gebruikt.
Hieronder ziet u een voorbeeld dat de basiskaarten van elke pagina opnieuw laadt, terugkeert naar pagina 1 en vervolgens opslaat.

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

Hoi Cyril,

wow dat was snel. Bij voorbaat hartelijk dank voor uw snelle feedback en hulp. De macro werkt prachtig.

Ik heb je macro een beetje aangepast zodat ik tegelijkertijd een ander bladformaat kan laden. Hier is de macro, voor het geval het iemand anders helpt.

Bedankt voor 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 like