Re: Дуга по точкам как из панели инструментов

Рискую показаться бестолковой :), но я пока не нашла, как придать кривизну сегменту. В вывпдающем меню для PolylineEdit я не вижу команды типа Arc...

Re: Дуга по точкам как из панели инструментов

> masha
Я имел в виду програмно...
object.SetBulge Index, Value
Где Index - номер сегмента, начиная с нуля
Value - тангенс четверти угла

Re: Дуга по точкам как из панели инструментов

А смысл - программно??? Я ведь и так создаю полилинию с дуговым сегментом, как раз программно... Фишка в том, что этот ДУГОВОЙ СЕГМЕНТ отличается от ДУГИ, проведённой через те же 3 точки. Не сильно, но отличается.

Re: Дуга по точкам как из панели инструментов

Может достаточно обновить экран?
А вообще выложи код - посмотрим, в чем разница...

Re: Дуга по точкам как из панели инструментов

Итак, задача: нарисовать трапецию с дугами вместо оснований.
Версия с дугами (работает):

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

Re: Дуга по точкам как из панели инструментов

> masha
В качестве предположения - когда вы запускаете команду _ARC - вы передаете ей точки в виде строки - есть какое-то округление. По алгоритму Евгения точки (углы)передаются с максимально возможной для AutoCAD точностью. В этом может быть расхождение. Кроме того могут быть нюансы если у вас UCS (ПСК) не соответствует WCS (МСК).

Re: Дуга по точкам как из панели инструментов

P.S.: А еще вы кажется невнимательны:
Вместо tg_betta = Sin(Angle) / Cos(Angle) должно быть tg_betta = Sin(Angle_3) / Cos(Angle_3)

Re: Дуга по точкам как из панели инструментов

Если рисовать дугу вручную, то никаких строк я не передаю. Это так?  Я просто тыкаю в те же 3 точки и строю дугу... Насчёт невнимательности -- да, промахнулась. Только исправление не помогло. Всё равно дуги не совпадают. Они довольно близки, но не совпадают. От меня хотят большую точность, поэтому я так и парюсь по этому вопросу.
А можно поподробнее про UCS (ПСК) и WCS (МСК) - что это такое и как сними бороться?

Re: Дуга по точкам как из панели инструментов

> masha
1) А можно поподробнее про UCS (ПСК) и WCS (МСК) — что это такое и как сними бороться?
Для начала установите UCS в WCS и проверьте свою программу. Для этой цели в командной строке AutoCAD:

_.UCS _World

2) Сомневаюсь, что функция CStr преобразует координаты точек из double в string абсолютно точно (т.е. хотябы с 14 значащими цифрами) - я не специалист в VBA, и так же как и Евгений его недолюбливаю.

Re: Дуга по точкам как из панели инструментов

Насчёт значащих цифр - мне важны только первые 3-4 знака после запятой, и то не очень важны. У чисел очень большая целая часть (так уж получилось). Я думаю, что виновата не точность, а наше (ваше или моё) вычисление тангенса угла. Либо причина глюка в самом AutoCAD-e, который может по-разному рисовать дуги и дуговые сегменты полилиний.

Re: Дуга по точкам как из панели инструментов

Как найти значения угла, зная его синус косинус тангенс?

Re: Дуга по точкам как из панели инструментов

> Дмитрий
atan