CODEWITHSUNDEEP
vbaexcel
Shahbaz Shaikh
Shahbaz Shaikh

Reputation: 21

how to fix the coordinates of the lines?

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

Upvotes: 2

Views: 593

Answers (1)

danieltakeshi
danieltakeshi

Reputation: 939

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°.

Result

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

Upvotes: 1

Related Questions