Sub Test() Dim c As New PatternCanvas c.PutCopy PatternCanvases(4) c.RotateArea 0, 0, c.Width - 1, c.Height - 1, 90 With ActiveLayer.CreateRectangle(0, 0, 2, 2) .Fill.ApplyPatternFill cdrTwoColorPattern .Fill.Pattern.Canvas = c End WithEnd Sub