Sub Test() Dim nr As NodeRange Dim x1 As Double, y1 As Double Dim x2 As Double, y2 As Double Set nr = ActiveShape.Curve.Selection ActiveDocument.ReferencePoint = cdrTopLeft x1 = nr.PositionX y1 = nr.PositionY ActiveDocument.ReferencePoint = cdrBottomRight x2 = nr.PositionX y2 = nr.PositionY ActiveLayer.CreateRectangle x1, y1, x2, y2End Sub