'这个过程完成了加载的全过成 '日期:2005-09-15 Public Sub TruetypeToStyle() Dim pStyleGallery As IStyleGallery 'Style文件的编辑环境 Dim pStyleGalleryItem As IStyleGalleryItem '符号库中的一个符号队形 'Dim pMarkerSymbolStyleGalleryClass As IStyleGalleryClass Dim pItems As IEnumStyleGalleryItem '一组符号 Dim pStylStor As IStyleGalleryStorage '管理编辑环境中的文件对象 Dim pCharMarkerSym As ICharacterMarkerSymbol '将要添加到Style文件中的符号 Dim pFont As IFont '字体 Dim pFilePath As String '自定义Style文件的路径 Dim pTargetFile As String '目标文件 '将自定义Style文件添加到StyleGallery Set pStylStor = New StyleGallery Set pStyleGallery = pStylStor pFilePath = pStylStor.DefaultStylePath & "CustomStyle.style" pTargetFile = pStylStor.TargetFile If pTargetFile = pFilePath Then '系统会默认一个路径 Else pStylStor.TargetFile = pFilePath pStylStor.AddFile pFilePath End If '创建各个符号对象 Set pFont = New SystemFont pFont.Name = "Cityblueprint" pFont.Italic = True Dim pCount As Long Dim pColor As IColor Set pColor = New RgbColor pColor.RGB = RGB(255, 0, 0) '要加载所有的字体中的符号需要你记下字体中的符号数目 Dim i As Long i = 0 Set pCharMarkerSym = New CharacterMarkerSymbol With pCharMarkerSym .Angle = 0 .Font = pFont .CharacterIndex = i .Color = pColor .size = 20 .XOffset = 0 .YOffset = 0 End With Do While Not pCharMarkerSym Is Nothing Set pStyleGalleryItem = New StyleGalleryItem With pStyleGalleryItem .Category = "Default" .Name = "Try" + CStr(i) .Item = pCharMarkerSym End With '将创建的符号添加到指定的Style文件中去 pStyleGallery.AddItem pStyleGalleryItem i = i + 1 If i >= 400 Then Exit Do End If pCharMarkerSym.CharacterIndex = i Loop '删除添加的条目 'Set pItems = pStyleGallery.Items("Marker Symbols", pFilePath, "Default") 'pItems.Reset 'Dim pItem As IStyleGalleryItem 'Dim j As Long 'j = 0 'Set pItem = pItems.Next 'Do While Not pItem Is Nothing ' pStyleGallery.RemoveItem pItem 'Set pItem = pItems.Next ' j = j + 1 ' Loop '清空内存 'pStylStor.RemoveFile pFilePath Set pStyleGallery = Nothing Set pStyleGalleryItem = Nothing Set pCharMarkerSym = Nothing Set pItems = Nothing Set pFont = Nothing Set pStylStor = Nothing Set pColor = Nothing 'Set pItem = Nothing End Sub '功能:把Style文件从Style管理器中移出 '日期:2005-09-15 Public Sub RemoveFileFromStyleManager() Dim pStyleGallery As IStyleGallery 'Style文件的编辑环境 Dim pStylStor As IStyleGalleryStorage '管理编辑环境中的文件对象 Dim pFilePath As String '自定义Style文件的路径 '将自定义Style文件添加到StyleGallery Set pStylStor = New StyleGallery Set pStyleGallery = pStylStor pFilePath = pStylStor.DefaultStylePath & "CustomStyle.style" pStylStor.RemoveFile pFilePath '清空内存 Set pStyleGallery = Nothing Set pStyleGalleryItem = Nothing pFilePath = "" End Sub '功能:删除指定Style文件中的符号 '日期:2005-09-15 Public Sub RemoveItem() Dim pItems As IEnumStyleGalleryItem '一组符号 Dim pStyleGallery As IStyleGallery 'Style文件的编辑环境 Dim pFilePath As String Dim pStylStor As IStyleGalleryStorage '管理编辑环境中的文件对象 pFilePath = "D:\Program Files\ArcGIS\Bin\Styles\CustomStyle.style" Set pStyleGallery = New StyleGallery Set pStylStor = pStyleGallery pStylStor.AddFile pFilePath Set pItems = pStyleGallery.Items("Marker Symbols", pFilePath, "Default") pItems.Reset If pItems Is Nothing Then Exit Sub End If '删除添加的条目 Dim pItem As IStyleGalleryItem Dim j As Long j = 0 Set pItem = pItems.Next Do While Not pItem Is Nothing pStyleGallery.RemoveItem pItem Set pItem = pItems.Next j = j + 1 Loop End Sub 注释:这个这些功能的总体思路是 1、将Style文件添加到Style文件管理器 2、创建一个符号 3、将符号添加到Style文件