[tata-tau]

как средствами VBA нарисовать дугу, зная координаты центра, радиус, координаты начальной и конечной точек?

[Кулик Алексей aka kpblc]

Зная координаты центра, начальной и конечной точек - запросто. А как с заданным радиусом - если честно, то не знаю.

[Хмурый]

как нарисовать дугу, зная координаты центра, радиус, координаты начальной и конечной точек?

из меню

PS при задании сразу всех указанных параметров- либо радиус, либо координаты центра будут лишними.

[tata-tau]

Для рисования дуги средствами VBA требуются центр, радиус, начальный и конечный угол.
Можно найти углы через координаты центра, начальной и конечной точек:
tgA=(By-Oy)/(Bx-Ox)
где Ox,Oy - координаты центра;
Bx,By - координаты одной из точек.
Второй угол - аналогично.
- получится или нет - пока не пробовала.

[Хмурый]

tata-tau, так сразу и надо писать про VBA, да ещё и в другом разделе форума.

[Кулик Алексей aka kpblc]

Хмурый, тема перемещена из AutoCAD в "Программирование"
tata-tau, с тебя переименование темы (как? см.справку по форуму, ссылка у меня в подписи).

[KronSerg]

Сообщение от Кулик Алексей aka kpblc Зная координаты центра, начальной и конечной точек - запросто. А как с заданным радиусом - если честно, то не знаю.

Алексей, если есть координаты центра и координаты точки на дуге, радиус уже определён и изменить его нельзя

[Олег (jr.)]

Сообщение от tata-tau как средствами VBA нарисовать дугу, зная координаты центра, радиус, координаты начальной и конечной точек?

Простой пример - переделай по своим данным
Точки нужно задавать против часовой стрелки
относительно центра

Код:

[Выделить все]

Option Explicit

Sub ArcByCenter2Points()
    Dim p1, p2, cp
    Dim sa As Double, ea As Double, rad As Double
    Dim arc As acadArc
    With ThisDrawing
        With .Utility
            p1 = .GetPoint(, vbCr & "First point: ")
            p2 = .GetPoint(p1, vbCr & "Second point: ")
            cp = .GetPoint(, vbCr & "Center point point: ")
            If Distance(cp, p1) <> _
               Distance(cp, p2) Then
                MsgBox "Distances between center" & vbCr & _
                       "and points are not equals" & vbCr & _
                       "Program exiting"
                Exit Sub
            End If
            rad = Distance(cp, p1)
            sa = .AngleFromXAxis(cp, p1)
            ea = .AngleFromXAxis(cp, p2)
        End With
        On Error Resume Next
        Set arc = .ModelSpace.AddArc(cp, rad, sa, ea)
        If Err Then
            Err.Clear
            MsgBox "Degenerate geometry values" & vbCr & _
                   "Program exiting"
            Exit Sub
        End If
    End With
End Sub

Function Distance(p1 As Variant, p2 As Variant) As Double
    Distance = Sqr((p1(0) - p2(0)) ^ 2 + ((p1(1) - p2(1)) ^ 2))
End Function

~'J'~

[hwd]

тынц.

[tata-tau]

СПАСИБО!