| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Как сделать сопряжение линии и дуги в vba autocad?

Как сделать сопряжение линии и дуги в vba autocad?

Ответ
Поиск в этой теме
Непрочитано 08.01.2016, 00:20 #1
Как сделать сопряжение линии и дуги в vba autocad?
rusik16
 
Регистрация: 07.01.2016
Сообщений: 6

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

Вложения
Тип файла: dwg
DWG 2010
Чертеж1.dwg (72.1 Кб, 1575 просмотров)

Просмотров: 10653
 
Непрочитано 08.01.2016, 02:14
#2
ssn

Инженер проектировщик (раздел ТМ - фриланс)
 
Регистрация: 06.12.2003
Геленджик
Сообщений: 1,794
Отправить сообщение для ssn с помощью Skype™


я думаю что самое простое это в лоб... расчетным путём просто определить нужные координаты и все.
ssn вне форума  
 
Непрочитано 08.01.2016, 03:56
#3
kacugu

начинающий инженер-гидротехник
 
Регистрация: 18.04.2010
Санкт-Петербург
Сообщений: 893


Недавно мучился таким же вопросом. В результате пришлось
Цитата:
Сообщение от ssn Посмотреть сообщение
в лоб... расчетным путём просто определить нужные координаты
kacugu вне форума  
 
Непрочитано 08.01.2016, 08:56
#4
art_rrc


 
Регистрация: 28.01.2013
Минск
Сообщений: 379


AddCircle -> IntersectWith -> AddArc
art_rrc вне форума  
 
Автор темы   Непрочитано 08.01.2016, 11:27
#5
rusik16


 
Регистрация: 07.01.2016
Сообщений: 6


Цитата:
Сообщение от ssn Посмотреть сообщение
я думаю что самое простое это в лоб... расчетным путём просто определить нужные координаты и все.
Да это было бы слишком просто, такой вариант хорош просто для двух линий. Этот чертеж нарисован с помощью небольшого макроса для работы и дело в том, что дуга меняется, а каждый раз рассчитывать координаты занятие неблагодарное, нужно максимально все автоматизировать.
rusik16 вне форума  
 
Непрочитано 08.01.2016, 12:20
#6
Puroshev


 
Регистрация: 22.10.2008
Сообщений: 73
Отправить сообщение для Puroshev с помощью Skype™


Использовать SendCommand
Puroshev вне форума  
 
Непрочитано 08.01.2016, 12:28
#7
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Цитата:
Сообщение от rusik16 Посмотреть сообщение
Этот чертеж нарисован с помощью небольшого макроса для работы и дело в том, что дуга меняется
Ну так прямо внутри макроса и выполнять вычисления - милое дело!
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 08.01.2016, 20:58
#8
rusik16


 
Регистрация: 07.01.2016
Сообщений: 6


Цитата:
Сообщение от 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
Вложения
Тип файла: dwg
DWG 2010
Чертеж2.dwg (68.0 Кб, 1079 просмотров)

Последний раз редактировалось Кулик Алексей aka kpblc, 08.01.2016 в 21:04.
rusik16 вне форума  
 
Автор темы   Непрочитано 08.01.2016, 21:58
#9
rusik16


 
Регистрация: 07.01.2016
Сообщений: 6


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Ну так прямо внутри макроса и выполнять вычисления - милое дело!
Я пробовал различные варианты, которые нашел в сети. Но они все в основном рассчитаны на полилинии и сплайны, а такой вариант не подходит для дальнейшего экспорта в artcam. Может посмотрите мой макрос, для лучшего понимания вопроса. Просьба не пинать за стиль написания кода, это рабочий вариант. запускать следует с включенной галочкой "витрина". длину-ширину задавать в пределах 300-1000.
Вложения
Тип файла: dvb arka.dvb (65.5 Кб, 20 просмотров)
rusik16 вне форума  
 
Непрочитано 08.01.2016, 22:19
#10
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Я не пишу на VBA.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 09.01.2016, 09:16
#11
Puroshev


 
Регистрация: 22.10.2008
Сообщений: 73
Отправить сообщение для Puroshev с помощью Skype™


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))
Puroshev вне форума  
 
Автор темы   Непрочитано 10.01.2016, 14:20
#12
rusik16


 
Регистрация: 07.01.2016
Сообщений: 6


Я пробую подставить значения точек конца линии и начала дуги. Пишет "Object required". Видимо я что то делаю те так.
rusik16 вне форума  
 
Непрочитано 10.01.2016, 15:53
#13
Puroshev


 
Регистрация: 22.10.2008
Сообщений: 73
Отправить сообщение для Puroshev с помощью Skype™


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

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
Puroshev вне форума  
 
Непрочитано 10.01.2016, 16:20
#14
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Тэги [code][/code] для кого сделаны?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 11.01.2016, 08:43
#15
Boxa

КЖ; C#
 
Регистрация: 03.11.2005
Санкт-Петербург
Сообщений: 2,588


Нда, на что только люди не пойдут, лишь бы математику не вспоминать. А ларчик то, просто открывается Касательная прямая к окружности
Boxa вне форума  
 
Автор темы   Непрочитано 11.01.2016, 22:06
#16
rusik16


 
Регистрация: 07.01.2016
Сообщений: 6


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

строю, ломаю
 
Регистрация: 03.04.2008
Украина
Сообщений: 5,515


Цитата:
Сообщение от rusik16 Посмотреть сообщение
попросить помощи в решении моей проблемы
попробуй нарисовать ломанную полилинию по точкам, дальше выставить соответствующий булже, предварительно его посчитав, это надежнее и быстрее, чем делать сопряжение
gomer вне форума  
 
Непрочитано 12.01.2016, 10:39
#18
Boxa

КЖ; C#
 
Регистрация: 03.11.2005
Санкт-Петербург
Сообщений: 2,588


Уважаемый 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. Профит!

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

ЗЫ.
Так как Вы указали, что умеете пользоваться поиском, то ссылки на статьи в википедии посвященные уравнениям прямой и окружности не указываю
Boxa вне форума  
 
Непрочитано 12.01.2016, 11:36
#19
art_rrc


 
Регистрация: 28.01.2013
Минск
Сообщений: 379


Цитата:
Сообщение от 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 нужно подрезать по окружности, но это в принципе и так очевидно.
art_rrc вне форума  
 
Непрочитано 12.01.2016, 12:09
#20
Boxa

КЖ; C#
 
Регистрация: 03.11.2005
Санкт-Петербург
Сообщений: 2,588


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


ЗЫ.
Не надо мне приписывать того, о чем я не писал. Фантазии на тему пятиклассников оставьте пожалуйста при себе.
Boxa вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Как сделать сопряжение линии и дуги в vba autocad?

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как сделать непечатаемым текст в ячейке таблицы в Autocad? Газизов Рафаэль AutoCAD 10 02.09.2014 16:51
Что сделать, чтоб при печати были видны линии, пересекающие трубопровод? Dion AutoCAD 8 09.08.2013 23:04
Как сделать сопряжение полилиний в этом случае? neonatyra AutoCAD 6 07.06.2013 11:11
как сделать в листе линии ч/б, чтобы в моделе они оставались цветными natiol AutoCAD 19 18.07.2010 20:35
Вес линии в AutoCAD 2002 CyberMan AutoCAD 5 05.11.2003 22:33