Attribute VB_Name = "Module2"
Global sSymbolName As String  'ist global definiert

Public Sub CreateAndInsertMyBorder()
    
    Dim oDrawDoc As DrawingDocument
    Set oDrawDoc = ThisApplication.ActiveDocument
    
    Dim oSheet As Sheet
    Set oSheet = oDrawDoc.ActiveSheet
    
    Dim oSheetOrientation As PageOrientationTypeEnum
    Dim oSheetSize As DrawingSheetSizeEnum
    Dim cSheetSize As String
    Dim oSheetWidth As Double
    Dim oSheetHeight As Double
    
    oSheetOrientation = oSheet.Orientation
    oSheetWidth = oSheet.Width
    oSheetHeight = oSheet.Height
    oSheetSize = oSheet.Size
    
    Dim oBorder As Border
    
    ' Obtain a reference to the desired border definition.
    Dim oBorderDef As BorderDefinition
    
    Dim sSheetSize As String
    sSymbolName = "Rahmen"
    sSheetSize = GetPropertyBlattgroesse(oSheet)
    If sSheetSize = "" Then sSheetSize = "user"
    sSymbolName = sSymbolName & "_" & sSheetSize
    
    If Not (Right(sSymbolName, 5) = "_user") Then
        If oSheet.Height >= oSheet.Width Then
            oSheet.Orientation = kPortraitPageOrientation
            sSymbolName = sSymbolName & "h"
        Else
            oSheet.Orientation = kLandscapePageOrientation
            sSymbolName = sSymbolName & "q"
        End If
    Else
        sSymbolName = sSymbolName & CStr(oSheetWidth) & "x" & CStr(oSheetHeight)
    End If
    
    Dim I As Integer
    For I = 1 To oDrawDoc.SketchedSymbolDefinitions.Count
        If oDrawDoc.SketchedSymbolDefinitions(I).Name = sSymbolName Then Exit Sub
    Next I
                
    Call InsertDefaultBorderOnSheet
    Call RemoveMyFrameFromSheet
    Call DeleteMyFrameDefinition
    Call CreateMyFrameDefinition
    Call InsertMyFrameOnSheet
        

End Sub


Public Sub InsertDefaultBorderOnSheet()

