Debugger писал(а):Таких дуги две, кстати.
Mikle писал(а):Debugger писал(а):Таких дуги две, кстати.
Кстати, четыре.
Sirik писал(а):Вообще-то она одна, так как в моем частном случае надо чертить только против часовой стрелке.
Sirik писал(а):Ну вот на примере что я выше показал, как можно еще по другому прийти от красной точке к зеленой? Если надо "идти" с опр радиусом и против часовой стрелке. Я просто не могу понять откуда появилась еще одна окружность
dX = X1 - X2
dX = 200 - 140 = 60 ( > 0 )
dX = 140 - 200 = -60 ( < 0 )
R Method Example 2 писал(а):If we want the arc with the longer arc length, we use a -R value (since -R does not already have a valid meaning)
A [x1, y1]
B [x2, y2]
R
C = {(x1+x2)/2, (y1+y2)/2 }
l = sqrt((x2-x1)^2 + (y2-y1)^2) - длина вектора AB
q = [y2 - y1, x1 - x2] - повернутый вектор AB
qnorm = q / l - нормированный повернутый вектор AB
h = sqrt(R^2 - (l/2)^2)
O {C.x + qnorm.x*h, C.y + qnorm.y*h}
O.x = (x1+x2)/2 + (y2 - y1)*sqrt(R^2 - (l/2)^2)/l
O.y = (y1+y2)/2 + (x1 - x2)*sqrt(R^2 - (l/2)^2)/l
pronto писал(а):Или мне выложить код для нахождения пересечения окружностей?
pronto писал(а):since -R does not already have a valid meaning
с этого момента -R не имеет верного смысла
A1 = 2 * cx1: A2 = 2 * cx2
B1 = 2 * cy1: B2 = 2 * cy2
C1 = cx1 ^ 2 + cy1 ^ 2 - r1 ^ 2
C2 = cx2 ^ 2 + cy2 ^ 2 - r2 ^ 2
M = 1 + ((B1 - B2) / (A2 - A1)) ^ 2
N = ((2 * (C2 - C1) * (B1 - B2)) / (A2 - A1) ^ 2) - B1 + A1 * ((B2 - B1) / (A2 - A1))
q = C1 + ((C2 - C1) / (A2 - A1)) ^ 2 + A1 * ((C1 - C2) / (A2 - A1))
D = N * N - 4 * M * q
If D >= 0 Then 'окружности пересекаются в двух, либо одной точке
y1 = (-N + Sqr(D)) / (2 * M)
y2 = (-N - Sqr(D)) / (2 * M)
End If
M = 1 + ((A1 - A2) / (B2 - B1)) ^ 2
N = ((2 * (C2 - C1) * (A1 - A2)) / (B2 - B1) ^ 2) - A1 + B1 * ((A2 - A1) / (B2 - B1))
q = C1 + ((C2 - C1) / (B2 - B1)) ^ 2 + B1 * ((C1 - C2) / (B2 - B1))
H = N * N - 4 * M * q
If H >= 0 Then 'окружности пересекаются в двух, либо одной точке
x1 = (-N + Sqr(H)) / (2 * M)
x2 = (-N - Sqr(H)) / (2 * M)
End If
If cx2 < cx1 And cy2 > cy1 Then 'для второй окружности, находящейся в третей четверти
Picture.Circle (x1, y1), 3
Picture.Circle (x2, y2), 3
ElseIf cx2 > cx1 And cy2 < cy1 Then 'для второй окружности, находящейся в первой четверти
Picture.Circle (x1, y1), 3
Picture.Circle (x2, y2), 3
Else
Picture.Circle (x2, y1), 3
Picture.Circle (x1, y2), 3
End If
Option Explicit
Private Type Vec
X As Single
Y As Single
End Type
Dim pt(2) As Vec, cur As Long
Private Function GetCircle(p1 As Vec, p2 As Vec, p3 As Vec, r As Single, c As Vec) As Boolean
Dim m1 As Single, m2 As Single
If p2.X = p1.X Or p3.X = p2.X Then Exit Function
m1 = (p2.Y - p1.Y) / (p2.X - p1.X)
m2 = (p3.Y - p2.Y) / (p3.X - p2.X)
If m2 = m1 Then Exit Function
c.X = (m1 * m2 * (p1.Y - p3.Y) + m2 * (p1.X + p2.X) - m1 * (p2.X + p3.X)) / (2 * (m2 - m1))
c.Y = -(1 / m1) * (c.X - (p1.X + p2.X) / 2) + (p1.Y + p2.Y) / 2
m1 = p1.X - c.X: m2 = p1.Y - c.Y
r = Sqr(m1 * m1 + m2 * m2)
GetCircle = True
End Function
Private Sub Form_Load()
Me.AutoRedraw = True: Me.ScaleMode = vbPixels
Me.Move (Screen.Width - 8000) \ 2, (Screen.Height - 8000) \ 2, 8000, 8000
Me.BackColor = vbWhite: Me.ForeColor = vbBlack
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If cur = 0 Then Me.Cls
Me.Line (X - 2, Y - 2)-(X + 2, Y + 2), vbRed, B: Print cur + 1
pt(cur).X = X: pt(cur).Y = Y
cur = cur + 1
If cur > 2 Then cur = 0
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If cur = 2 Then pt(2).X = X: pt(2).Y = Y: Draw
End Sub
Private Sub Draw()
Dim a As Single, b As Single, _
s As Single, e As Single, _
q As Single, c As Vec, r As Single
If Not GetCircle(pt(0), pt(1), pt(2), r, c) Then Exit Sub
a = -(pt(0).Y - c.Y) * r: b = (pt(0).X - c.X) * r: s = Atan2(a, b)
a = -(pt(1).Y - c.Y) * r: b = (pt(1).X - c.X) * r: e = Atan2(a, b)
a = -(pt(2).Y - c.Y) * r: b = (pt(2).X - c.X) * r: q = Atan2(a, b)
If e < 0 Then e = 6.28318530717959 + e
If s < 0 Then s = 6.28318530717959 + s
If q < 0 Then q = 6.28318530717959 + q
If s > e Then a = s: s = e: e = a
If q < s Or q > e Then a = s: s = e: e = a
Debug.Print s, e, q
Me.Cls
Circle (c.X, c.Y), r, , s, e
Me.Line (pt(0).X - 2, pt(0).Y - 2)-(pt(0).X + 2, pt(0).Y + 2), vbRed, B: Print 1
Me.Line (pt(1).X - 2, pt(1).Y - 2)-(pt(1).X + 2, pt(1).Y + 2), vbRed, B: Print 2
Me.Line (pt(2).X - 2, pt(2).Y - 2)-(pt(2).X + 2, pt(2).Y + 2), vbRed, B
Me.Refresh
End Sub
Private Function Atan2(ByVal Y As Double, ByVal X As Double) As Double 'Возвращает угол, тангенс которого равен отношению двух указанных чисел
If Y > 0 Then
If X >= Y Then
Atan2 = Atn(Y / X)
ElseIf X <= -Y Then
Atan2 = Atn(Y / X) + 3.14159265358979
Else
Atan2 = 3.14159265358979 / 2 - Atn(X / Y)
End If
Else
If X >= -Y Then
Atan2 = Atn(Y / X)
ElseIf X <= Y Then
Atan2 = Atn(Y / X) - 3.14159265358979
Else
Atan2 = -Atn(X / Y) - 3.14159265358979 / 2
End If
End If
End Function
Кривоус Анатолий писал(а):Посмотри.
Sirik писал(а):ps/ хоть убейте, не могу составить правильный алгоритм. единственно что получается - очень частный случай, когда расстояние к началу координат совпадает с радиусом
Хакер писал(а): жду «респектище»
Сейчас этот форум просматривают: AhrefsBot и гости: 24