Sub Zentrierung_links_332()

Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveDocument
    
Dim oSheet As Sheet
Set oSheet = oDrawDoc.ActiveSheet

Dim oSketches As DrawingSketches
Set oSketches = ThisDocument.ActiveSheet.Sketches
oSketches.Add

Dim oSketch As DrawingSketch
Set oSketch = oSketches.Item(1)
oSketch.Edit

Dim oTransGeom As TransientGeometry
Set oTransGeom = ThisApplication.TransientGeometry
    'Zentrierung
Dim oPoint(1 To 70) As Point2d
Set oPoint(1) = oTransGeom.CreatePoint2d(0, 0)
Set oPoint(2) = oTransGeom.CreatePoint2d(0, 0.7)
Set oPoint(3) = oTransGeom.CreatePoint2d(0.3, 1.3)
Set oPoint(4) = oTransGeom.CreatePoint2d(1.1, 1.7)
Set oPoint(5) = oTransGeom.CreatePoint2d(2.1, 1.7)
Set oPoint(6) = oTransGeom.CreatePoint2d(2.4, 2)
Set oPoint(7) = oTransGeom.CreatePoint2d(7.7, 2)
Set oPoint(8) = oTransGeom.CreatePoint2d(8.2, 3)
Set oPoint(9) = oTransGeom.CreatePoint2d(7.7, 4)
Set oPoint(10) = oTransGeom.CreatePoint2d(2.4, 4)
Set oPoint(11) = oTransGeom.CreatePoint2d(2.1, 4.3)
Set oPoint(12) = oTransGeom.CreatePoint2d(1.1, 4.3)
Set oPoint(13) = oTransGeom.CreatePoint2d(0.3, 4.7)
Set oPoint(14) = oTransGeom.CreatePoint2d(0, 5.2)
Set oPoint(15) = oTransGeom.CreatePoint2d(0, 6)
Set oPoint(16) = oTransGeom.CreatePoint2d(2.2, 1.8)
Set oPoint(17) = oTransGeom.CreatePoint2d(5.8, 1.8)
Set oPoint(18) = oTransGeom.CreatePoint2d(2.2, 4.2)
Set oPoint(19) = oTransGeom.CreatePoint2d(5.8, 4.2)
Set oPoint(20) = oTransGeom.CreatePoint2d(-0.2, 3)
Set oPoint(21) = oTransGeom.CreatePoint2d(8.4, 3)
Set oPoint(22) = oTransGeom.CreatePoint2d(9, 6)
    'Schraffur
