Sub Test() Dim s As Shape For Each s In ActivePage.Shapes If s.Outline.Type = cdrOutline Then s.Outline.Color.ConvertToGray End If Next sEnd Sub
Sub Test() Dim seg As Segment Dim sr As New ShapeRange Dim s As Shape, st As Shape Dim Steps As Long Set s = ActiveShape Optimization = True If s Is Nothing Then MsgBox "Nothing is selected." Exit Sub End If If s.Type <> cdrCurveShape Then MsgBox "A curve must be selected. Try again." Exit Sub End If If s.Outline.Type = cdrNoOutline Then MsgBox "The curve must have an outline. Try again." Exit Sub End If Steps = s.Curve.Segments.Count For Each seg In s.Curve.Segments Select Case seg.Type Case cdrLineSegment Set st = ActiveLayer.CreateLineSegment( _ seg.StartNode.PositionX, seg.StartNode.PositionY, _ seg.EndNode.PositionX, seg.EndNode.PositionY) Case cdrCurveSegment Set st = ActiveLayer.CreateCurveSegment( _ seg.StartNode.PositionX, seg.StartNode.PositionY, _ seg.EndNode.PositionX, seg.EndNode.PositionY, _ seg.StartingControlPointLength, _ seg.StartingControlPointAngle, _ seg.EndingControlPointLength, _ seg.EndingControlPointAngle) End Select st.Outline.Width = s.Outline.Width st.Outline.Color.RGBAssign 255 * seg.Index / Steps, 0, 0 sr.Add st Next seg sr.Group Optimization = False ActiveWindow.RefreshEnd Sub