Sub Test() Dim sr As ShapeRange Dim sPath As Shape, sShape As Shape, sWork As Shape Dim dWidth As Double, Offset As Double, Rest As Double, t As Double Dim x As Double, y As Double, a As Double, sx As Double, sy As Double Dim seg As Segment Set sr = ActiveSelectionRange If sr.Count <> 2 Then MsgBox "Please select two shapes", vbCritical Exit Sub End If If sr(1).Type <> cdrCurveShape Then MsgBox "Last selected shape must be a curve", vbCritical Exit Sub End If Set sPath = sr(1) Set sShape = sr(2) ActiveDocument.ReferencePoint = cdrCenter dWidth = sShape.SizeWidth sShape.GetPosition sx, sy Offset = dWidth / 2 For Each seg In sPath.Curve.Segments While seg.FindParamOffset(Offset, t, Rest) seg.GetPointPositionAt x, y, t, cdrParamSegmentOffset a = seg.GetTangentAt(t, cdrParamSegmentOffset) Set sWork = sShape.Duplicate(x - sx, y - sy) sWork.Rotate a Offset = Offset + dWidth Wend Offset = Rest Next segEnd Sub