Public Sub Zoom_11()
    ' Výpočet požadované šířky zorného pole kamery na základě velikosti okna
        Dim desiredModelScreenWidth As Double
        desiredModelScreenWidth = 120 ' Požadovaná šířka modelu na obrazovce v mm

        Dim screenDPI As Double
        screenDPI = 96 ' Předpokládáme DPI obrazovky 96 (změňte dle potřeby)
        
    ' Získání aktuálního dokumentu
    Dim oDoc As Document
    Set oDoc = ThisApplication.ActiveDocument

    ' Ověření, zda je dokument typu součást nebo sestava
    If oDoc.DocumentType = kPartDocumentObject Or oDoc.DocumentType = kAssemblyDocumentObject Then
        ' Získání aktivního pohledu
        Dim oView As View
        Set oView = ThisApplication.ActiveView

        ' Získání velikosti okna
        Dim clientWidth As Double
        Dim clientHeight As Double
        clientWidth = oView.width
        clientHeight = oView.height

        ' Získání kamery
        Dim oCamera As Camera
        Set oCamera = oView.Camera

        ' Uchování aktuálních hodnot Eye, Target a UpVector
        Dim currentEye As Point
        Set currentEye = oCamera.Eye

        Dim currentTarget As Point
        Set currentTarget = oCamera.Target

        Dim currentUpVector As UnitVector
        Set currentUpVector = oCamera.UpVector

        Dim windowInchesWidth As Double
        windowInchesWidth = clientWidth / screenDPI

        Dim scaleFactor As Double
        scaleFactor = desiredModelScreenWidth / windowInchesWidth

        Dim desiredWidth As Double
        desiredWidth = scaleFactor ' Zde nastavíme požadovanou šířku zorného pole v mm

        ' Výpočet požadované výšky zorného pole podle poměru stran okna
        Dim desiredHeight As Double
        desiredHeight = desiredWidth * (clientHeight / clientWidth)

        ' Nastavení extents kamery
        oCamera.Perspective = False
        oCamera.ApplyWithoutTransition

        ' Nastavení cílového bodu kamery na střed modelu
        Dim modelCenter As Point
        Dim oCompDef As ComponentDefinition
        If oDoc.DocumentType = kPartDocumentObject Then
            Set oCompDef = oDoc.ComponentDefinition
        ElseIf oDoc.DocumentType = kAssemblyDocumentObject Then
            Set oCompDef = oDoc.ComponentDefinition
        End If
        Dim oRangeBox As Box
        Set oRangeBox = oCompDef.RangeBox
        Set modelCenter = ThisApplication.TransientGeometry.CreatePoint((oRangeBox.MinPoint.X + oRangeBox.MaxPoint.X) / 2, (oRangeBox.MinPoint.Y + oRangeBox.MaxPoint.Y) / 2, (oRangeBox.MinPoint.Z + oRangeBox.MaxPoint.Z) / 2)
        oCamera.Target = modelCenter

        ' Výpočet nové pozice kamery (Eye) s ohledem na zachování vzdálenosti
        Dim directionVector As Vector
        Set directionVector = ThisApplication.TransientGeometry.CreateVector(currentEye.X - currentTarget.X, currentEye.Y - currentTarget.Y, currentEye.Z - currentTarget.Z)
        directionVector.Normalize
        directionVector.ScaleBy (desiredWidth / 2) ' nebo jiné měřítko podle potřeby

        Dim newEye As Point
        Set newEye = modelCenter
        Call newEye.TranslateBy(directionVector)
        oCamera.Eye = newEye

        ' Zachování aktuálního UpVector
        oCamera.UpVector = currentUpVector

        ' Nastavení zorného pole kamery
        oCamera.SetExtents desiredWidth, desiredHeight
        oCamera.Apply

        ' Znovu nastavení Eye a UpVector po aplikaci extents, aby se nezměnil úhel pohledu
        oCamera.Eye = newEye
        oCamera.UpVector = currentUpVector
        oCamera.Apply
    Else
        ' Zobrazení zprávy, pokud dokument není typu součást nebo sestava
        MsgBox "Tento skript lze použít pouze v prostředí návrhu modelu (součást nebo sestava).", vbExclamation, "Neplatný dokument"
    End If
End Sub