'   Fügt den Standardrahmen ein

    ' Setzt eine Referenz zur Zeichnungsableitung.
    ' Das setzt voraus, daß eine offen ist.
    Dim oDrawDoc As DrawingDocument
    Set oDrawDoc = ThisApplication.ActiveDocument
    
    Dim oSheet As Sheet
    Set oSheet = oDrawDoc.ActiveSheet
    
    ' Falls ein Rahmen existiert, diesen löschen.
    If Not oSheet.Border Is Nothing Then
        oSheet.Border.Delete
    End If
    
    '------------------------------------------------------------
    ' Blattgröße ermitteln
    '------------------------------------------------------------
    
    Dim oSheetOrientation As PageOrientationTypeEnum
    Dim oSheetSize As DrawingSheetSizeEnum
    Dim cSheetSize As String
    Dim oSheetWidth As Double
    Dim oSheetHeight As Double
    
    oSheetOrientation = oSheet.Orientation
    oSheetWidth = oSheet.Width
    oSheetHeight = oSheet.Height
    oSheetSize = oSheet.Size
    
    '-----------------------------
    ' Werte für den Rahmen setzen.
    '-----------------------------
    
    ' HorizontalZoneCount
    '       Optional
    '       Anzahl der horizontalen Zonen
    ' VerticalZoneCount
    '       Optional
    '       Anzahl der vertikalen Zonen
    
    Dim HorizontalZoneCount As Long
    Dim VerticalZoneCount As Long
    
    Select Case Fix(10 * oSheetWidth)
    Case Is = 210
        ' A4h
        HorizontalZoneCount = 4
        VerticalZoneCount = 6
    Case Is = 297
        If (oSheetHeight = 21) Then
        ' A4q
            HorizontalZoneCount = 6
            VerticalZoneCount = 4
        Else
        ' A3h
            HorizontalZoneCount = 6
            VerticalZoneCount = 8
        End If
     Case Is = 420
        If (oSheetHeight = 29.7) Then
        ' A3q
            HorizontalZoneCount = 8
            VerticalZoneCount = 6
        Else
        ' A2h
            HorizontalZoneCount = 8
            VerticalZoneCount = 12
        End If
    Case Is = 594
        If (oSheetHeight = 42) Then
        ' A2q
            HorizontalZoneCount = 12
            VerticalZoneCount = 8
        Else
        ' A1h
            HorizontalZoneCount = 12
            VerticalZoneCount = 16
        End If
    Case Is = 841
        If (oSheetHeight = 59.4) Then
        ' A1q
            HorizontalZoneCount = 16
            VerticalZoneCount = 12
        Else
        ' A0h
            HorizontalZoneCount = 16
            VerticalZoneCount = 24
        End If
    Case Is = 1189
        ' A0q
        HorizontalZoneCount = 24
        VerticalZoneCount = 16
    Case Else
        ' andere Formate
        HorizontalZoneCount = Int((oSheetWidth / 5) + 1) + Int((oSheetWidth / 5) + 1) Mod 2
        VerticalZoneCount = Int((oSheetHeight / 5) + 1) + Int((oSheetHeight / 5) + 1) Mod 2
        
    End Select
    
    ' HorizontalZoneLabelMode
    '   Optional
    '   Gültige Werte: kBorderLabelModeAlphabetical (alphabetisch),
    '                  kBorderLabelModeNumeric (nummerisch), and
    '                  kBorderLabelModeNone (kein).
    '
    '   Standard: kBorderLabelModeNumeric.
    '
    Dim HorizontalZoneLabelMode As BorderLabelModeEnum
    HorizontalZoneLabelMode = kBorderLabelModeNumeric
    
    ' VerticalZoneLabelMode
    '   Optional
    '   Gültige Werte: kBorderLabelModeAlphabetical (alphabetisch),
    '                  kBorderLabelModeNumeric (nummerisch), and
    '                  kBorderLabelModeNone (kein).
    '
    '   Standard: kBorderLabelModeAlphabetical.
    '
    Dim VerticalZoneLabelMode As BorderLabelModeEnum
    VerticalZoneLabelMode = kBorderLabelModeAlphabetical
    
    ' LabelFromBottomRight
    '   Optional
    '   Zonennummern sollen unten-rechts
    '   oder oben-links beginnen.
    '   True: unten-rechts
    '   False: oben-links
    '
    Dim LabelFromBottomRight As Boolean
    LabelFromBottomRight = False
    
    ' DelimitByLines
    '   Optional
    '   Zonenbegrenzungen als Linie oder Pfeilspitze
    '   True: Linie; False: Pfeilspitze
    '
    Dim DelimitByLines As Boolean
    DelimitByLines = True
    
    ' CenterMarks
    '   Optional
    '   Mittenmarkierung
    '   True: wird angezeigt
    '
    Dim CenterMarks As Boolean
    CenterMarks = True
    
    ' TopMargin
    '   Optional
    '   Abstand Blattrand-Rahmen oben
    '   Angabe in Zentimetern!
    '
    Dim TopMargin As Double
    TopMargin = 1
    
    ' BottomMargin
    '   Optional
    '   Abstand Blattrand-Rahmen unten
    '   Angabe in Zentimetern!
    '
    Dim BottomMargin As Double
    BottomMargin = 1
    
    ' LeftMargin
    '   Optional
    '   Abstand Blattrand-Rahmen links
    '   Angabe in Zentimetern!
    '
    Dim LeftMargin As Double
    LeftMargin = 2
    
    ' RightMargin
    '   Optional
    '   Abstand Blattrand-Rahmen rechts
    '   Angabe in Zentimetern!
    '
    Dim RightMargin As Double
    RightMargin = 1
    
    Dim oTextStyle As TextStyle
    Dim bFound As Boolean
    bFound = False
    
    'überprüfen, ob Textstil existiert
    For Each oTextStyle In oDrawDoc.StylesManager.TextStyles
        If oTextStyle.Name = "Rahmen_1" Then
            bFound = True
            Exit For
        End If
    Next
    
    If bFound Then
        Set oTextStyle = oDrawDoc.StylesManager.TextStyles.Item("Rahmen_1")
    Else
        ' nicht gefunden!
        MsgBox "TextStil Rahmen_1 fehlt!"
    End If
        
    Dim oTextLayer As Variant
    'oTextLayer =
    
    Dim oLineLayer As Variant
    
    '------------------------------------------------------------
    ' Rahmen zum Blatt hinzufügen
    '------------------------------------------------------------
    Dim oBorder As DefaultBorder
    Set oBorder = Nothing

    Set oBorder = oSheet.AddDefaultBorder(HorizontalZoneCount, _
                                              HorizontalZoneLabelMode, _
                                              VerticalZoneCount, _
                                              VerticalZoneLabelMode, _
                                              LabelFromBottomRight, _
                                              DelimitByLines, _
                                              CenterMarks, _
                                              TopMargin, _
                                              BottomMargin, _
                                              LeftMargin, _
                                              RightMargin _
                                              )
                                    
