vba - 如何固定线的坐标？

Question

我有两条线-第一条是水平直线，x1y1作为起点和x2y2作为终点。还有另一条线的起点为x1y1和终点为x3y3 .



有什么办法可以修复坐标x1y1的线条，这样如果我旋转第二条线点x1y1是不是超然？



我尝试将线条分组，但没有奏效。

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

Answer 1

问题和代码

如果我理解正确，您想输入一个角度并获取点 (x3,y3) 的坐标以重画一条线。

该解决方案可以在坐标 x3 和 y3 上完成，因为正如@SJR 所说“旋转围绕直线的中点”。所以你需要使用几何来做到这一点。

使用 Law of Sines code on Math.Stackexchange回答者 Jean Marie ，可以完成以下代码:

'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)

在代码中，示例是初始值是您绘制的一条线，在输入 DesiredAngle 之后，用这个角度绘制一条线，使用新的 x3 和 y3 坐标。

结果

在结果中，示例使用 DesiredAngle 45°。



更多引用资料

您可以在 Math.Stackexchange 上引用许多关于此的问题，例如 this , this , this .

编辑:

要对其进行测试，您可以创建一个简单的 For 循环并检查是否制作了一个圆，即圆的半径是相同的长度:

'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