Разбить кривую на n равных кривых?

  • Автор темы Автор темы dik973
  • Дата начала Дата начала
Статус
Закрыто для дальнейших ответов.
D

dik973

Топикстартер
15 лет на форуме
Сообщения
596
Реакции
79
Исходя из вопроса http://forum.rudtp.ru/showthread.php?t=30077, думаю дай-ка я макросом порежу по примерному длине стреки кривую, но не тут то было... Все точки и сегменты привязаны, к координатам, хотя длину Curve.Length объект знает...

Может, кто-то знает как это сделать, или это нужны математические расчеты координат кривой?
 
Ответ: Разбить кривую на n равных кривых?

см. в сторону SubPath.GetPointPositionAt, в примере из хелпа вместо стрелок расставляются кружочки. В примере команда GetPointPositionAt написана со старым синтаксисом, поэтому может не работать. В зависимости от версии Вашего CorelDRAW, возможно, придётся поменять её на:
Код: 
sp.GetPointPositionAt x, y, t, cdrRelativeSegmentOffset
 
Ответ: Разбить кривую на n равных кривых?

Спасибо, вроде разобрался
Код: 
Sub Macro7()

    Const ArrSize = 40 'это в мм примерная длина стрелки
    Dim undocArrSize As Double, myCountSubpath As Integer
    undocArrSize = ConvertUnits(ArrSize, cdrMillimeter, Application.Unit)
    Dim crv As Curve, myNodes As New NodeRange, selShape As ShapeRange
ActiveDocument.BeginCommandGroup "Break Arrow"
    Set selShape = ActiveSelectionRange
    Set crv = selShape.Shapes.FindShape(Type:=cdrCurveShape).Curve
    If crv.SubPaths.Count > 1 Then
     ActiveShape.BreakApart
    End If
    myCountSubpath = Round(crv.Length / undocArrSize)
    For I = 1 To myCountSubpath - 1
    myNodes.Add crv.SubPaths.First.AddNodeAt(I / myCountSubpath, cdrRelativeSegmentOffset)
    Next I
    myNodes.BreakApart

ActiveDocument.EndCommandGroup
    
End Sub
Работает активной кривой
 
Ответ: Разбить кривую на n равных кривых?

Вот доработал, что бы удобно было пользоваться...
 

Вложения

Статус
Закрыто для дальнейших ответов.
Верх Низ