Set oPoint(23) = oTransGeom.CreatePoint2d(0.2, 6)
Set oPoint(24) = oTransGeom.CreatePoint2d(0, 5.8)
Set oPoint(25) = oTransGeom.CreatePoint2d(1.1, 6)
Set oPoint(26) = oTransGeom.CreatePoint2d(0.1125, 5.0125)
Set oPoint(27) = oTransGeom.CreatePoint2d(2, 6)
Set oPoint(28) = oTransGeom.CreatePoint2d(0.5667, 4.5667)
Set oPoint(29) = oTransGeom.CreatePoint2d(2.9, 6)
Set oPoint(30) = oTransGeom.CreatePoint2d(1.2, 4.3)
Set oPoint(31) = oTransGeom.CreatePoint2d(3.8, 6)
Set oPoint(32) = oTransGeom.CreatePoint2d(2.1, 4.3)
Set oPoint(33) = oTransGeom.CreatePoint2d(4.7, 6)
Set oPoint(34) = oTransGeom.CreatePoint2d(2.7, 4)
Set oPoint(35) = oTransGeom.CreatePoint2d(5.6, 6)
Set oPoint(36) = oTransGeom.CreatePoint2d(3.6, 4)
Set oPoint(37) = oTransGeom.CreatePoint2d(6.5, 6)
Set oPoint(38) = oTransGeom.CreatePoint2d(4.5, 4)
Set oPoint(39) = oTransGeom.CreatePoint2d(7.4, 6)
Set oPoint(40) = oTransGeom.CreatePoint2d(5.4, 4)
Set oPoint(41) = oTransGeom.CreatePoint2d(8.3, 6)
Set oPoint(42) = oTransGeom.CreatePoint2d(6.3, 4)
Set oPoint(43) = oTransGeom.CreatePoint2d(9, 5.8)
Set oPoint(44) = oTransGeom.CreatePoint2d(7.2, 4)
Set oPoint(45) = oTransGeom.CreatePoint2d(9, 4.9)
Set oPoint(46) = oTransGeom.CreatePoint2d(7.8333, 3.7333)
Set oPoint(47) = oTransGeom.CreatePoint2d(9, 4)
Set oPoint(48) = oTransGeom.CreatePoint2d(8.1333, 3.1333)
Set oPoint(49) = oTransGeom.CreatePoint2d(9, 3.1)
Set oPoint(50) = oTransGeom.CreatePoint2d(5.9, 0)
Set oPoint(51) = oTransGeom.CreatePoint2d(9, 2.2)
Set oPoint(52) = oTransGeom.CreatePoint2d(6.8, 0)
Set oPoint(53) = oTransGeom.CreatePoint2d(9, 1.3)
Set oPoint(54) = oTransGeom.CreatePoint2d(7.7, 0)
Set oPoint(55) = oTransGeom.CreatePoint2d(9, 0.4)
Set oPoint(56) = oTransGeom.CreatePoint2d(8.6, 0)
Set oPoint(57) = oTransGeom.CreatePoint2d(7, 2)
Set oPoint(58) = oTransGeom.CreatePoint2d(5, 0)
Set oPoint(59) = oTransGeom.CreatePoint2d(6.1, 2)
Set oPoint(60) = oTransGeom.CreatePoint2d(4.1, 0)
Set oPoint(61) = oTransGeom.CreatePoint2d(5.2, 2)
Set oPoint(62) = oTransGeom.CreatePoint2d(3.2, 0)
Set oPoint(63) = oTransGeom.CreatePoint2d(4.3, 2)
Set oPoint(64) = oTransGeom.CreatePoint2d(2.3, 0)
Set oPoint(65) = oTransGeom.CreatePoint2d(3.4, 2)
Set oPoint(66) = oTransGeom.CreatePoint2d(1.4, 0)
Set oPoint(67) = oTransGeom.CreatePoint2d(2.5, 2)
Set oPoint(68) = oTransGeom.CreatePoint2d(0.5, 0)
Set oPoint(69) = oTransGeom.CreatePoint2d(1.3, 1.7)
Set oPoint(70) = oTransGeom.CreatePoint2d(0, 0.4)
    'Zentrierung
Dim oLine(1 To 46) As SketchLine
Set oLine(1) = oSketch.SketchLines.AddByTwoPoints(oPoint(1), oPoint(15))
Set oLine(2) = oSketch.SketchLines.AddByTwoPoints(oPoint(2), oPoint(3))
Set oLine(3) = oSketch.SketchLines.AddByTwoPoints(oPoint(3), oPoint(4))
Set oLine(4) = oSketch.SketchLines.AddByTwoPoints(oPoint(4), oPoint(5))
Set oLine(5) = oSketch.SketchLines.AddByTwoPoints(oPoint(5), oPoint(6))
Set oLine(6) = oSketch.SketchLines.AddByTwoPoints(oPoint(6), oPoint(7))
Set oLine(7) = oSketch.SketchLines.AddByTwoPoints(oPoint(7), oPoint(8))
Set oLine(8) = oSketch.SketchLines.AddByTwoPoints(oPoint(8), oPoint(9))
Set oLine(9) = oSketch.SketchLines.AddByTwoPoints(oPoint(9), oPoint(10))
Set oLine(10) = oSketch.SketchLines.AddByTwoPoints(oPoint(10), oPoint(11))
Set oLine(11) = oSketch.SketchLines.AddByTwoPoints(oPoint(11), oPoint(12))
Set oLine(12) = oSketch.SketchLines.AddByTwoPoints(oPoint(12), oPoint(13))
Set oLine(13) = oSketch.SketchLines.AddByTwoPoints(oPoint(13), oPoint(14))
Set oLine(14) = oSketch.SketchLines.AddByTwoPoints(oPoint(3), oPoint(13))
Set oLine(15) = oSketch.SketchLines.AddByTwoPoints(oPoint(4), oPoint(12))
Set oLine(16) = oSketch.SketchLines.AddByTwoPoints(oPoint(5), oPoint(11))
Set oLine(17) = oSketch.SketchLines.AddByTwoPoints(oPoint(6), oPoint(10))
Set oLine(18) = oSketch.SketchLines.AddByTwoPoints(oPoint(7), oPoint(9))
Set oLine(19) = oSketch.SketchLines.AddByTwoPoints(oPoint(16), oPoint(17))
Set oLine(20) = oSketch.SketchLines.AddByTwoPoints(oPoint(17), oPoint(19))
Set oLine(21) = oSketch.SketchLines.AddByTwoPoints(oPoint(18), oPoint(19))
Set oLine(22) = oSketch.SketchLines.AddByTwoPoints(oPoint(20), oPoint(21))
    'Schraffur
