Sub Test() Dim c As New PatternCanvas c.Size = cdrPatternCanvas32x32 c.Clear c.Line (0, 0)-(31, 31) c.Line (5, 5)-(27, 27), , B c.PSet (30, 2) c.PSet (2, 30) With ActiveLayer.CreateRectangle(0, 0, 2, 2) .Fill.ApplyPatternFill cdrTwoColorPattern .Fill.Pattern.Canvas = c End WithEnd Sub