как нарисовать дугу по трём точкам в vb.net?

Slan, 363 просмотра

Примечание:
а можно пример?
просто хотелось в своей программе добавить дугу на подобии автокадовской по трём точкам..

Примечание:
Вот нашёл VBA макрос каторый чертит то что мне нужно, вот только теперь нужно всё это в vb.net перевести..

Option Explicit

Const pi As Double = 3.14159265358979

Sub CreateArc()
Dim sr As New ShapeRange
Dim px(1 To 3) As Double, py(1 To 3) As Double
Dim t As Double, bc As Double, cd As Double
Dim x As Double, y As Double
Dim a1 As Double, a2 As Double, a3 As Double
Dim det As Double, i As Long, Shift As Long
If Documents.Count = 0 Then
MsgBox "There's no document open. Aborting...", vbCritical
Exit Sub
End If
t = 5 / ActiveDocument.ActiveWindow.ActiveView.Zoom
For i = 1 To 3
If ActiveDocument.GetUserClick(px(i), py(i), Shift, 100, False, cdrCursorPickOvertarget) <> 0 Then
sr.Delete
Exit Sub
End If
If (Shift And 2) = 0 Then ' Check if Ctrl was not pressed
x = t
If (Shift And 1) <> 0 Then x = 4 * t
sr.Add ActiveLayer.CreateEllipse2(px(i), py(i), x)
ActiveDocument.ClearSelection
End If
Next i
t = px(2) * px(2) + py(2) * py(2)
bc = (px(1) * px(1) + py(1) * py(1) - t) / 2
cd = (t - px(3) * px(3) - py(3) * py(3)) / 2
det = (px(1) - px(2)) * (py(2) - py(3)) - (px(2) - px(3)) * (py(1) - py(2))
If Abs(det) < 0.001 Then
With ActiveLayer.CreateLineSegment(px(1), py(1), px(2), py(2)).Curve
.Subpaths(1).AppendLineSegment False, px(3), py(3)
.Segments.All.SetType cdrCurveSegment
.Nodes.All.SetType cdrSmoothNode
End With
Else
det = 1 / det
x = (bc * (py(2) - py(3)) - cd * (py(1) - py(2))) * det
y = ((px(1) - px(2)) * cd - (px(2) - px(3)) * bc) * det
t = Sqr((x - px(1)) * (x - px(1)) + (y - py(1)) * (y - py(1)))
a1 = atan2(y - py(1), px(1) - x)
a2 = atan2(y - py(2), px(2) - x)
a3 = atan2(y - py(3), px(3) - x)
bc = a2 - a1
cd = a3 - a1
If bc < 0 Then bc = bc + 360
If cd < 0 Then cd = cd + 360
If bc > cd Then det = a1: a1 = a3: a3 = det
ActiveLayer.CreateEllipse2 x, y, t, , a1, a3
End If
ExitSub:
sr.Delete
Exit Sub
ErrHandler:
MsgBox "Unexpected error occured: " & Err.Description & " [" & Err.Number & "]", vbCritical, "Error"
Resume ExitSub
End Sub

Private Function atan2(y#, x#) As Double
Dim a As Double
If x > 0 Then
a = Atn(y / x)
Else
If x < 0 Then a = Atn(y / x) + pi Else a = Sgn(y) * pi / 2
End If
If a < 0 Then a = a + 2 * pi
atan2 = a * 180 / pi
End Function

Ответы:

ABihle

тут дело в том на каком в какой среде ее строить, а в том как ее описать(дугу), можно например с помощью полинома 2й степени, или используя другие способы интерполяции.
Для полинома 2й степени необходимо найти коэффициенты полинома а0, а1, а2.Это можно сделать различными способами, просто подобрать, или воспользоваться методами регрессионного анализа, т.е. определить эти коэффициенты по минимуму СКО. Найдя эти коэф. получаем уравнение кривой у = а0 + а1*х +а2*х^2 и по уравнению строим график кривой который проходит через данные точки в пределах от Хмин до Хмакс, где Хмин до Хмакс это соответственно максимально и минимальное значение координат точек по оси Х.

ABihle

А в общем чем большей степени полином тем точнее он интерполирует точки, тогда необходимо найти большее число коэффициентов, что резко усложняет задачу

doronin.m

Из геометрии известно:
1. Соединить 3 точки отрезками. Получится две хорды.
2. Из этих хорд провести посередине перпендикулярные прямые.

ABihle

Причем здесь окружность человеку нужно построить кривую, а для этого необходимо задать ее уравнение, как по Вашему на VB проводить хорды и строить окружности ???????

doronin.m

Наслаждайтесь

doronin.m

>ABihle
Ты сам-то прочитал вопрос? Дуга это часть окружности вообще-то.

ABihle

>doronin.m извеняюсь
Немного перепутал кривую с дугой, но тем не менее могу добавить что в данном примере не написано как ее все таки построить в приложении, от себя могу добавить что найдя параметры дуги, т.е. центр, радиус, для построения воспользоваться функциями sin и cos, т.к. использую формулу окружности R=sqrt(x^2+y^2), не всегда получится построить правильно,
зная центр окружности нужно найти минимальный и максимальный угол а, и рисовать следующим образом(для одной точки на дуге):
х = cos(a);
y = sin(a);
где альфа меняться в заданных пределах

16 лет назад

RPI.su - самая большая русскоязычная база вопросов и ответов. Наш проект был реализован как продолжение популярного сервиса otvety.google.ru, который был закрыт и удален 30 апреля 2015 года. Мы решили воскресить полезный сервис Ответы Гугл, чтобы любой человек смог публично узнать ответ на свой вопрос у интернет сообщества.

Все вопросы, добавленные на сайт ответов Google, мы скопировали и сохранили здесь. Имена старых пользователей также отображены в том виде, в котором они существовали ранее. Только нужно заново пройти регистрацию, чтобы иметь возможность задавать вопросы, или отвечать другим.

Чтобы связаться с нами по любому вопросу О САЙТЕ (реклама, сотрудничество, отзыв о сервисе), пишите на почту [email protected]. Только все общие вопросы размещайте на сайте, на них ответ по почте не предоставляется.