请教版主在AE中实现数据的符号化

请问如何在AE中实现数据的符号化

在开发帮助中的例子，经过改变但是不能使用

主要是因为使用了arcGIS中的对象库，在AE中找不到，我现在想问一下在AE中怎么实现数据符号化，感激不仅

'***************************************************
'名称：     SymbolInit
'功能描述： 初始化显示点、线、面对象时所用的Symbol
'传入参数： 无
'依赖关系： 无
'作者：    
'创建日期  

'***************************************************
Public Sub SymbolInit()
On Error GoTo errh
ReadIni
Dim pRen As ISimpleRenderer
Dim pGeoFeatLyr As IGeoFeatureLayer
 

Dim i As Integer
Dim l As Integer
For i = 0 To Form1.map1.LayerCount - 1
   For l = 1 To iMaxNum

      If Form1.map1.layer(i).Name = layer(l) Then

               Set pGeoFeatLyr = Form1.map1.layer(i)
               Set pRen = pGeoFeatLyr.Renderer
               
               Dim pSimpleRenderer As ISimpleRenderer
               Dim pSimpleMarkerSymbol As ISimpleMarkerSymbol
           
               Dim pRgbColor As IRgbColor
               
               Set pSimpleRenderer = New SimpleRenderer
               Set pSimpleMarkerSymbol = New SimpleMarkerSymbol
           
               Dim pStyleGal As IStyleGallery
               Dim pStyleStorage As IStyleGalleryStorage
               Dim pEnumStyleGall As IEnumStyleGalleryItem
               Dim pStyleItem As IStyleGalleryItem
               Set pStyleGal = New ServerStyleGallery
               Set pStyleStorage = pStyleGal
               pStyleStorage.TargetFile = App.Path ; "\water.ServerStyle"
               Set pEnumStyleGall = pStyleGal.Items("Marker Symbols", "", "")
               
               pEnumStyleGall.Reset
               Set pStyleItem = pEnumStyleGall.Next
               Do While Not pStyleItem Is Nothing
                       
                       If pStyleItem.Name = symindex(l) Then
                           Dim pSym As ISymbol
                           Set pSym = pStyleItem.Item
                           
                       GoTo ExitLOOP
                   End If
                   Set pStyleItem = pEnumStyleGall.Next
               Loop
ExitLOOP:
           Set pRen.Symbol = pSym
           Form1.map1.layer(i).Visible = show(l)
           
        End If

   Next
Next

Form1.map1.Refresh

errh:
 If Err.Number <> 0 Then
    MsgBox Err.Number ; Err.Description, vbOKOnly + vbInformation ; "2"
 End If
   
End Sub

感激不尽

这个问题,我也知道该这样做了,但是我的符号库是symbol.style 我用AE提供的工具MakeServerStyleset将他转换成symbol.serverstyle

但是在程序执行到

              Set pStyleItem = pEnumStyleGall.Next
               Do While Not pStyleItem Is Nothing
时   pstyleitem始终都是nothing

最后导致程序出错

是怎么回事

谢谢执教

我今天晚上又进行了试验

我把我的符号库文件拷到arcgis\bin\styles目录下后再利用makeserverstyleset.exe工具进行转换后程序执行到

Set pStyleItem = pEnumStyleGall.Next
               Do While Not pStyleItem Is Nothing
不会在出现pstyleitem一直是空值

但是在程序的运行过程中却出现了这样的问题

参见下面这段程序红色部分

Private Sub RendererLayers()

'On Error Resume Next

Dim pFeatureCount As Long

Dim pFeature As IFeature

Dim pGeoLayer As IGeoFeatureLayer

Dim pStyleStorage As IStyleGalleryStorage

Dim pStyleGalleryItem As IStyleGalleryItem

Dim pEnumStyleGalleryItem As IEnumStyleGalleryItem

Dim pStyleGallery As IStyleGallery

Dim pDefaultStyle As IStyleGalleryItem

Dim SymPointColor As IRgbColor

Dim SymLineColor As IRgbColor

Dim SymFillColor As IRgbColor

Dim pdefaultsymbol As ISimpleMarkerSymbol

Dim pdefaultsymbol1 As ISimpleLineSymbol

Dim pdefaultsymbol2 As ISimpleFillSymbol

Dim pGeoFeaLayer As IGeoFeatureLayer

Dim pQueryFilter As IQueryFilter

Dim pFeaCursor As IFeatureCursor

Dim StylePath As String