End Sub

Private Sub RemoveMyFrameFromSheet()

    Dim oDrawDoc As DrawingDocument
    Set oDrawDoc = ThisApplication.ActiveDocument
    Dim oSheet As Sheet
    Set oSheet = oDrawDoc.ActiveSheet
    
    ' Nachsehen, ob das Blatt schon einen Rahmen namens "Rahmen" hat und löschen.
    Dim I As Long
    For I = oSheet.SketchedSymbols.Count To 1 Step -1
        If Left(oSheet.SketchedSymbols.Item(I).Definition.Name, 6) = "Rahmen" Then
            oSheet.SketchedSymbols.Item(I).Delete
        End If
    Next I
    
End Sub

Sub DeleteMyFrameDefinition()
' Definitionen löschen, falls diese nicht benutzt werden
' Der Name beginnt mit "Rahmen"

    Dim I As Long
    Dim oDrawDoc As DrawingDocument
    Set oDrawDoc = ThisApplication.ActiveDocument
    
    On Error Resume Next
    For I = oDrawDoc.SketchedSymbolDefinitions.Count To 1 Step -1
    
        If Left(oDrawDoc.SketchedSymbolDefinitions.Item(I).Name, 6) = "Rahmen" Then
            oDrawDoc.SketchedSymbolDefinitions.Item(I).Delete
        End If
    
    Next I
    On Error GoTo 0

    Set oDrawDoc = Nothing

    
End Sub


