Sub Test() Dim s As Shape Dim sgr As SegmentRange Set s = ActiveLayer.CreateArtisticText(0, 0, "B") With s.Text.FontProperties .Name = "Arial Black" .Size = 200 End With s.ConvertToCurves s.Curve.Subpaths(3).Delete s.Curve.Subpaths(2).DeleteEnd Sub