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

  • God damn it Mek! A lovely bit of code right there sir!

    Beat me to the post and much better than my dunderhead approach of using reference shapes and 'GetPerpendicularAt'.

     Well, I've written it now and at least it shows the power of using math over brute force!

    Sub AlignSubpathEndsArc()
        If ActiveShape Is Nothing Then Exit Sub
        Dim startSh As Shape
            Set startSh = ActiveSelectionRange(1)
            If startSh.Curve.SubPaths.Count > 1 Then Exit Sub
            If startSh.Curve.SubPaths.First.Closed = True Then Exit Sub
        Dim tolerance#: tolerance = 0.01
        Dim startNode As Node, endNode As Node
            Set startNode = startSh.Curve.Nodes.First
            Set endNode = startSh.Curve.Nodes.Last
        Dim startNodeX#, startNodeY#
            startNodeX = startNode.PositionX
            startNodeY = startNode.PositionY
        Dim endNodeX#, endNodeY#
            endNodeX = endNode.PositionX
            endNodeY = endNode.PositionY
        Dim shapeNeedsRotating As Boolean
            If Abs(startNodeY - startNodeY) > tolerance Then 'then Nodes are not aligned horizontally
                If Abs(endNodeX - startNodeX) < tolerance Then
                    startSh.Rotate 90 'Nodes are apart and near vertical aliengment
                    shapeNeedsRotating = False
                    shapeNeedsRotating = True
                End If
                shapeNeedsRotating = True
            End If
        Dim refLine As Shape, refCircle As Shape, refHorizonLine As Shape
        Dim horizonAngle#, lineAngle#
        Dim rotAmount#
            If shapeNeedsRotating = True Then
                startSh.SetRotationCenter startNodeX, startNodeY
                Set refLine = ActiveLayer.CreateLineSegment(startNodeX, startNodeY, endNodeX, endNodeY): refLine.Outline.Color.CMYKAssign 0, 100, 0, 0
                Set refCircle = ActiveLayer.CreateEllipse2(startNodeX, startNodeY, refLine.Curve.Length, refLine.Curve.Length): refCircle.Outline.Color.CMYKAssign 0, 100, 0, 0
                Set refHorizonLine = ActiveLayer.CreateLineSegment(refCircle.LeftX, refCircle.CenterY, refCircle.RightX, refCircle.CenterY): refHorizonLine.Outline.Color.CMYKAssign 100, 0, 0, 0
                horizonAngle = refHorizonLine.Curve.Segments.First.GetPerpendicularAt(0.5)
                lineAngle = refLine.Curve.Segments.First.GetPerpendicularAt(0.5)
                rotAmount = horizonAngle - lineAngle
                startSh.Rotate rotAmount
            End If
    End Sub
Reply Children
No Data