How to convert a font to MarkerSymbols


The code below demonstrates how you might create a series of MarkerSymbols from a TrueType Font. You can change the name of the font used to any True Type font available on your machine.

How to use

  1. Start ArcMap and open the Visual Basic editor.
  2. Copy and paste the code below into the Project code window.
  3. Close the editor window, and run the MakeFontStyle macro by pressing ALT+F8.
[VBA]
Public Sub MakeFontStyle()
    On Error GoTo errH
    '
    ' First, we define the Font which we want to convert to MarkerSymbols.
    '
    Dim strFontName As String
    strFontName = "ESRI Cartography"
    '
    ' Now get a reference to the StyleGallery.
    '
    Dim pStyleGallery As IStyleGallery, pStyleStorage As IStyleGalleryStorage
    Set pStyleGallery = New StyleGallery
    Set pStyleStorage = pStyleGallery
    '
    ' By default, the second file referenced will be your personal Style file.
    ' We will use this file for adding the new Markers to, by setting the
    ' TargetFile property.
    '
    pStyleStorage.TargetFile = pStyleStorage.File(1)
    '
    ' Now set up a basic CharacterMarkerSymbol to use as the basis for all the
    ' new symbols.
    '
    Dim pFont As stdole.StdFont, pRGB As IRgbColor, pBasicMarker As ICharacterMarkerSymbol
    
    Set pRGB = New RgbColor
    pRGB.RGB = 0
    
    Set pFont = New stdole.StdFont
    pFont.Name = strFontName
    
    Set pBasicMarker = New CharacterMarkerSymbol
    With pBasicMarker
        .Font = pFont
        .Color = pRGB
        .Angle = 0
        .Size = 14
        .XOffset = 0
        .YOffset = 0
    End With
    '
    ' Set up a StyleGalleryItem to use as the basis for the new items.
    '
    Dim pBasicStyleItem As IStyleGalleryItem
    Set pBasicStyleItem = New StyleGalleryItem
    pBasicStyleItem.Category = strFontName & " Markers"
    '
    ' Iterate from 0 to 255 - every ASCII character in the font.
    '
    Dim i As Integer, pMarker As ICharacterMarkerSymbol, pStyleItem As IStyleGalleryItem
    For i = 0 To 255
        '
        ' Create a new CharacterMarkerSymbol and set it's CharacterIndex.
        '
        Set pMarker = CloneMe(pBasicMarker)
        pMarker.CharacterIndex = i
        '
        ' Create a new StyleGalleryItem, set the MarkerSymbol, and add it to the gallery.
        '
        Set pStyleItem = CloneMe(pBasicStyleItem)
        pStyleItem.Item = pMarker
        pStyleItem.Name = "ChrIndex " & CStr(i)
        pStyleGallery.AddItem pStyleItem
    Next i
    '
    ' Here we open the StyleManager dialog so you can see your new symbols.
    '
    Dim pStyleDialog As IStyleDialog
    Set pStyleDialog = New StyleManagerDialog
    pStyleDialog.DoModal pStyleGallery, Application.hWnd
    
    Exit Sub
errH:
    If Err.Number <> 0 Then
        MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "MakeFontStyle Error"
    End If
End Sub

Private Function CloneMe(pClone As IClone) As IClone
    On Error GoTo errH
    '
    ' Clone the passed in item.
    '
    Set CloneMe = pClone.Clone
    
    Exit Function
errH:
    If Err.Number <> 0 Then
        MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "CloneMe Error"
    End If
End Function