Dim PrendererValue As String

Dim i, j, k, L, Flag As Integer

Dim StyleFlag, ValExit As Boolean

Dim pUVRenderer As IUniqueValueRenderer

Dim pSymbolType As ISymbol

   

 If pFeatureLayers(0) Is Nothing Then Exit Sub

   Set pStyleGallery = New ServerStyleGallery

      ' pStyleGallery.ImportStyle "D:\Program Files\ArcGIS\Styles\Esri.ServerStyle"

   Set pStyleStorage = pStyleGallery

   'MsgBox pStyleStorage.FileCount

       pStyleStorage.TargetFile = "D:\Program Files\ArcGIS\Styles\symbol.ServerStyle"

   '''''''''''''''''查找符号库

   For j = 0 To pStyleStorage.FileCount - 1

        If UCase(pStyleStorage.File(j)) = UCase(App.Path) ; "\SYMBOL.SERVERSTYLE" Then

           StyleFlag = True

        Else

        'MsgBox pStyleStorage.File(j)

           StyleFlag = False

       End If

   Next j

   ''''''''''''''''''''''''''''设置默认符号

   Set pDefaultStyle = New ServerStyleGalleryItem

   Set pdefaultsymbol = New SimpleMarkerSymbol

   Set pdefaultsymbol1 = New SimpleLineSymbol

   Set pdefaultsymbol2 = New SimpleFillSymbol

'  If Not StyleFlag Then

'     StylePath = App.Path ; "\symbol.ServerStyle"

'     pStyleStorage.AddFile StylePath

