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,布布扣,bubuko.com
原文地址:http://blog.csdn.net/a814153a/article/details/37530985