Set oLine(23) = oSketch.SketchLines.AddByTwoPoints(oPoint(23), oPoint(24))
Set oLine(24) = oSketch.SketchLines.AddByTwoPoints(oPoint(25), oPoint(26))
Set oLine(25) = oSketch.SketchLines.AddByTwoPoints(oPoint(27), oPoint(28))
Set oLine(26) = oSketch.SketchLines.AddByTwoPoints(oPoint(29), oPoint(30))
Set oLine(27) = oSketch.SketchLines.AddByTwoPoints(oPoint(31), oPoint(32))
Set oLine(28) = oSketch.SketchLines.AddByTwoPoints(oPoint(33), oPoint(34))
Set oLine(29) = oSketch.SketchLines.AddByTwoPoints(oPoint(35), oPoint(36))
Set oLine(30) = oSketch.SketchLines.AddByTwoPoints(oPoint(37), oPoint(38))
Set oLine(31) = oSketch.SketchLines.AddByTwoPoints(oPoint(39), oPoint(40))
Set oLine(32) = oSketch.SketchLines.AddByTwoPoints(oPoint(41), oPoint(42))
Set oLine(33) = oSketch.SketchLines.AddByTwoPoints(oPoint(43), oPoint(44))
Set oLine(34) = oSketch.SketchLines.AddByTwoPoints(oPoint(45), oPoint(46))
Set oLine(35) = oSketch.SketchLines.AddByTwoPoints(oPoint(47), oPoint(48))
Set oLine(36) = oSketch.SketchLines.AddByTwoPoints(oPoint(49), oPoint(50))
Set oLine(37) = oSketch.SketchLines.AddByTwoPoints(oPoint(51), oPoint(52))
Set oLine(38) = oSketch.SketchLines.AddByTwoPoints(oPoint(53), oPoint(54))
Set oLine(39) = oSketch.SketchLines.AddByTwoPoints(oPoint(55), oPoint(56))
Set oLine(40) = oSketch.SketchLines.AddByTwoPoints(oPoint(57), oPoint(58))
Set oLine(41) = oSketch.SketchLines.AddByTwoPoints(oPoint(59), oPoint(60))
Set oLine(42) = oSketch.SketchLines.AddByTwoPoints(oPoint(61), oPoint(62))
Set oLine(43) = oSketch.SketchLines.AddByTwoPoints(oPoint(63), oPoint(64))
Set oLine(44) = oSketch.SketchLines.AddByTwoPoints(oPoint(65), oPoint(66))
Set oLine(45) = oSketch.SketchLines.AddByTwoPoints(oPoint(67), oPoint(68))
Set oLine(46) = oSketch.SketchLines.AddByTwoPoints(oPoint(69), oPoint(70))
    'Mitellinie
oSketch.SketchLines(22).LineType = kDashDottedLineType
oSketch.SketchLines(22).LineScale = 7

oSketch.ExitEdit
    'Bemaßung
Dim oDrawingDim As DrawingDimensions
Set oDrawingDim = oSheet.DrawingDimensions

Dim oDrawDim(1 To 10) As DrawingDimension

End Sub