Sub Test() Dim s1 As Shape, s2 As Shape Set s1 = ActiveLayer.CreateRectangle2(0, 2, 3, 2) s1.Fill.ApplyFountainFill Set s2 = ActiveLayer.CreateEllipse2(1.5, 4.5, 1.5) s2.CreateLens(cdrLensHeatMap, 20).Lens.RemoveFace = True Set s2 = ActiveLayer.CreateEllipse2(1.5, 1.5, 1.5) s2.CreateLens(cdrLensHeatMap, 20).Lens.RemoveFace = FalseEnd Sub