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.14159265358979here: os(1).Rotate k * myangleEnd Sub
Awesome thanks. Sending a pm
You are welcome.
Kindly note that line 5 has changed (added ": Exit Sub")
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 Else shapeNeedsRotating = True End If Else 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
Atn ((y2 - y1) / (x2 - x1)) ....I think this solves a problem I've been thinking about all week.
Thanks