[CDR 2017-2021] Размеры фигур.

[lev]

По "по той же технологии..." Вы уже писали в посте №35, и я уже тогда не понял.
Покажите уже наконец.

 

[_MBK_]

Вы еще видео попросите

В студию!

 

[dosp]

Покажите уже наконец

А вы нарисуйте в своем способе поверклип длиной не

с текущую сторону фигуры

, а в 3 раза больше. Или в 5, так чтобы вся фигура в него поместилась. И масштабируйте его не до желаемого размера, а в 3 (5) раз больше. И оказывается что загонять исходную фигуру в поверклип, а потом оттуда доставать уже и не надо.

 

[dosp]

В студию

Нет, спасибо. Это не ко мне.

 

[lev]

Вы условие какой задачи выполняете?

 

[dosp]

Вы условие какой задачи выполняете?

Точно такой же как у вас в 34-м посте.

 

[_MBK_]

Извините, видимо под вечер мозг уже замылился

нарисуйте в своем способе поверклип

загонять исходную фигуру в поверклип, а потом оттуда доставать уже и не надо.

Разве поверклип, в который не загнали фигуру - это собственно поверклип?

 

[lev]

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

 

[dosp]

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

 

[_MBK_]

Не по теме:

Я понимаю, что пятница, но не рановато ли?

 

[Aniriann]

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

А давайте вы все вернетесь в более созидательное русло беседы, а не будете словесно препираться.

@dosp, не могли бы вы продемонстрировать то, о чем говорите? Так, чтобы очевидно стало даже тем, у кого нет сейчас под рукой Корела, чтобы что-то наглядно проверить. Спасибо.

 

[Элвин]

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

Файл из Облака Mail.Ru

 

[zollinger]

Так попробуйте (предполагается, что у Вас равносторонний многоугольник, без искажений):

Sub Polyside()
  ActiveDocument.Unit = cdrMillimeter
  ActiveDocument.ReferencePoint = cdrCenter
  Set s = ActiveShape
  If s.Type = cdrPolygonShape Then
    sl = s.DisplayCurve.Length / s.Polygon.Sides
    desired_sl = InputBox("Введите длину стороны")
    sc = desired_sl / sl
    s.Stretch sc, sc
  End If
End Sub

А нафига, собственно, при РАВНОСТОРОННЕМ треугольнике какие-то макросы? Polygon tool при нажатом Ctrl и построении трехстороннего полигона даст таки равносторонний треугольник. Потом можно задать его ШИРИНУ, все стороны будут равны такой ширине. Вот для других треугольников да, посложнее

 

[_MBK_]

А нафига, собственно, при РАВНОСТОРОННЕМ треугольнике какие-то макросы? Polygon tool при нажатом Ctrl и построении трехстороннего полигона даст таки равносторонний треугольник. Потом можно задать его ШИРИНУ, все стороны будут равны такой ширине.

Для N<5 это справедливо

 

[zollinger]

Для N<5 это справедливо

Так не нужно строить абстрактного коня в вакууме. Задача стояла - треугольник. Впрочем, с другой стороны, равносторонний треугольник частный случай.
Самый простой способ - воспользоваться геометрическим способом построения. Т.е. строим одну сторону нужной длины, из крайних точек строим окружности радиусом как вторая и третья стороны. Делаем новую фигуру пересечением окружностей, окружности удаляем. Строим линии из одного конца первой линии к верхней (или нижней) узловой точке, потом из второго конца туда же. фигуру-пересечение удаляем. По желанию объединяем и замыкаем образовавшийся треугольник. Я рекордером записал, тут чистить нужно, и обвязка-форма для ввода размеров, но при желании полчаса работы.

