Absturz bei intelligenter Füllung

[koter]

Hallo Wolfgang,

Das folgende Makro flickt an jede offene Kurve ein Stück an. Die angeflickten Stücke landen auf der Ebene „Flickebene“ die man nach Gebrauch löschen kann.

Code:

Sub anflicken()
   Dim s1 As Shape, s2 As New Shape, zForm As New Shape
   Dim n1 As Node, n2 As Node
   Dim Flickebene As New Layer
   Dim sr As ShapeRange
   Dim seg As Segment, segVor As Segment, segNach As Segment
   Dim L As Double, k1x As Double, k1y As Double, k2x As Double, k2y As Double
   ActiveDocument.Unit = cdrMillimeter
   On Error GoTo weiter
   
   L = 3
       
   Set sr = ActivePage.Shapes.FindShapes(Type:=cdrCurveShape)
   Set sr = sr.Shapes.FindShapes(Query:="@com.curve.closed = false")
   
   ActiveDocument.BeginCommandGroup "Flickebene"
   Application.Optimization = True
   Set Flickebene = ActivePage.CreateLayer("Flickebene")
   For Each s1 In sr
       k1x = s1.Curve.Nodes.First.PositionX
       k1y = s1.Curve.Nodes.First.PositionY
       k2x = s1.Curve.Nodes.Last.PositionX
       k2y = s1.Curve.Nodes.Last.PositionY
       
       Set n1 = s1.Curve.Nodes.First
       Set n2 = s1.Curve.Nodes.Last
       Set segVor = n2.PrevSegment
       Set segNach = n1.NextSegment
       Set s2 = ActiveVirtualLayer.CreateLineSegment(k1x, k1y, k1x, k1y + L)
       s2.RotateEx segNach.StartingControlPointAngle + 90, k1x, k1y
       ActiveDocument.LogCreateShape s2
       Set s2 = ActiveVirtualLayer.CreateLineSegment(k2x, k2y, k2x, k2y + L)
       s2.RotateEx segVor.EndingControlPointAngle + 90, k2x, k2y
       ActiveDocument.LogCreateShape s2
   Next
weiter:
   Application.Optimization = False
   ActiveDocument.EndCommandGroup
   ActiveSelectionRange.Shapes.All.RemoveFromSelection
   ActiveWindow.Refresh
End Sub

Die Länge der angeflickten Linien kann über die Variable „L“ eingestellt werden. Sie steht hier auf 3mm, das wird für Dich zu lang sein. 

Das Makro basiert auf Norres Idee mit den Pfeilspitzen, nur das es keine Flächen sondern Linien produziert.
Ich bin allerdings skeptisch. Das ist bestimmt kein „professionelles Makro“ und ob es wirklich den erhofften Zweck erfüllt kann ich nicht vorhersagen.

Gruß

Koter