[rusik16]

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

[ssn]

я думаю что самое простое это в лоб... расчетным путём просто определить нужные координаты и все.

[kacugu]

Недавно мучился таким же вопросом. В результате пришлось

Сообщение от ssn в лоб... расчетным путём просто определить нужные координаты

[art_rrc]

AddCircle -> IntersectWith -> AddArc

[rusik16]

Сообщение от ssn я думаю что самое простое это в лоб... расчетным путём просто определить нужные координаты и все.

Да это было бы слишком просто, такой вариант хорош просто для двух линий. Этот чертеж нарисован с помощью небольшого макроса для работы и дело в том, что дуга меняется, а каждый раз рассчитывать координаты занятие неблагодарное, нужно максимально все автоматизировать.

[Puroshev]

Использовать SendCommand

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

Сообщение от rusik16 Этот чертеж нарисован с помощью небольшого макроса для работы и дело в том, что дуга меняется

Ну так прямо внутри макроса и выполнять вычисления - милое дело!

[rusik16]

Сообщение от Puroshev Использовать SendCommand

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

Код:

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

Sub FilletLines()
Dim objLine1 As Acadobject
Dim objarc2 As Acadobject
Dim varPt As Variant
Dim dblFill, newSysVar As Double
Dim comString As String

dblFill = ThisDrawing.GetVariable("FILLETRAD")

On Error GoTo ProblemHere

MsgBox CStr(dblFill)
newSysVar = CDbl(InputBox("Enter fillet radius:", "Fillet Radius Value", "8"))
ThisDrawing.Utility.GetEntity objLine1, varPt, "Select first line"
ThisDrawing.Utility.GetEntity objarc2, varPt, "Select second arc"

If objLine1 Is Nothing Or objarc2 Is Nothing Then
Exit Sub
Else
If TypeOf objLine1 Is Acadobject And _
   TypeOf objarc2 Is Acadobject Then
ThisDrawing.SetVariable "FILLETRAD", newSysVar
comString = "_FILLET" & vbCr & "(HANDENT " & Chr(34) & CStr(objLine1.Handle) & Chr(34) & ")" & vbCr & _
"(HANDENT " & Chr(34) & CStr(objarc2.Handle) & Chr(34) & ")" & vbCr
ThisDrawing.SendCommand comString
Else
MsgBox "Incorrect object type"
Exit Sub
End If
End If
ThisDrawing.SetVariable "FILLETRAD", dblFill

ProblemHere:
If Err Then
ThisDrawing.SetVariable "FILLETRAD", dblFill
MsgBox vbCr & Err.Description
End If
End Sub

[rusik16]

Сообщение от Кулик Алексей aka kpblc Ну так прямо внутри макроса и выполнять вычисления - милое дело!

Я пробовал различные варианты, которые нашел в сети. Но они все в основном рассчитаны на полилинии и сплайны, а такой вариант не подходит для дальнейшего экспорта в artcam. Может посмотрите мой макрос, для лучшего понимания вопроса. Просьба не пинать за стиль написания кода, это рабочий вариант. запускать следует с включенной галочкой "витрина". длину-ширину задавать в пределах 300-1000.

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

Я не пишу на VBA.

[Puroshev]

comString = "_FILLET" & vbCr & "(HANDENT " & Chr(34) & CStr(objLine1.Handle) & Chr(34) & ")" & vbCr & _
"(HANDENT " & Chr(34) & CStr(objarc2.Handle) & Chr(34) & ")" & vbCr


В строке comString нет данных о точке указания объекта (идет передача только имени)
подставь точки конца отрезка и начала дуги.
Для примера протокол команды _fillet

Команда: (setq a (entsel))
Выберите объект: (<Имя объекта: 7ef03c90> (100.5 177.0 0.0))
Команда: (setq b (entsel))
Выберите объект: (<Имя объекта: 7ef03c98> (102.5 186.0 0.0))
Команда: _fillet
Текущие настройки: Режим = С ОБРЕЗКОЙ, Радиус сопряжения = 8.0000
Выберите первый объект или [оТменить/полИлиния/раДиус/оБрезка/Несколько]: !a
(<Имя объекта: 7ef03c90> (100.5 177.0 0.0))
Выберите второй объект или нажмите клавишу Shift при выборе, чтобы создать
угол: !b
(<Имя объекта: 7ef03c98> (102.5 186.0 0.0))

[rusik16]

Я пробую подставить значения точек конца линии и начала дуги. Пишет "Object required". Видимо я что то делаю те так.

[Puroshev]

''''Попробуй это:
''''вроде получилось.

Sub FilletLines()
Dim objLine1 As AcadLine
Dim objarc2 As AcadArc
Dim varPt As Variant
Dim dblFill, newSysVar As Double
Dim comString As String
Dim S1 As String
Dim S2 As String

dblFill = ThisDrawing.GetVariable("FILLETRAD")
UserForm1.Hide
On Error GoTo ProblemHere

MsgBox CStr(dblFill)
newSysVar = CDbl(InputBox("Enter fillet radius:", "Fillet Radius Value", "8"))
ThisDrawing.Utility.GetEntity objLine1, varPt, "Select first line"
XL = Format(varPt(0), "###0.00")
YL = Format(varPt(1), "###0.00")
ZL = Format(varPt(2), "###0.00")