Sub testTriangle()
    '
    ' Recorded 22.10.2018
    '
    ' Description:
    '                строит треугольник по трем сторонам
    '
    Dim s1 As Shape
    Set s1 = ActiveLayer.CreateLineSegment(0.334114, 7.631453, 7.279783, 7.631453)
    s1.Fill.ApplyNoFill
    s1.Outline.SetProperties 0.003, OutlineStyles(0), CreateCMYKColor(0, 0, 0, 100), ArrowHeads(0), ArrowHeads(0), False, False, cdrOutlineButtLineCaps, cdrOutlineMiterLineJoin, 0#, 100, , , 5#
    ActiveDocument.ReferencePoint = cdrCenter
    s1.SetSize 7.086614, 0.000016
 
    Dim s2 As Shape
    Set s2 = ActiveLayer.CreateEllipse2(0.263642, 7.631453, 3.737697, -3.737697, 90#, 90#, False)
 
    s2.SetSize 7.874016, 7.874016
 
    Dim s3 As Shape
    Set s3 = ActiveLayer.CreateEllipse2(7.350256, 7.631453, 4.383091, -4.383091, 90#, 90#, False)
    s3.Fill.ApplyNoFill
    s3.Outline.SetProperties 0.003, OutlineStyles(0), CreateCMYKColor(0, 0, 0, 100), ArrowHeads(0), ArrowHeads(0), False, False, cdrOutlineButtLineCaps, cdrOutlineMiterLineJoin, 0#, 100, , , 5#
    s3.SetSize 8.661417, 8.661417
   
    Dim s4 As Shape
    Set s4 = s3.Intersect(s2, True, True)

   ' вот тут нужно будет получить координаты одой из точек получившейся при пересечении фигуры

    Dim s5 As Shape
    Set s5 = ActiveLayer.CreateLineSegment(0.263642, 7.631453, 3.577224, 9.758) ' а вот тут их подставить
   
    Dim crv As Curve
    Set crv = ActiveDocument.CreateCurve()
    With crv.CreateSubPath(0.263642, 7.631453)  ' и тут
        .AppendLineSegment 3.577224, 9.758
        .AppendLineSegment 7.350256, 7.631453
    End With
   
    s5.Curve.CopyAssign crv
    s4.Delete
    ActiveDocument.CreateSelection s1, s5
   
    Dim s6 As Shape
    Set s6 = ActiveSelection.Combine
    Set crv = ActiveDocument.CreateCurve()
    With crv.CreateSubPath(0.263642, 7.631453)
        .AppendLineSegment 7.350256, 7.631453
        .AppendLineSegment 3.577224, 9.758
        .AppendLineSegment 0.263642, 7.631453
    End With
    s6.Curve.CopyAssign crv
    Set crv = ActiveDocument.CreateCurve()
    With crv.CreateSubPath(0.263642, 7.631453)
        .AppendLineSegment 7.350256, 7.631453
        .AppendLineSegment 3.577224, 9.758
        .AppendLineSegment 0.263642, 7.631453
        .Closed = True
    End With
    s6.Curve.CopyAssign crv
End Sub

 

[Элвин]

Вот функция из моего макроса. a, b, c - длины сторон, Cx, Cy - координаты вершины C.

Function drawTriangle(a, b, c, Cx, Cy) As Shape

  Dim spath As SubPath, crv As Curve
  Dim Ax, Ay, Bx, By, Adx, Ady, p
        
  'рассчитываем координаты вершин
  Bx = Cx - a
  By = Cy
  p = (a + b + c) / 2
  Ady = 2 / a * Sqr(p * (p - a) * (p - b) * (p - c))
  Adx = Sqr(b ^ 2 - Ady ^ 2)
  If a ^ 2 + b ^ 2 - c ^ 2 > 0 Then Ax = Cx - Adx Else Ax = Cx + Adx
  Ay = Cy - Ady
 
  'рисуем треугольник
  Set crv = Application.CreateCurve(ActiveDocument)
  Set spath = crv.CreateSubPath(Cx, Cy)
  spath.AppendLineSegment Bx, By
  spath.AppendLineSegment Ax, Ay
  spath.Closed = True
 
  Set drawTriangle = ActiveLayer.CreateCurve(crv)
 
End Function

 

[_MBK_]

Да ну?

Всем привет! В программе Corel я новичок, и вот столкнулся вроде бы с элементарной проблемой.
Рисую пятиугольник либо треугольник

 

[zollinger]

Да ну?

Ну тогда да, я пропустил про пятиугольник. Был неправ, пойду накачу

 

[_MBK_]

В понедельник с утра - не лучшая идея

 

[zollinger]

Вот функция из моего макроса. a, b, c - длины сторон, Cx, Cy - координаты вершины C.

Function drawTriangle(a, b, c, Cx, Cy) As Shape

  Dim spath As SubPath, crv As Curve
  Dim Ax, Ay, Bx, By, Adx, Ady, p
      
  'рассчитываем координаты вершин
  Bx = Cx - a
  By = Cy
  p = (a + b + c) / 2
  Ady = 2 / a * Sqr(p * (p - a) * (p - b) * (p - c))
  Adx = Sqr(b ^ 2 - Ady ^ 2)
  If a ^ 2 + b ^ 2 - c ^ 2 > 0 Then Ax = Cx - Adx Else Ax = Cx + Adx
  Ay = Cy - Ady
 
  'рисуем треугольник
  Set crv = Application.CreateCurve(ActiveDocument)
  Set spath = crv.CreateSubPath(Cx, Cy)
  spath.AppendLineSegment Bx, By
  spath.AppendLineSegment Ax, Ay
  spath.Closed = True
 
  Set drawTriangle = ActiveLayer.CreateCurve(crv)
 
End Function

Тоже чудно В защиту своего способа скажу - наглядно и считать не нужно Впрочем, на этом преимущества заканчиваются. Расчеты в данном случае намного быстрее. Хотя не думаю, что в этом случае это имеет какое-то значение, это если бы треугольников миллион сгенерить...