Private Sub CreateMyFrameDefinition()
' Erzeugt ein skizziertes Symbol und fügt es in das aktuelle Blatt ein.
' Dieses Symbol ergänzt den Standard-Rahmen um weitere Elemente.
' Der Name besteht aus "Rahmen" und der Größe des Rahmens.

    Dim oDrawDoc As DrawingDocument
    Set oDrawDoc = ThisApplication.ActiveDocument
    
    '------------------------------------------------------------
    ' Blattgröße ermitteln
    '------------------------------------------------------------
    
    Dim oSheet As Sheet
    Set oSheet = oDrawDoc.ActiveSheet
  
    Dim oSheetOrientation As PageOrientationTypeEnum
    Dim oSheetSize As DrawingSheetSizeEnum
    Dim cSheetSize As String
    Dim oSheetWidth As Double
    Dim oSheetHeight As Double
    
    oSheetOrientation = oSheet.Orientation
    oSheetWidth = oSheet.Width
    oSheetHeight = oSheet.Height
    oSheetSize = oSheet.Size
    
    Dim sSheetSize As String
    sSymbolName = "Rahmen"
    sSheetSize = GetPropertyBlattgroesse(oSheet)
    If sSheetSize = "" Then sSheetSize = "user"
    sSymbolName = sSymbolName & "_" & sSheetSize
    
    If Not (Right(sSymbolName, 5) = "_user") Then
        If oSheet.Height >= oSheet.Width Then
            oSheet.Orientation = kPortraitPageOrientation
            sSymbolName = sSymbolName & "h"
        Else
            oSheet.Orientation = kLandscapePageOrientation
            sSymbolName = sSymbolName & "q"
        End If
    Else
        sSymbolName = sSymbolName & CStr(oSheetWidth) & "x" & CStr(oSheetHeight)
    End If
    
    ' Wenn das Sketched Symbol schon da ist, dann Absprung
    Dim I As Integer
    For I = 1 To oDrawDoc.SketchedSymbolDefinitions.Count
        If oDrawDoc.SketchedSymbolDefinitions(I).Name = sSymbolName Then Exit Sub
    Next I
      
    Dim oSSymbolDef As SketchedSymbolDefinition

    ' neue SymbolDefinition.
    Set oSSymbolDef = oDrawDoc.SketchedSymbolDefinitions.Add(sSymbolName)

    ' Öffnet die Skizze der SymbolDefinition zum editieren.
    Dim oSketch As DrawingSketch
    Call oSSymbolDef.Edit(oSketch)
    
    Dim oTG As TransientGeometry
    Set oTG = ThisApplication.TransientGeometry
    
    ' Rahmen ganz außen
    Call oSketch.SketchLines.AddAsTwoPointRectangle(oTG.CreatePoint2d(0, 0), oTG.CreatePoint2d(oSheetWidth, oSheetHeight))
    Call oSketch.SketchLines.AddAsTwoPointRectangle(oTG.CreatePoint2d(0.5, 0.5), oTG.CreatePoint2d(oSheetWidth - 0.5, oSheetHeight - 0.5))
    
    Dim dxKoord As Double
    Dim dyKoord As Double
    
    dxKoord = oSheetWidth
    dyKoord = oSheetHeight
    
    ' Faltmarken
    ' erst die vertikalen
    Select Case Fix(10 * oSheetWidth)
    Case Is = 297
        'A4 Portrait wird quer eingeheftet
        If Not (oSheetSize = kA4DrawingSheetSize Or oSheetSize = kA3DrawingSheetSize) Then
            dxKoord = oSheetWidth - 19
            Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(dxKoord, 0), oTG.CreatePoint2d(dxKoord, 0.5))
            Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(dxKoord, oSheetHeight - 0.5), oTG.CreatePoint2d(dxKoord, oSheetHeight))
            dxKoord = 2 + (oSheetWidth - 19 - 2) / 2
            Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(dxKoord, 0), oTG.CreatePoint2d(dxKoord, 0.5))
            Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(dxKoord, oSheetHeight - 0.5), oTG.CreatePoint2d(dxKoord, oSheetHeight))
        End If
    Case Is = 420
        dxKoord = 12.5
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(dxKoord, 0), oTG.CreatePoint2d(dxKoord, 0.5))
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(dxKoord, oSheetHeight - 0.5), oTG.CreatePoint2d(dxKoord, oSheetHeight))
        dxKoord = 12.5 + 10.5
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(dxKoord, 0), oTG.CreatePoint2d(dxKoord, 0.5))
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(dxKoord, oSheetHeight - 0.5), oTG.CreatePoint2d(dxKoord, oSheetHeight))
    Case Is = 594
        dxKoord = 21
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(dxKoord, 0), oTG.CreatePoint2d(dxKoord, 0.5))
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(dxKoord, oSheetHeight - 0.5), oTG.CreatePoint2d(dxKoord, oSheetHeight))
        dxKoord = 21 + 19.2
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(dxKoord, 0), oTG.CreatePoint2d(dxKoord, 0.5))
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(dxKoord, oSheetHeight - 0.5), oTG.CreatePoint2d(dxKoord, oSheetHeight))
    Case Is = 841
        dxKoord = 21
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(dxKoord, 0), oTG.CreatePoint2d(dxKoord, 0.5))
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(dxKoord, oSheetHeight - 0.5), oTG.CreatePoint2d(dxKoord, oSheetHeight))
        dxKoord = oSheetWidth - 19
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(dxKoord, 0), oTG.CreatePoint2d(dxKoord, 0.5))
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(dxKoord, oSheetHeight - 0.5), oTG.CreatePoint2d(dxKoord, oSheetHeight))
        dxKoord = oSheetWidth - 2 * 19
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(dxKoord, 0), oTG.CreatePoint2d(dxKoord, 0.5))
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(dxKoord, oSheetHeight - 0.5), oTG.CreatePoint2d(dxKoord, oSheetHeight))
        dxKoord = 21 + (oSheetWidth - 2 * 19 - 21) / 2
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(dxKoord, 0), oTG.CreatePoint2d(dxKoord, 0.5))
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(dxKoord, oSheetHeight - 0.5), oTG.CreatePoint2d(dxKoord, oSheetHeight))
    Case Is = 1189
        dxKoord = 21
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(dxKoord, 0), oTG.CreatePoint2d(dxKoord, 0.5))
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(dxKoord, oSheetHeight - 0.5), oTG.CreatePoint2d(dxKoord, oSheetHeight))
        dxKoord = oSheetWidth - 19
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(dxKoord, 0), oTG.CreatePoint2d(dxKoord, 0.5))
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(dxKoord, oSheetHeight - 0.5), oTG.CreatePoint2d(dxKoord, oSheetHeight))
        dxKoord = oSheetWidth - 2 * 19
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(dxKoord, 0), oTG.CreatePoint2d(dxKoord, 0.5))
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(dxKoord, oSheetHeight - 0.5), oTG.CreatePoint2d(dxKoord, oSheetHeight))
        dxKoord = oSheetWidth - 3 * 19
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(dxKoord, 0), oTG.CreatePoint2d(dxKoord, 0.5))
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(dxKoord, oSheetHeight - 0.5), oTG.CreatePoint2d(dxKoord, oSheetHeight))
        dxKoord = oSheetWidth - 4 * 19
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(dxKoord, 0), oTG.CreatePoint2d(dxKoord, 0.5))
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(dxKoord, oSheetHeight - 0.5), oTG.CreatePoint2d(dxKoord, oSheetHeight))
        dxKoord = 21 + (oSheetWidth - 4 * 19 - 21) / 2
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(dxKoord, 0), oTG.CreatePoint2d(dxKoord, 0.5))
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(dxKoord, oSheetHeight - 0.5), oTG.CreatePoint2d(dxKoord, oSheetHeight))
    Case Else
        ' für alle anderen Blattformate
        
    End Select
    
    ' dann die horizontalen
    Select Case Fix(10 * oSheetHeight)
    Case Is = 420
        If Not (oSheetSize = kA3DrawingSheetSize) Then
            dyKoord = 29.7
            Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(0, dyKoord), oTG.CreatePoint2d(0.5, dyKoord))
            Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(oSheetWidth - 0.5, dyKoord), oTG.CreatePoint2d(oSheetWidth, dyKoord))
        Else
            ' A3 Portrait wird quer gefaltet und eingeheftet
            dyKoord = 19
            Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(0, dyKoord), oTG.CreatePoint2d(0.5, dyKoord))
            Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(oSheetWidth - 0.5, dyKoord), oTG.CreatePoint2d(oSheetWidth, dyKoord))
            dyKoord = 19 + 10.5
            Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(0, dyKoord), oTG.CreatePoint2d(0.5, dyKoord))
            Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(oSheetWidth - 0.5, dyKoord), oTG.CreatePoint2d(oSheetWidth, dyKoord))
    End If
    Case Is = 594
        dyKoord = 29.7
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(0, dyKoord), oTG.CreatePoint2d(0.5, dyKoord))
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(oSheetWidth - 0.5, dyKoord), oTG.CreatePoint2d(oSheetWidth, dyKoord))
    Case Is = 841
        dyKoord = 29.7
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(0, dyKoord), oTG.CreatePoint2d(0.5, dyKoord))
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(oSheetWidth - 0.5, dyKoord), oTG.CreatePoint2d(oSheetWidth, dyKoord))
        dyKoord = 2 * 29.7
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(0, dyKoord), oTG.CreatePoint2d(0.5, dyKoord))
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(oSheetWidth - 0.5, dyKoord), oTG.CreatePoint2d(oSheetWidth, dyKoord))
    Case Is = 1189
        dyKoord = 29.7
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(0, dyKoord), oTG.CreatePoint2d(0.5, dyKoord))
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(oSheetWidth - 0.5, dyKoord), oTG.CreatePoint2d(oSheetWidth, dyKoord))
        dyKoord = 2 * 29.7
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(0, dyKoord), oTG.CreatePoint2d(0.5, dyKoord))
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(oSheetWidth - 0.5, dyKoord), oTG.CreatePoint2d(oSheetWidth, dyKoord))
        dyKoord = 3 * 29.7
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(0, dyKoord), oTG.CreatePoint2d(0.5, dyKoord))
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(oSheetWidth - 0.5, dyKoord), oTG.CreatePoint2d(oSheetWidth, dyKoord))
    Case Else
        ' für alle anderen Blattformate
        
    End Select
    
    ' die Eckenfaltung
    If Not (oSheetSize = kA4DrawingSheetSize Or oSheetSize = kA3DrawingSheetSize Or oSheetHeight <= 29.7 * 1.5 - 6) Then
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(0, 29.7), oTG.CreatePoint2d(0.5, 29.7 + (oSheetHeight - 29.7) / 10.5 * 0.5))
        Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(10.5, oSheetHeight), oTG.CreatePoint2d(10.5 - 10.5 / (oSheetHeight - 29.7) * 0.5, oSheetHeight - 0.5))
    End If
    
    Dim oNewLayer As Layer
    
    'Set oNewLayer = oDrawDoc.StylesManager.Layers.Item("Sketch Geometry (ANSI)").Copy("Custom Sketch Lines")
    
    On Error Resume Next
        Set oNewLayer = oDrawDoc.StylesManager.Layers.Item("Titel schmal (ISO)")
    On Error GoTo 0
    
    Dim oLayer As Layer
    Dim bLayerExists As Boolean
    bLayerExists = False
    For Each oLayer In oDrawDoc.StylesManager.Layers
        If oLayer.Name = "Rahmen (ISO)" Then
            bLayerExists = True
            Exit For
        End If
    Next
    
    If Not bLayerExists Then
        MsgBox "Layer >>Titel schmal (ISO)<< existiert nicht."
        Err.Clear
    Else
    
        ' Set the LineType on the new layer to 'dashed'.
        'oNewLayer.LineType = kDashedLineType
    
        Dim oSketchline As SketchLine
    
        'Put all the sketch circles on this layer
        Dim ii As Integer
        For ii = 1 To oSketch.SketchLines.Count
            oSketch.SketchLines(ii).Layer = oLayer
            oSketch.SketchLines(ii).LineWeight = 0.025
        Next ii
    
        ' Turn off the new layer
        'oNewLayer.Visible = True
    
    End If

    ' Einfügepunkt
    
    Call ConvertToInsertionPoint(oSketch.SketchPoints.Add( _
                 oTG.CreatePoint2d(0, 0)))
    
    Call oSSymbolDef.ExitEdit(True)


