how to fix the coordinates of the lines?

Question

I have two lines - the first one is straight horizontal line with x1y1 as start point and x2y2 as end point. There is another line with start point as x1y1 and end point as x3y3.

lines without rotation

Is there any way that I can fix the coordinate x1y1 of the lines so that if I rotate the second line the point x1y1 is not detached?

lines after rotation

I tried grouping the lines but it didn't work.

Set p1 = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, x1, y1, x2, y2)
p1.Select
Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadOval
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadOval

Set p2 = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, x1, y1, x3, y3)
p2.Select
Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadOval
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadOval

Dim R As Variant
Set R = ActiveSheet.Shapes.Range(Array(p1.Name, p2.Name))
R.Group

I think you might have to make the second line twice as long so its midpoint is at x1y1 and then rotate around that midpoint. You can hide the top end by placing a white line on top of it. — SJR, Oct 26 '17 at 11:07
the lengths and the point x1y1 of both the line should not change when I rotate ...only the coordinate x2y2 should move at an angle... — Shahbaz Shaikh, Oct 26 '17 at 11:17
If I understand you correctly, you are asking if you can rotate the second line around its top end (x1y1). Is that right? If so, I don't think it's possible because you can see by testing that when you rotate a line it is rotated around it's midpoint. Hence, when you rotate the second line, the end at x1y1 will move. I suggested a workaround which is the only way I know, but others may have other ideas. — SJR, Oct 26 '17 at 11:29
exactly u got my point...there should some syntax to group the co-ordinates as we group the lines...if the starting point of line 1 and 2 are fixed then if I use rotation only the end point will move....so I need to figure out how can I fix the points.. — Shahbaz Shaikh, Oct 26 '17 at 11:32
Do you have the angle and you want the coordinate on point x3, y3? — danieltakeshi, Oct 26 '17 at 13:29
yes I hav the angle...if I give the angle for ex 10 degress to left it rotates from centre of the line...I want it should rotate from top of the line as the top point doesn't move — Shahbaz Shaikh, Oct 26 '17 at 14:17

danieltakeshi · Answer 1 · 2017-10-26T16:24:13.870

Problem and code

If I understood correctly, you want to input an angle and to obtain the coordinates of the point (x3,y3) to redraw a line.

The solution can be done on the coordinates x3 and y3, since, as @SJR said "Rotation is around the midpoint of the line". So you need to use geometry to do it.

Using the Law of Sines code on Math.Stackexchange answered by Jean Marie, the following code can be done:

'Initial Values
x1 = 100
y1 = 100
x2 = 300
y2 = 100
DesiredAngle = 45

'Find coordinates
Angle1 = Application.WorksheetFunction.Radians(DesiredAngle)
Angle2 = Application.WorksheetFunction.Radians((180 - DesiredAngle) / 2)
Deltax = x2 - x1
Deltay = y2 - y1
a3 = Sqr(Deltax ^ 2 + Deltay ^ 2)
Angle3 = Application.WorksheetFunction.Pi() - Angle1 - Angle2
a2 = a3 * Sin(Angle2) / Sin(Angle3)
RHS1 = x1 * Deltax + y1 * Deltay + a2 * a3 * Cos(Angle1)
RHS2 = y2 * Deltax - x2 * Deltay + a2 * a3 * Sin(Angle1)
x3 = (1 / a3 ^ 2) * (Deltax * RHS1 - Deltay * RHS2)
y3 = (1 / a3 ^ 2) * (Deltay * RHS1 + Deltax * RHS2)
Debug.Print x3 & " " & y3

'Draw Lines
Set Line1 = ActiveSheet.Shapes.AddLine(x1, y1, x2, y2)
Set Line2 = ActiveSheet.Shapes.AddLine(x1, y1, x3, y3)

'Verify angle to know if it worked
'Method1 to obtain angle of 3 points
alpha = Application.WorksheetFunction.Atan2((y2 - y1), (x2 - x1))
beta = Application.WorksheetFunction.Atan2((y3 - y1), (x3 - x1))
Debug.Print Application.WorksheetFunction.Degrees(beta - alpha)

'Method2
m1 = (y2 - y1) / (x2 - x1)
m2 = (y3 - y1) / (x3 - x1)
Debug.Print Application.WorksheetFunction.Degrees(Atn((m1 - m2) / (1 + m1 * m2)))

'Check Length
Debug.Print Sqr((x3 - x1) ^ 2 + (y3 - y1) ^ 2)

On the code, the example is that the initial value is a line as you drew and after inputting the DesiredAngle, a line is drawn with this angle, with the new x3 and y3 coordinates.

Result

On the Result, the example uses a DesiredAngle of 45°.

Further References

You can refer to many questions about this on Math.Stackexchange, like this, this, this.

EDIT:

To test it, you can make a simple For loop and check that a circle is made, i.e., the circle radius is the same length:

'Initial Values
x1 = 500
y1 = 300
x2 = 700
y2 = 300
For i = 1 To 360
    On Error Resume Next
    DesiredAngle = i
    'Find coordinates
    Angle1 = Application.WorksheetFunction.Radians(DesiredAngle)
    Angle2 = Application.WorksheetFunction.Radians((180 - DesiredAngle) / 2)
    Deltax = x2 - x1
    Deltay = y2 - y1
    a3 = Sqr(Deltax ^ 2 + Deltay ^ 2)
    Angle3 = Application.WorksheetFunction.Pi() - Angle1 - Angle2
    a2 = a3 * Sin(Angle2) / Sin(Angle3)
    RHS1 = x1 * Deltax + y1 * Deltay + a2 * a3 * Cos(Angle1)
    RHS2 = y2 * Deltax - x2 * Deltay + a2 * a3 * Sin(Angle1)
    x3 = (1 / a3 ^ 2) * (Deltax * RHS1 - Deltay * RHS2)
    y3 = (1 / a3 ^ 2) * (Deltay * RHS1 + Deltax * RHS2)
    Debug.Print x3 & " " & y3

    'Draw Lines
    Set Line1 = ActiveSheet.Shapes.AddLine(x1, y1, x2, y2)
    Set Line2 = ActiveSheet.Shapes.AddLine(x1, y1, x3, y3)

Next i

but the length of the line changes according to the angles...it should remain same only angle oh that line should change — Shahbaz Shaikh, Oct 26 '17 at 14:30
@ShahbazShaikh You will need to use geometry, Where the radius of the circle is equal, since the length is constant. Then you give an angle and get the new point y3 and x3. So you will have to program based on it. Give a try, research and post later your new code. — danieltakeshi, Oct 26 '17 at 18:22

how to fix the coordinates of the lines?

1 Answers1