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
- Start ArcMap and open the Visual Basic editor.
- Copy and paste the code below into the Project code window.
- Close the editor window, and run the MakeFontStyle macro by pressing ALT+F8.
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