End Sub
Private Sub ConvertToInsertionPoint(oSketchPoint As SketchPoint)
    Dim oSelectSet As SelectSet
    Set oSelectSet = ThisApplication.ActiveDocument.SelectSet

    ' Programmatically select the sketch point
    Call oSelectSet.Select(oSketchPoint)

    ' Get the Inventor command that does the conversion
    Dim oControlDef As ControlDefinition
    Set oControlDef = ThisApplication.CommandManager.ControlDefinitions.Item("SketchInsertionPtCmd")

    'Execute the command
    oControlDef.Execute
End Sub


Sub InsertMyFrameOnSheet()

    Dim oDrawDoc As DrawingDocument
    Set oDrawDoc = ThisApplication.ActiveDocument
    
    Dim oSheet As Sheet
    Set oSheet = oDrawDoc.ActiveSheet
    
    Dim oTG As TransientGeometry
    Set oTG = ThisApplication.TransientGeometry
    
    On Error Resume Next
    Dim oMyFrame As SketchedSymbol
    Set oMyFrame = oSheet.SketchedSymbols.Add(sSymbolName, oTG.CreatePoint2d(0, 0))
    oMyFrame.Static = True
    On Error GoTo 0

End Sub


Sub PropertyBlattgroesseSetzen()

    Dim oDrawDoc As DrawingDocument
    Set oDrawDoc = ThisApplication.ActiveDocument
    Dim oSheet As Sheet
    Set oSheet = oDrawDoc.ActiveSheet
    
    Dim Blattgroesse As String
    
    Blattgroesse = GetPropertyBlattgroesse(oSheet)
    
    Dim EE_Da As Boolean
    Dim EE_Prop As Property
 
    '"Blattgroesse" vorhanden?
    EE_Da = False
    For Each EE_Prop In oDrawDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}") 'Benutzerdefiniert
        If EE_Prop.Name = "Blattgroesse" Then
            EE_Da = True
        Exit For
        End If
    Next
  
    ' Blattgroesse eintragen oder ändern
    If EE_Da Then
        oDrawDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Item("Blattgroesse").Value = Blattgroesse
    Else
        oDrawDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Add Blattgroesse, "Blattgroesse"
    End If
    