ThisDrawing.Utility.GetEntity objarc2, varPt, "Select second arc"
XA = Format(varPt(0), "###0.00")
YA = Format(varPt(1), "###0.00")
ZA = Format(varPt(2), "###0.00")


S1 = "(setq a (LIST (HANDENT " & Chr(34) & CStr(objLine1.Handle) & Chr(34) & ") (list " & XL & " " & YL & " " & ZL & "))) "
S2 = "(setq b (LIST (HANDENT " & Chr(34) & CStr(objarc2.Handle) & Chr(34) & ") (list " & XA & " " & YA & " " & ZA & "))) "

ThisDrawing.SendCommand S1
ThisDrawing.SendCommand S2
If objLine1 Is Nothing Or objarc2 Is Nothing Then
Exit Sub
Else

If TypeOf objLine1 Is AcadObject And _
TypeOf objarc2 Is AcadObject Then
ThisDrawing.SetVariable "FILLETRAD", newSysVar
comString = "_FILLET" & vbCr & "!a" & vbCr & "!b" & vbCr
ThisDrawing.SendCommand comString
Else
MsgBox "Incorrect object type"
Exit Sub
End If
End If
ThisDrawing.SetVariable "FILLETRAD", dblFill

ProblemHere:
If Err Then
ThisDrawing.SetVariable "FILLETRAD", dblFill
MsgBox vbCr & Err.Description
End If
UserForm1.Show
End Sub

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

Тэги [code][/code] для кого сделаны?

[Boxa]

Нда, на что только люди не пойдут, лишь бы математику не вспоминать. А ларчик то, просто открывается Касательная прямая к окружности

[rusik16]

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

[gomer]

Сообщение от rusik16 попросить помощи в решении моей проблемы

попробуй нарисовать ломанную полилинию по точкам, дальше выставить соответствующий булже, предварительно его посчитав, это надежнее и быстрее, чем делать сопряжение

[Boxa]

Уважаемый rusik16, мне пару лет назад пришлось решать похожую задачу (отрисовка хомутов с радиусами загибов по нормативу) и мне помогла ссылка приведенная выше.
Если Вам не совсем понятно, то я попробую описать решение проще:
1. Имея дугу и прямую, Вы имеете два уравнения, уравнение окружности (окр1) и уравнение прямой (прям1)
2. Вам нужно преобразовать эти уравнения в уравнение окружности с радиусом равным радиусу окр1 + радиус сопряжения (окр2) и уравнение прямой параллельной прям1 и отстоящей о нее в сторону центра окр1 на величину равную радиусу скругления (прям2)
3. Найти точки пересечения окр2 и прям2, отсеять не нужные точки и в Вас получится точка центра дуги скругления
4. Составить уравнение прямой по двум точкам, центр окр1 и центр дуги скругления, (прям3)
5. Решить систему уравнения и найти точки пересечения прям3 и окр1, у Вас получится точка начала дуги скругления
6. Составить уравнение прямой проходящей через заданную точку (центр дуги сопряжения) и перпендикулярную прям1, у Вас получится уравнение прям4
7. Решить систему уравнений прям1 и прям4, получите точку конца дуги сопряжения.
8. Откорректировать имеющиеся примитивы и дорисовать дугу сопряжения по трем точкам и радиусу.
9. Профит!

То, что я описал выше - курс математики начальных классов средней школы. Так же упомяну, что у решения есть ограничения, которые нужно учитывать, когда напишите первичный вариант, и поиграетесь с ним, поймете что и как. В любом случае, удачи в написании кода.

ЗЫ.
Так как Вы указали, что умеете пользоваться поиском, то ссылки на статьи в википедии посвященные уравнениям прямой и окружности не указываю

[art_rrc]

Сообщение от art_rrc AddCircle -> IntersectWith -> AddArc

Ух ты сколько тут всего написали... а мой пост проигнорировали, непонятно почему. Такие тут алгоритмы Boxa предлагет.. без целого класса пятикласников и не справишься..
Теперь по делу. Все ведь проще:
Дано: отрезок(line), дуга(arc), желаемый радиус сопряжения (r) также известен.
1. Находим точку пересечения line и arc = p1 (указываем вручную/сравниваем расстояния между start и endpoint и т.п. вариантов куча).
2. В точке p1 cтроим вспомогательную окружность circle с радиусом например r/2 (после вставки метод update применять не нужно, чтоб ничего не мерцало, т.к. в конце circle.delete)
3. Находим точку пересечения line и и circle (отнимаем от координаты r/2 или используем метод Intersectwith(предпочтительнее) и т.п.) =p2
4. Находим точку пересечения arc и и circle (зовем толпу пятиклашек, чтоб посчитали геометрию, а лучше опять используем Intersectwith(с соответствующей настройкой, не продлевать примитивы)) =p3
5. По 2м точкам (p2,p3) и радиусу (R) строим новую дугу.

добавлено:
ps не написал, что line и arc нужно подрезать по окружности, но это в принципе и так очевидно.

[Boxa]

art_rrc, стесняюсь спросить, а Вы пробовали руками сделать то, что написали?
Я вот не только пробовал, но и использовал приведенный мной алгоритм, да и руками он легко повторяется:


ЗЫ.
Не надо мне приписывать того, о чем я не писал. Фантазии на тему пятиклассников оставьте пожалуйста при себе.

[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 Я считаю, что она хороша в плане простоты реализации

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