VBA to rotate an open curve so that the end nodes are perfectly aligned along a horizontal plane

Parents
  • Sub Macro1()
    Dim n As Node, x1 As Double, y1 As Double, x2 As Double, y2 As Double, os As ShapeRange
    ActiveDocument.Unit = cdrMillimeter
    Set os = ActiveSelectionRange
    If os.Count <> 1 Then MsgBox ("Select one shape and run macro again!"): Exit Sub
    ActiveShape.Curve.Nodes.First.GetPosition x1, y1
    ActiveShape.Curve.Nodes.Last.GetPosition x2, y2
    If x2 <> x1 Then k = -1 Else myangle = -90: GoTo here:
    With os(1)
    .RotationCenterX = x1
    .RotationCenterY = y1
    End With
    myangle = Atn((y2 - y1) / (x2 - x1)) * 180 / 3.14159265358979
    here:
    os(1).Rotate k * myangle
    End Sub

Reply Children