请教版主在AE中实现数据符号化的问题（续）

楼主^#

更多发布于：2005-08-16 22:52

版主老大，麻烦你帮我看看这段代码，尤其是代码的红色部分
 
歧中红色部分中的绿色代码是程序的错误所在
出现 automation error 
 
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
 <st1:place w:st="on">Loop</st1:place>
 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

喜欢0 评分0

举报回复

发帖回复

« 返回列表

您需要登录后才可以回帖，登录或者注册

返回顶部

请教版主在AE中实现数据符号化的问题（续）

最新喜欢：