将自定义符号写入STYLE文件

本文介绍如何使用VBA代码在ArcGIS中管理样式文件,包括添加自定义样式文件到样式库、移除样式文件及删除特定样式的步骤。

摘要生成于 C知道 ,由 DeepSeek-R1 满血版支持, 前往体验 >

 

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文件

 
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值