'  End If

   ''''''''''''''''设置以那个字段来作为符号化的标准，以及字段的数量

 Set pUVRenderer = New UniqueValueRenderer

     pUVRenderer.FieldCount = 1

     pUVRenderer.Field(0) = "名称"

   

   

   

 Dim pFeatureLayer As IFeatureLayer

 Dim pFeatureClass As IFeatureClass

 

 For i = 0 To UBound(pFeatureLayers)

     Set pFeatureLayer = pFeatureLayers(i)

     Set pFeatureClass = pFeatureLayer.FeatureClass

     

     Select Case UCase(pFeatureClass.AliasName)

                         

                '/////////////////改进

                Case "SDE.DBO.WNNJS"

                      Set pUVRenderer = New UniqueValueRenderer

                      pUVRenderer.FieldCount = 1

                      pUVRenderer.Field(0) = "JLX"

                Case "SDE.DBO.WPPGD"

                      Set pUVRenderer = New UniqueValueRenderer

                      pUVRenderer.FieldCount = 1

                      pUVRenderer.Field(0) = "GXLX"

                Case Else

                     Set pUVRenderer = New UniqueValueRenderer

                      pUVRenderer.FieldCount = 1

                      pUVRenderer.Field(0) = "JDLX"

               ''/////////////////////////////////

                         

     End Select

     '////////////////////确定当前图层是用那种符号类型

     'Set pEnumStyleGalleryItem = New EnumServerStyleGalleryItem

     

     Select Case pFeatureClass.ShapeType

          Case 1

               Set pSymbolType = New SimpleMarkerSymbol

                   Flag = 0

               Set pEnumStyleGalleryItem = pStyleGallery.Items("marker symbols", "", "")

          Case 3

               Set pSymbolType = New SimpleLineSymbol

                   Flag = 1

               Set pEnumStyleGalleryItem = pStyleGallery.Items("line symbols", "", "")

          Case 4

              GoTo 30000

               Set pSymbolType = New SimpleFillSymbol

               Set pEnumStyleGalleryItem = pStyleGallery.Items("fill symbols", "", "")

               

     End Select

       

       

     

      Set pGeoLayer = pFeatureLayer

 

          pFeatureCount = pFeatureClass.FeatureCount(Nothing)

   

 

      Set pFeaCursor = pFeatureClass.Search(Nothing, False)

     

     

      For k = 0 To pFeatureCount - 1

         Dim tempval As String

         Set pFeature = pFeaCursor.NextFeature

             If UCase(pFeature.Class.AliasName) = "SDE.DBO.WPPGD" Then

                    If Not IsNull(pFeature.Value(pFeature.Fields.FindField("GXLX"))) Then

                         PrendererValue = Trim(pFeature.Value(pFeature.Fields.FindField("GXLX")))

                    Else

                         PrendererValue = ""

                    End If

             ElseIf UCase(pFeature.Class.AliasName) = "SDE.DBO.WNNJS" Then

                    If Not IsNull(pFeature.Value(pFeature.Fields.FindField("JLX"))) Then

                         PrendererValue = Trim(pFeature.Value(pFeature.Fields.FindField("JLX")))

                    Else

                         PrendererValue = ""

                    End If

             Else

                    If Not IsNull(pFeature.Value(pFeature.Fields.FindField("JDLX"))) Then

                          PrendererValue = Trim(pFeature.Value(pFeature.Fields.FindField("JDLX")))

                    Else

                          PrendererValue = ""

                    End If

             End If

             

         If tempval <> PrendererValue Then

            tempval = PrendererValue

            ValExit = False

         Else

            ValExit = True

        End If

        Dim pValueCount As Integer

            pValueCount = 0

        For pValueCount = 0 To pUVRenderer.ValueCount - 1

            If pUVRenderer.Value(pValueCount) = PrendererValue Then

                ValExit = True

                Exit For

            End If

        Next pValueCount

       

        If Not ValExit Then

           ' pUVRenderer.AddValue

            pUVRenderer.AddValue PrendererValue, "类型", pSymbolType

            pUVRenderer.Label(PrendererValue) = PrendererValue

            pUVRenderer.Symbol(PrendererValue) = pSymbolType

        End If

     Next k

       

     For L = 0 To pUVRenderer.ValueCount - 1

       Dim val As String

       val = pUVRenderer.Value(L)

            If val <> "" Then

                   pEnumStyleGalleryItem.Reset

                  Set pStyleGalleryItem = pEnumStyleGalleryItem.Next

                  Do While Not pStyleGalleryItem Is Nothing

                           If pStyleGalleryItem.Name = val Then

                              pUVRenderer.Symbol(val) = pStyleGalleryItem.Item

                              'Set pGeoLayer = pFeatureLayer

                              'Set pGeoLayer.Renderer = pUVRenderer

                              Exit Do

                           Else

                           Select Case Flag

                                  Case 0

                                       Set pGeoLayer = pFeatureLayer

                                       Set SymPointColor = New RgbColor

                                       SymPointColor.RGB = vbGreen

                                       Set pDefaultStyle = New ServerStyleGalleryItem

                         

                                       Set pdefaultsymbol = New SimpleMarkerSymbol

                                       pdefaultsymbol.Color = SymPointColor

                                       pdefaultsymbol.Size = 4

                                       pdefaultsymbol.Style = esriSMSCircle

                                       pDefaultStyle.Item = pdefaultsymbol

                           

                                       pUVRenderer.Symbol(val) = pdefaultsymbol

                     

                                  Case 1

                                       Set pGeoLayer = pFeatureLayer

                                       Set SymLineColor = New RgbColor

                                       SymLineColor.RGB = vbGreen

                                       Set pDefaultStyle = New ServerStyleGalleryItem

                         

                                       Set pdefaultsymbol1 = New SimpleLineSymbol

                                       pdefaultsymbol1.Color = SymLineColor

                                       pdefaultsymbol1.Width = 1

                                       pdefaultsymbol1.Style = esriSLSSolid

                                       pDefaultStyle.Item = pdefaultsymbol1

                           

                                       pUVRenderer.Symbol(val) = pdefaultsymbol1

                           End Select

                           End If

                         Set pStyleGalleryItem = pEnumStyleGalleryItem.Next

                  Loop

             End If

       

   Next L

      Set pGeoLayer.Renderer = pUVRenderer

      Set pUVRenderer = Nothing

     

30000: Next i

 frmmain.MapControl1.ActiveView.ContentsChanged

 

 frmmain.MapControl1.ActiveView.Refresh

 frmmain.MapControl1.ActiveView.PartialRefresh esriViewGeography, Nothing, Nothing

在代码中绿色部分运行时出现

automation error

请教版主这个问题是怎么回事

你遇到过这样的问题吗？

有人说是arcgis的bug是这样的吗？

你确定你的servestyle里已经有符号了吗？

你是不是没有安装arcgis desktop？

在9。0版本没有安装arcgis desktop，arcengine显示符号是有问题的

6楼的说得对，5楼的同胞，我的符号库中已经确定有符号了

我在安装了Desktop的机器使用也会出现问题

经过修改后问题解决

但是当我将程序打包后安装到一台只有runtime的机器上后，上面提到的问题又出现了

难道正的是ArcEngine的Bug

郁闷 郁闷