Sub Test() Dim sp As SubPath Dim x As Double, y As Double ActiveDocument.ReferencePoint = cdrBottomLeft For Each sp In ActiveShape.Curve.Subpaths sp.GetPosition x, y ActiveLayer.CreateRectangle2 x, y, sp.SizeWidth, sp.SizeHeight Next spEnd Sub