等分曲线 CorelDRAW Vba

Sub 等分曲线()
    等分数 = 20
    Dim eff1 As Effect
    Dim s1 As Shape, s2 As Shape
    Dim n1 As Node, n2 As Node
    Set n1 = ActiveLayer.Shapes(1).Curve.SubPaths(1).StartNode
    Set n2 = ActiveLayer.Shapes(1).Curve.SubPaths(1).EndNode
    Set s1 = ActiveLayer.CreateEllipse2(n1.PositionX, n1.PositionY, 1 / 25.4, 1 / 25.4)
    Set s2 = ActiveLayer.CreateEllipse2(n2.PositionX, n2.PositionY, 1 / 25.4, 1 / 25.4)

    Set eff1 = s1.CreateBlend(s2, 等分数, cdrDirectFountainFillBlend, cdrBlendSteps, 0.393701, 0#, False, Nothing, False, 0, 0, False)
    eff1.Blend.LinkAcceleration = True
    eff1.Blend.Steps = 等分数 - 1
    eff1.Blend.Path = ActiveLayer.Shapes(4)
    ActivePage.Shapes.All.CreateSelection
    ActiveSelection.Separate
    Dim grp1 As ShapeRange
    Set grp1 = ActiveSelection.UngroupAllEx
    ActiveDocument.CreateShapeRangeFromArray(grp1(等分数 + 1), grp1(等分数 + 2)).ConvertToCurves
    Debug.Print "1/" & 等分数 & "点坐标", ActiveLayer.Shapes(等分数).CenterX * 25.4, ActiveLayer.Shapes(等分数).CenterY * 25.4      '输出等分点坐标
    k = ActiveLayer.Shapes.Count - 1
    For i = 1 To k
        ActiveLayer.Shapes(1).Delete
    Next
End Sub

等分曲线 CorelDRAW Vba