Private Sub Command2_Click()
    
    Dim AcadApp As Object
    Dim AcDok As Object
    Dim Min, Max, AllMin, AllMax As Variant
    Dim AcSSet As Object
    Dim FilterType(0) As Integer
    Dim FilterData(0) As Variant
    Dim ScaleFactor As Double
    
    On Error Resume Next
    
    Set AcadApp = CreateObject("Autocad.Application")
    
    AcadApp.Visible = True
    
    pfad = "L:\temp\Zeichung.dwg"
    
    Set AcDok = AcadApp.ActiveDocument
    AcDok.Open (pfad)
    
    'On Error GoTo 0
    
    'Filter auf den Modellbereich setzen
    FilterType(0) = 67
    FilterData(0) = "0"
    
    'Erstelle Auswahlsatz "Alle"
    On Local Error Resume Next
    If TypeName(MyDrawing.SelectionSets("Auswahl")) = "Nothing" Then
      Set AcSSet = MyDrawing.SelectionSets.Add("Auswahl")
    Else
      Set AcSSet = MyDrawing.SelectionSets("Auswahl")
    End If
    AcSSet.Clear
    
    AcSSet.Select acSelectionSetAll, , , FilterType, FilterData
    
    'Schleife durch den Auswahlsatz für Maximalwerte
    For i = 0 To AcSSet.Count - 1
      AcSSet.Item(i).GetBoundingBox Min, Max
      If i = 0 Then
        AllMin = Min
        AllMax = Max
      Else
        If Min(0) < AllMin(0) Then AllMin(0) = Min(0)
        If Min(1) < AllMin(1) Then AllMin(1) = Min(1)
        If Max(0) > AllMax(0) Then AllMax(0) = Max(0)
        If Max(1) > AllMax(1) Then AllMax(1) = Max(1)
      End If
    Next i
    
    ScaleFactor = 5
    
    MsgBox "gleich wird verkleinert"
    
    'Alle Elemente skalieren
    For i = 0 To AcSSet.Count - 1
      AcSSet.Item(i).ScaleEntity AllMin, ScaleFactor
    Next i
    
    MsgBox "Fertig"
    
    AcDok.Save
    AcDok.Close
    
    MsgBox "wird neu erstellt"
        
    AcDok.Open