Ausrichten an Strecke

[koter]

Hallo Boerni,

zum Ausrichten von Objekten an einer Strecke kannst Du auch dieses Makro nehmen:

Code:

Sub AnStreckeAusrichten2()
   Dim Objekte As ShapeRange
   Dim Strecke As Shape
   Dim C As Curve
   Dim SP As SubPath
   Dim w As Double, ofs As Double, m As Double, x As Double, y As Double
   Dim Anz As Integer, i As Integer
   On Error GoTo ende
   
   Set Objekte = ActiveSelectionRange
   Set Strecke = Objekte.Shapes.First
   Objekte.Remove 1
   
   Objekte.Sort " @shape1.Top * 100 - @shape1.Left > @shape2.Top * 100 - @shape2.Left"
   Anz = Objekte.Count
   Set C = Strecke.Curve
   m = 1
   If C.Closed Then m = 0
   Set SP = C.SubPaths.First
   ofs = 0
   ActiveDocument.BeginCommandGroup "An Strecke Ausrichten"
   For i = 1 To Anz
       SP.GetPointPositionAt x, y, ofs
       w = SP.GetPerpendicularAt(ofs) - 90
       Objekte(i).CenterX = x
       Objekte(i).CenterY = y
       Objekte(i).RotationAngle = w
       ofs = 1 / (Anz - m) * i
   Next i
ende:
   ActiveDocument.EndCommandGroup
End Sub

Du musst erst die Objekte markieren und dann mit gedrückter Umschalttaste die Strecke. Dann das Makro ausführen. 

Das Makro ist mit X7 erstellt. Falls es bei Dir nicht funktioniert oder Du noch Änderungen brauchst, gib Bescheid.

Ich habe Dein großzügiges Angebot aus dem von Dir zitierten Beitrag gelesen. Vielen Dank dafür!
Leider bin ich davon abgekommen, darauf zu reagieren.

Weil das Makro ein „Abfallprodukt“ eines anderen Makros war, wäre es reichlich überbezahlt, wenn ich das Angebot annehmen würde.

Gruß

Koter