Sub BreakApartNode()
'##断开节点 随机填充颜色
Dim s As Shape, sr As ShapeRange, sp As SubPath, nr As NodeRange
Set sr = ActivePage.Shapes.FindShapes()
Dim srBrokenCurves As New ShapeRange
Dim n As Long, num As Long
'loop thru shapes
For Each s In sr
s.Curve.SubPaths.First.AddNodeAt 0.333, cdrRelativeSegmentOffset
s.Curve.SubPaths.First.AddNodeAt 0.666, cdrRelativeSegmentOffset
'break nodes and curve
Set nr = s.Curve.Nodes.All
nr.BreakApart
nr.RemoveAll
srBrokenCurves.AddRange s.BreakApartEx
Next s
num = ActivePalette.ColorCount
For Each s In srBrokenCurves
n = CLng(Fix(Rnd() * num)) + 1
s.Outline.Color = ActivePalette.Color(n)
Next s
End Sub