[rusik16]

Доброго времени суток. Помогите решить проблему, все праздники бьюсь над этим. Не могу разобраться как в VBA AUTOCAD сделать сопряжение дуги и линии с заданным радиусом. Спасибо за понимание.

[Puroshev]

Макрос для построения того, что хотел автор

Код:

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

Private Sub CommandButton2_Click()
Dim T0 As Variant
Dim objLine1 As AcadLine
   Dim sP(0 To 2) As Double
   Dim eP(0 To 2) As Double

Dim obL1 As AcadLine
Dim obL2 As AcadLine
Dim obL3 As AcadLine

Dim objarc1 As AcadArc
Dim objarc2 As AcadArc
Dim objarc3 As AcadArc
    
    Dim startAngleInRadian As Double
    Dim endAngleInRadian As Double

    Dim centerPoint(0 To 2) As Double
    Dim radius As Double
    Dim startAngleInDegree As Double
    Dim endAngleInDegree As Double
Dim S1 As String
Dim S2 As String
    
'############# ДАННЫЕ #################
'############# ДАННЫЕ #################
'############# ДАННЫЕ #################
'############# ДАННЫЕ #################
'############# ДАННЫЕ #################
'############# ДАННЫЕ #################
    radius = 25# ' сопряжения
    B = 150# ' ширина фигуры
    H = 250# ' высота фигуры (без учета подъема верхнй дуги)
    RD = 125# ' радиус верхней дуги
'############################################################
UserForm1.Hide
    ' Возвратите точку, используя подсказку
    T0 = ThisDrawing.Utility.GetPoint(, "Введите точку: ")
       ' Определяем нижнюю линию
        sP(0) = T0(0) - (B / 2 - radius): sP(1) = T0(1): sP(2) = T0(2)
        eP(0) = T0(0) + (B / 2 - radius): eP(1) = T0(1): eP(2) = T0(2)
    Set obL1 = ThisDrawing.ModelSpace.AddLine(sP, eP)
    ' Определяем левую линию
        sP(0) = T0(0) - B / 2: sP(1) = T0(1) + radius: sP(2) = T0(2)
        eP(0) = T0(0) - B / 2: eP(1) = T0(1) + H: eP(2) = T0(2)
    Set obL2 = ThisDrawing.ModelSpace.AddLine(sP, eP)
    ' Определяем дугу левую нижнюю
        centerPoint(0) = T0(0) - (B / 2 - radius): centerPoint(1) = T0(1) + radius: centerPoint(2) = 0#
        startAngleInDegree = 180#
    endAngleInDegree = -90#
    ' Конвертируйте углы в градусах к углам в радианах
        startAngleInRadian = startAngleInDegree * 3.141592 / 180#
        endAngleInRadian = endAngleInDegree * 3.141592 / 180#
    Set objarc1 = ThisDrawing.ModelSpace.AddArc(centerPoint, radius, startAngleInRadian, endAngleInRadian)
    
    ' Определяем правую линию
        sP(0) = T0(0) + B / 2: sP(1) = T0(1) + radius: sP(2) = T0(2)
        eP(0) = T0(0) + B / 2: eP(1) = T0(1) + H: eP(2) = T0(2)
    Set obL3 = ThisDrawing.ModelSpace.AddLine(sP, eP)
    ' Определяем дугу правую нижнюю
        centerPoint(0) = T0(0) + (B / 2 - radius): centerPoint(1) = T0(1) + radius: centerPoint(2) = 0#
        startAngleInDegree = -90#
    endAngleInDegree = 0#
    ' Конвертируйте углы в градусах к углам в радианах
        startAngleInRadian = startAngleInDegree * 3.14159265358979 / 180#
        endAngleInRadian = endAngleInDegree * 3.14159265358979 / 180#
    Set objarc2 = ThisDrawing.ModelSpace.AddArc(centerPoint, radius, startAngleInRadian, endAngleInRadian)
        ' Определяем дугу верхнюю
        dH = (RD ^ 2 - (B / 2) ^ 2) ^ 0.5
        centerPoint(0) = T0(0): centerPoint(1) = (T0(1) + H) - dH: centerPoint(2) = 0#
        startAngleInRadian = Atn(dH / (B / 2))
        endAngleInRadian = 3.14159265358979 - startAngleInRadian
    Set objarc3 = ThisDrawing.ModelSpace.AddArc(centerPoint, RD, startAngleInRadian, endAngleInRadian)
    objarc3.Update
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


