Option Explicit

' ==============================================================================
' Maßstab schnell ändern — SolidWorks 2022 SP5 (Zeichnung)
' ------------------------------------------------------------------------------
' Zwei Einsprungpunkte (je auf eine Taste/Schaltfläche legbar):
'   1. MassstabKleiner  – Maßstab verkleinern
'   2. MassstabGroesser – Maßstab vergrößern
'
' Routing pro Aufruf:
'   - Ist eine Ansicht im Modus "benutzerdefinierter Maßstab" selektiert
'     -> nur deren Ansichtsmaßstab ändern.
'   - Sonst (nichts selektiert, oder Ansicht nutzt Blatt-/Eltern-Maßstab)
'     -> Blattmaßstab ändern.
'
' Inkrement immer 1. Keine Dialoge, keine Meldungen.
' Schritt-Logik (num:den): vergrößern -> den-1, bei den=1 dann num+1
'                          verkleinern -> num-1, bei num=1 dann den+1
' (kreuzt 1:1 korrekt, bleibt immer >= 1)
' ==============================================================================

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2

' ===== Einsprungpunkt 1 =====
Sub MassstabKleiner()
    AendereMassstab False
End Sub

' ===== Einsprungpunkt 2 =====
Sub MassstabGroesser()
    AendereMassstab True
End Sub

' ------------------------------------------------------------------------------
' Zentrale Routing-Logik: custom-Ansicht oder Blatt.
' ------------------------------------------------------------------------------
Private Sub AendereMassstab(ByVal vergroessern As Boolean)
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    If swModel Is Nothing Then Exit Sub
    If swModel.GetType() <> swDocDRAWING Then Exit Sub

    Dim swDraw As SldWorks.DrawingDoc
    Set swDraw = swModel

    ' Selektierte Ansicht im custom-Maßstab-Modus suchen
    Dim swView As SldWorks.View
    Set swView = HoleCustomAnsicht()

    If Not swView Is Nothing Then
        AendereAnsichtMassstab swView, vergroessern
    Else
        AendereBlattMassstab swDraw, vergroessern
    End If

    swModel.EditRebuild3
End Sub

' ------------------------------------------------------------------------------
' Erste selektierte Zeichnungsansicht zurückgeben, die im Modus
' "benutzerdefinierter Maßstab" steht (weder Blatt- noch Eltern-Maßstab).
' Andernfalls Nothing.
' ------------------------------------------------------------------------------
Private Function HoleCustomAnsicht() As SldWorks.View
    Dim swSelMgr As SldWorks.SelectionMgr
    Set swSelMgr = swModel.SelectionManager

    Dim swView As SldWorks.View
    Dim i As Long
    For i = 1 To swSelMgr.GetSelectedObjectCount2(-1)
        ' swSelDRAWINGVIEWS = 12
        If swSelMgr.GetSelectedObjectType3(i, -1) = swSelDRAWINGVIEWS Then
            Set swView = swSelMgr.GetSelectedObject6(i, -1)
            ' custom = weder Blatt- noch Eltern-Maßstab
            If Not swView.UseSheetScale And Not swView.UseParentScale Then
                Set HoleCustomAnsicht = swView
                Exit Function
            End If
        End If
    Next i

    Set HoleCustomAnsicht = Nothing
End Function

' ------------------------------------------------------------------------------
' Einen Maßstab-Bruch (num:den) um genau 1 verstellen.
' ------------------------------------------------------------------------------
Private Sub SchrittMassstab(ByRef num As Double, ByRef den As Double, ByVal vergroessern As Boolean)
    If vergroessern Then
        If den > 1 Then
            den = den - 1
        Else
            num = num + 1
        End If
    Else
        If num > 1 Then
            num = num - 1
        Else
            den = den + 1
        End If
    End If
End Sub

' ------------------------------------------------------------------------------
' Blattmaßstab des aktuellen Blatts verstellen.
' ------------------------------------------------------------------------------
Private Sub AendereBlattMassstab(ByVal swDraw As SldWorks.DrawingDoc, ByVal vergroessern As Boolean)
    Dim swSheet As SldWorks.Sheet
    Set swSheet = swDraw.GetCurrentSheet
    If swSheet Is Nothing Then Exit Sub

    ' GetProperties2: (2)=Maßstab-Zähler, (3)=Maßstab-Nenner
    Dim props As Variant
    props = swSheet.GetProperties2()

    Dim num As Double, den As Double
    num = props(2)
    den = props(3)

    SchrittMassstab num, den, vergroessern

    ' SetScale(Zähler, Nenner, Anno-Position skalieren, Anno-Texthöhe skalieren)
    swSheet.SetScale num, den, False, False
End Sub

' ------------------------------------------------------------------------------
' Maßstab einer (bereits als custom geprüften) Ansicht verstellen.
' ------------------------------------------------------------------------------
Private Sub AendereAnsichtMassstab(ByVal swView As SldWorks.View, ByVal vergroessern As Boolean)
    ' ScaleRatio: (0)=Zähler, (1)=Nenner
    Dim ratio As Variant
    ratio = swView.ScaleRatio

    Dim num As Double, den As Double
    num = ratio(0)
    den = ratio(1)

    SchrittMassstab num, den, vergroessern

    Dim neu(1) As Double
    neu(0) = num
    neu(1) = den
    swView.ScaleRatio = neu
End Sub