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

[dik973]

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

Может, кто-то знает как это сделать, или это нужны математические расчеты координат кривой?

 

[lev]

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

см. в сторону SubPath.GetPointPositionAt, в примере из хелпа вместо стрелок расставляются кружочки. В примере команда GetPointPositionAt написана со старым синтаксисом, поэтому может не работать. В зависимости от версии Вашего CorelDRAW, возможно, придётся поменять её на:

sp.GetPointPositionAt x, y, t, cdrRelativeSegmentOffset

 

[dik973]

Ответ: Разбить кривую на 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

Работает активной кривой

 

[dik973]

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

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