Ende:
    Set oSheet = Nothing
    Set oDrawDoc = Nothing
    
End Sub

Private Function GetPropertyBlattgroesse(oSheet) As String
        
        Dim Voreinstellung As String
        
        Select Case oSheet.Size
        
        Case Is = kA4DrawingSheetSize
            Voreinstellung = "A4"
        Case Is = kA3DrawingSheetSize
            Voreinstellung = "A3"
        Case Is = kA2DrawingSheetSize
            Voreinstellung = "A2"
        Case Is = kA1DrawingSheetSize
            Voreinstellung = "A1"
        Case Is = kA0DrawingSheetSize
            Voreinstellung = "A0"
            
        Case Is = kADrawingSheetSize
            Voreinstellung = "A"
        Case Is = kBDrawingSheetSize
            Voreinstellung = "B"
        Case Is = kCDrawingSheetSize
            Voreinstellung = "C"
        Case Is = kDDrawingSheetSize
            Voreinstellung = "D"
        Case Is = kEDrawingSheetSize
            Voreinstellung = "E"
        Case Is = kFDrawingSheetSize
            Voreinstellung = "F"
            
        Case Else
            Voreinstellung = ""
        End Select
        
        
        GetPropertyBlattgroesse = Voreinstellung

End Function

Sub dummy()
End Sub