X2L = Format(obL2.endPoint(0), "###0.00")
Y2L = Format(obL2.endPoint(1) - 1, "###0.00")
Z2L = Format(obL2.endPoint(2), "###0.00")

X3L = Format(obL3.endPoint(0), "###0.00")
Y3L = Format(obL3.endPoint(1) - 1, "###0.00")
Z3L = Format(obL3.endPoint(2), "###0.00")


X2A = Format(objarc3.startPoint(0), "###0.00")
Y2A = Format(objarc3.startPoint(1) + 1, "###0.00")
Z2A = Format(objarc3.startPoint(2), "###0.00")

X3A = Format(objarc3.endPoint(0), "###0.00")
Y3A = Format(objarc3.endPoint(1) + 1, "###0.00")
Z3A = Format(objarc3.endPoint(2), "###0.00")

ThisDrawing.SetVariable "FILLETRAD", radius

S1 = "(setq a (LIST (HANDENT " & Chr(34) & CStr(obL2.Handle) & Chr(34) & ") (list " & X2L & " " & Y2L & " " & Z2L & "))) "
S2 = "(setq b (LIST (HANDENT " & Chr(34) & CStr(objarc3.Handle) & Chr(34) & ") (list " & X3A & " " & Y3A & " " & Z3A & "))) "
ThisDrawing.SendCommand S1
ThisDrawing.SendCommand S2
comString = "_FILLET" & vbCr & "!a" & vbCr & "!b" & vbCr
ThisDrawing.SendCommand comString


S1 = "(setq a (LIST (HANDENT " & Chr(34) & CStr(obL3.Handle) & Chr(34) & ") (list " & X3L & " " & Y3L & " " & Z3L & "))) "
S2 = "(setq b (LIST (HANDENT " & Chr(34) & CStr(objarc3.Handle) & Chr(34) & ") (list " & X2A & " " & Y2A & " " & Z2A & "))) "
ThisDrawing.SendCommand S1
ThisDrawing.SendCommand S2
comString = "_FILLET" & vbCr & "!a" & vbCr & "!b" & vbCr
ThisDrawing.SendCommand comString


UserForm1.Show

End Sub

[art_rrc]

Сообщение от Boxa art_rrc, стесняюсь спросить, а Вы пробовали руками сделать то, что написали?

1. Окружность
2. Красные точки с помощью Intersect, подрезка примитивов.
3. По 2м точкам и радиусу дуга. Удаление окружности.

ps На 3м изображении в точности то, что хотел автор в прикрепленном файле dwg в первом посте

[doctorraz]

здорово, так просто все получается

Сообщение от art_rrc 1. Окружность

а каким она радиусом?

Сообщение от art_rrc 3. По 2м точкам и радиусу дуга. Удаление окружности.

по полученным точкам и радиусу первой окружности получается только для угла 90 град

[art_rrc]

doctorraz, Тут подробнее http://forum.dwg.ru/showpost.php?p=1491345&postcount=19

[Boxa]

Сообщение от art_rrc 1. Окружность 2. Красные точки с помощью Intersect, подрезка примитивов. 3. По 2м точкам и радиусу дуга. Удаление окружности.

А теперь еще такую же картинку для острого угла, если не сложно конечно.
Хотя нет, не надо и так все понятно.

[art_rrc]

Сообщение от Boxa А теперь еще такую же картинку для острого угла, если не сложно конечно.

Ну для какого острого угла? Задача ведь не абстрактная, не математическая, не в общем виде. Где вы видели окна с арками вниз?
Автор просил идей, я высказал свою. Я считаю, что она хороша в плане простоты реализации, плоха в плане универсальности, но нужна ли эта универсальность в рамках поставленной задачи? Теперь у автора есть выбор, что ему нужнее.
ps В споре рождается истина.

[Boxa]

Сообщение от art_rrc Ну для какого острого угла? Задача ведь не абстрактная, не математическая, не в общем виде. Где вы видели окна с арками вниз?

Сообщение от art_rrc Я считаю, что она хороша в плане простоты реализации

Проблема в том, что ваше решение не дает сопряжение. Сопряжение строится на основе касательных, а Ваш алгоритм один, заметный, излом, заменяет парой менее заметных изломов.