Re: Дуга по точкам как из панели инструментов
Рискую показаться бестолковой :), но я пока не нашла, как придать кривизну сегменту. В вывпдающем меню для PolylineEdit я не вижу команды типа Arc...
Информационный портал для профессионалов в области САПР
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Форумы CADUser → Программирование → VBA → Дуга по точкам как из панели инструментов
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Рискую показаться бестолковой :), но я пока не нашла, как придать кривизну сегменту. В вывпдающем меню для PolylineEdit я не вижу команды типа Arc...
> masha
Я имел в виду програмно...
object.SetBulge Index, Value
Где Index - номер сегмента, начиная с нуля
Value - тангенс четверти угла
А смысл - программно??? Я ведь и так создаю полилинию с дуговым сегментом, как раз программно... Фишка в том, что этот ДУГОВОЙ СЕГМЕНТ отличается от ДУГИ, проведённой через те же 3 точки. Не сильно, но отличается.
Может достаточно обновить экран?
А вообще выложи код - посмотрим, в чем разница...
Итак, задача: нарисовать трапецию с дугами вместо оснований.
Версия с дугами (работает):
Dim pt0(0 To 2) As Double, pt1(0 To 2) As Double, pt2(0 To 2) As Double Dim SysVarOsmode SysVarOsmode = ThisDrawing.GetVariable("osmode") ThisDrawing.SetVariable "osmode", 0 pt0(0) = cell_points_arr(0): pt0(1) = cell_points_arr(1): pt0(2) = cell_points_arr(2) pt1(0) = cell_points_arr(3): pt1(1) = cell_points_arr(4): pt1(2) = cell_points_arr(5) pt2(0) = cell_points_arr(6): pt2(1) = cell_points_arr(7): pt2(2) = cell_points_arr(8) strPt1 = Replace(CStr(pt0(0)), ",", ".") & "," & Replace(CStr(pt0(1)), ",", ".") strPt2 = Replace(CStr(pt1(0)), ",", ".") & "," & Replace(CStr(pt1(1)), ",", ".") strPt3 = Replace(CStr(pt2(0)), ",", ".") & "," & Replace(CStr(pt2(1)), ",", ".") ThisDrawing.SendCommand ("_arc" & vbCr & strPt1 & vbCr & strPt2 & vbCr & strPt3 & vbCr) pt0(0) = cell_points_arr(9): pt0(1) = cell_points_arr(10): pt0(2) = cell_points_arr(11) pt1(0) = cell_points_arr(12): pt1(1) = cell_points_arr(13): pt1(2) = cell_points_arr(14) pt2(0) = cell_points_arr(15): pt2(1) = cell_points_arr(16): pt2(2) = cell_points_arr(17) strPt1 = Replace(CStr(pt0(0)), ",", ".") & "," & Replace(CStr(pt0(1)), ",", ".") strPt2 = Replace(CStr(pt1(0)), ",", ".") & "," & Replace(CStr(pt1(1)), ",", ".") strPt3 = Replace(CStr(pt2(0)), ",", ".") & "," & Replace(CStr(pt2(1)), ",", ".") ThisDrawing.SendCommand ("_arc" & vbCr & strPt1 & vbCr & strPt2 & vbCr & strPt3 & vbCr) ThisDrawing.SetVariable "osmode", SysVarOsmode ThisDrawing.Regen acAllViewports
Версия с полилинией (работает, но результат другой):
Dim A, D, C As Variant 'the next fragment WORKS Set curr_cell = ThisDrawing.ModelSpace.AddPolyline(cell_points_arr) For i = 0 To 4 If i = 0 Or i = 3 Then 'arcs: 0,1,3,4 segments A = curr_cell.Coordinate(i): D = curr_cell.Coordinate(i + 1): C = curr_cell.Coordinate(i + 2) R_AD = Sqr((A(0) - D(0)) * (A(0) - D(0)) + (A(1) - D(1)) * (A(1) - D(1))) R_AC = Sqr((A(0) - C(0)) * (A(0) - C(0)) + (A(1) - C(1)) * (A(1) - C(1))) R_DC = Sqr((D(0) - C(0)) * (D(0) - C(0)) + (D(1) - C(1)) * (D(1) - C(1))) If R_AC = R_AD + R_DC Then Exit Sub ' cos_alfa = 1, ekvator ==> line, not arc ' my version fo COUNT TANGENS cos_D = (R_AD * R_AD + R_DC * R_DC - R_AC * R_AC) / 2 / R_AD / R_DC R = R_AC / Sqr(2 * (1 + cos_D)) cos_fi = 2 * cos_D * cos_D - 1 sin_fi = Sqr(1 - cos_fi * cos_fi) tg_fi = sin_fi / cos_fi fi = Atn(tg_fi) arc_angle = fi / 2 tg_betta = Tan(arc_angle / 4) 'COUNT TANGENS FROM Евгений Dim Angle_1 As Double, Angle_2 As Double, Angle_3 As Double Angle_1 = ThisDrawing.Utility.AngleFromXAxis(pt1, pt2) Angle_2 = ThisDrawing.Utility.AngleFromXAxis(pt0, pt1) Angle_3 = Angle_1 - Angle_2 Angle_3 = Angle_3 / 2 tg_betta = Sin(Angle) / Cos(Angle) If i < 2 Then 'upper border curr_cell.SetBulge i, tg_betta curr_cell.SetBulge i + 1, tg_betta Else curr_cell.SetBulge i, -tg_betta curr_cell.SetBulge i + 1, -tg_betta End If End If Next i curr_cell.Closed = True: curr_cell.Update
> masha
В качестве предположения - когда вы запускаете команду _ARC - вы передаете ей точки в виде строки - есть какое-то округление. По алгоритму Евгения точки (углы)передаются с максимально возможной для AutoCAD точностью. В этом может быть расхождение. Кроме того могут быть нюансы если у вас UCS (ПСК) не соответствует WCS (МСК).
P.S.: А еще вы кажется невнимательны:
Вместо tg_betta = Sin(Angle) / Cos(Angle) должно быть tg_betta = Sin(Angle_3) / Cos(Angle_3)
Если рисовать дугу вручную, то никаких строк я не передаю. Это так? Я просто тыкаю в те же 3 точки и строю дугу... Насчёт невнимательности -- да, промахнулась. Только исправление не помогло. Всё равно дуги не совпадают. Они довольно близки, но не совпадают. От меня хотят большую точность, поэтому я так и парюсь по этому вопросу.
А можно поподробнее про UCS (ПСК) и WCS (МСК) - что это такое и как сними бороться?
> masha
1) А можно поподробнее про UCS (ПСК) и WCS (МСК) — что это такое и как сними бороться?
Для начала установите UCS в WCS и проверьте свою программу. Для этой цели в командной строке AutoCAD:
_.UCS _World
2) Сомневаюсь, что функция CStr преобразует координаты точек из double в string абсолютно точно (т.е. хотябы с 14 значащими цифрами) - я не специалист в VBA, и так же как и Евгений его недолюбливаю.
Насчёт значащих цифр - мне важны только первые 3-4 знака после запятой, и то не очень важны. У чисел очень большая целая часть (так уж получилось). Я думаю, что виновата не точность, а наше (ваше или моё) вычисление тангенса угла. Либо причина глюка в самом AutoCAD-e, который может по-разному рисовать дуги и дуговые сегменты полилиний.
Как найти значения угла, зная его синус косинус тангенс?
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Форумы CADUser → Программирование → VBA → Дуга по точкам как из панели инструментов
Форум работает на PunBB, при поддержке Informer Technologies, Inc