Sub Test() Dim s As Shape, sr As ShapeRange Set s = ActiveLayer.CreateArtisticText(0, 0, "O", , , "Arial Black", 48) s.ConvertToCurves Set sr = s.BreakApartEx sr(1).Move 0, 0.2 sr.CombineEnd Sub