Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - .NET

Страница: 1 |

 

  Вопрос: HELP !!! Как нарисовать дугу по трём координатам?? Добавлено: 13.06.09 23:38  

Автор вопроса:  Slan hillton
Подскажите как с помощью gdi+ нарисовать на форме дугу зная три координаты? облазил весь гугл, так ничего и не нашёл!

Ответить

  Ответы Всего ответов: 4  

Номер ответа: 1
Автор ответа:
 Skywalker



ICQ: 300-70-6пятьЪ 

Вопросов: 62
Ответов: 545
  Web-сайт: iSkywalker.ru
 Профиль | | #1 		Добавлено: 14.06.09 01:19
так штоль?
  1. Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
  2.         Using g As Graphics = Me.CreateGraphics
  3.             g.DrawCurve(Pens.Red, New PointF() {New PointF(10, 10), New PointF(100, 20), New PointF(30, 50)})
  4.         End Using
  5.     End Sub

Ответить

Номер ответа: 2
Автор ответа:
 Sharp


Лидер форума

ICQ: 216865379 

Вопросов: 106
Ответов: 9979
  Web-сайт: sharpc.livejournal.com
 Профиль | | #2 		Добавлено: 14.06.09 03:19
Если нужна именно дуга окружности, точка пересечения срединных перпендикуляров треугольника это центр окружности.

Ответить

Номер ответа: 3
Автор ответа:
 Slan hillton



Вопросов: 2
Ответов: 2
  Профиль | | #3 Добавлено: 14.06.09 10:36
нет это не то! вот нашёл 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

Ответить

Номер ответа: 4
Автор ответа:
 Slan hillton



Вопросов: 2
Ответов: 2
  Профиль | | #4 Добавлено: 15.06.09 01:39
Вот собственно и код для рисования дуги по трём точкам, всё работает!
  1. Private Sub DrawCircle(ByVal a As PointF, ByVal b As PointF, ByVal c As PointF, ByVal g As Graphics)
  2.         g.TranslateTransform(a.X, a.Y)
  3.         b.X -= a.X
  4.         b.Y -= a.Y
  5.         c.X -= a.X
  6.         c.Y -= a.Y
  7.         a.X = 0
  8.         a.Y = 0
  9.         Dim d As Single = 2 * (b.X * c.Y - b.Y * c.X)
  10.         If d = 0 Then
  11.             ' Points a, b, c are collinear
  12.             g.DrawLine(Pens.Black, a.X, a.Y, b.X, b.Y)
  13.             g.DrawLine(Pens.Black, b.X, b.Y, c.X, c.Y)
  14.             g.DrawLine(Pens.Black, c.X, c.Y, a.X, a.Y)
  15.         Else
  16.             Dim center As New PointF((c.Y * (b.X * b.X + b.Y * b.Y) - b.Y * (c.X * c.X + c.Y * c.Y)) / d, (b.X * (c.X * c.X + c.Y * c.Y) - c.X * (b.X * b.X + b.Y * b.Y)) / d)
  17.             Dim radius As Single = CSng(Math.Sqrt(center.X * center.X + center.Y * center.Y))
  18.             g.FillEllipse(Brushes.Blue, center.X - 2, center.Y - 2, 4, 4)
  19.             g.DrawEllipse(Pens.Black, center.X - radius, center.Y - radius, 2 * radius, 2 * radius)
  20.         End If
  21.         g.FillEllipse(Brushes.Red, a.X - 2, a.Y - 2, 4, 4)
  22.         g.FillEllipse(Brushes.Red, b.X - 2, b.Y - 2, 4, 4)
  23.         g.FillEllipse(Brushes.Red, c.X - 2, c.Y - 2, 4, 4)
  24.         g.ResetTransform()
  25.     End Sub

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам