如何修复线条的坐标?

时间:2017-10-26 10:53:07

标签: vba excel-vba excel

我有两行 - 第一行是直线水平线,x1y1为起点,x2y2为终点。另一行的起点为x1y1,终点为x3y3

lines without rotation

有没有办法可以修复线条的x1y1坐标,这样如果我旋转第二条线就不会分离点x1y1

lines after rotation

我尝试对线路进行分组,但它没有用。

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

1 个答案:

答案 0 :(得分: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坐标。

<强>结果

在结果上,该示例使用45°的DesiredAngle

Result

进一步参考

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

修改

要测试它,你可以做一个简单的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