|
阅读：1124回复：1
帮忙看看这段代码！！！！急急急
<P>我要做的功能是，用不同颜色标注不同属性值的设施</P>
<P>（测试的时候，是选择了一个管线图层，设置了管线的口径字段名，想要看到的效果是代码根据口径分5个等级，分5种颜色，显示管线）</P> <P>Public Function ClassBreakRender(pFeaturelayer As IFeatureLayer, pFieldName As String)<BR> Dim pGeoFeatureLayer As IGeoFeatureLayer<BR> Dim pTable As ITable<BR> Dim pClassify As IClassify<BR> Dim pTableHistogram As ITableHistogram<BR> Dim pHistogram As IHistogram<BR> Dim pDataFrequency As Variant<BR> Dim pDataValues As Variant<BR> <BR> Dim pClassBreaksRender As IClassBreaksRenderer<BR> Dim pFromColor As IHsvColor<BR> Dim pToColor As IHsvColor<BR> Dim pAlgorithmicCR As IAlgorithmicColorRamp<BR> Dim pEnumColors As IEnumColors<BR> Dim pColor As IColor<BR> Dim pSimpleFillS As ISimpleFillSymbol<BR> Dim lBreakIndex As Long<BR> 'Dim numDesiredClasses As Long<BR> Dim ClassesCount As Long<BR> Const numDesiredClasses As Long = 5<BR>On Error GoTo ErrorHandler:<BR> Set pGeoFeatureLayer = pFeaturelayer<BR> Set pTable = pGeoFeatureLayer<BR> Set pTableHistogram = New TableHistogram<BR> Set pHistogram = pTableHistogram<BR> <BR> pTableHistogram.field = pFieldName<BR> Set pTableHistogram.Table = pTable<BR> pHistogram.GetHistogram pDataValues, pDataFrequency<BR> <BR> Set pClassify = New EqualInterval<BR> pClassify.SetHistogramData pDataValues, pDataFrequency<BR> <BR> pClassify.Classify numDesiredClasses<BR> Classes = pClassify.ClassBreaks<BR> ClassesCount = UBound(Classes)<BR> <BR> Set pClassBreaksRender = New ClassBreaksRenderer<BR> pClassBreaksRender.field = pFieldName<BR> pClassBreaksRender.BreakCount = ClassesCount<BR> pClassBreaksRender.SortClassesAscending = True<BR> <BR> Set pFromColor = New HsvColor<BR> pFromColor.Hue = 60<BR> pFromColor.Saturation = 100<BR> pFromColor.value = 96<BR> <BR> Set pToColor = New HsvColor<BR> pToColor.Hue = 0<BR> pToColor.Saturation = 100<BR> pToColor.value = 96<BR> <BR> Set pAlgorithmicCR = New AlgorithmicColorRamp<BR> pAlgorithmicCR.Algorithm = esriHSVAlgorithm<BR> pAlgorithmicCR.FromColor = pFromColor<BR> pAlgorithmicCR.ToColor = pToColor<BR> pAlgorithmicCR.Size = ClassesCount<BR> pAlgorithmicCR.CreateRamp True<BR> Set pEnumColors = pAlgorithmicCR.Colors<BR> <BR> For lBreakIndex = 0 To ClassesCount - 1<BR> Set pColor = pEnumColors.Next<BR> Set pSimpleFillS = New SimpleFillSymbol<BR> pSimpleFillS.Color = pColor<BR> pSimpleFillS.Style = esriSFSSolid<BR> pClassBreaksRender.Symbol(lBreakIndex) = pSimpleFillS<BR> pClassBreaksRender.Break(lBreakIndex) = Classes(lBreakIndex + 1)<BR> Next lBreakIndex<BR> Set pGeoFeatureLayer.Renderer = pClassBreaksRender‘ 这句运行时就出错，查看错误是空，没有提示，<BR> g_pActiveView.Refresh<BR> <BR> <BR>ErrorHandler:<BR> MsgBox Err.Description<BR>End Function<BR></P> |
|
|
1楼#
发布于：2005-10-10 14:31
<P>我看了一下你的代码，测试的时候，你是选择了一个管线图层，因此应该使用ISimpleLineSymbol而不是ISimpleFillSymbol，线状要素是没有填充色的。以下是我改过的代码，其实改动地方很少的。</P>
<P>Public Function ClassBreakRender(pFeaturelayer As IFeatureLayer, pFieldName As String)<BR> Dim pGeoFeatureLayer As IGeoFeatureLayer<BR> Dim pTable As ITable<BR> Dim pClassify As IClassify<BR> Dim pTableHistogram As ITableHistogram<BR> Dim pHistogram As IHistogram<BR> Dim pDataFrequency As Variant<BR> Dim pDataValues As Variant<BR> <BR> Dim pClassBreaksRender As IClassBreaksRenderer<BR> Dim pFromColor As IHsvColor<BR> Dim pToColor As IHsvColor<BR> Dim pAlgorithmicCR As IAlgorithmicColorRamp<BR> Dim pEnumColors As IEnumColors<BR> Dim pColor As IColor<BR> Dim pSimpleFillS As ISimpleFillSymbol<BR> Dim pLineSymbol As ISimpleLineSymbol<BR> Dim lBreakIndex As Long<BR> 'Dim numDesiredClasses As Long<BR> Dim ClassesCount As Long<BR> Dim Classes As Variant<BR> Const numDesiredClasses As Long = 5<BR>On Error GoTo ErrorHandler:<BR> Set pGeoFeatureLayer = pFeaturelayer<BR> Set pTable = pGeoFeatureLayer<BR> Set pTableHistogram = New TableHistogram<BR> Set pHistogram = pTableHistogram<BR> <BR> pTableHistogram.Field = pFieldName<BR> Set pTableHistogram.Table = pTable<BR> pHistogram.GetHistogram pDataValues, pDataFrequency<BR> <BR> Set pClassify = New EqualInterval<BR> pClassify.SetHistogramData pDataValues, pDataFrequency<BR> <BR> pClassify.Classify numDesiredClasses<BR> Classes = pClassify.ClassBreaks<BR> ClassesCount = UBound(Classes)<BR> <BR> Set pClassBreaksRender = New ClassBreaksRenderer<BR> pClassBreaksRender.Field = pFieldName<BR> pClassBreaksRender.BreakCount = ClassesCount<BR> pClassBreaksRender.SortClassesAscending = True<BR> <BR> Set pFromColor = New HsvColor<BR> pFromColor.hue = 60<BR> pFromColor.saturation = 100<BR> pFromColor.Value = 96<BR> <BR> Set pToColor = New HsvColor<BR> pToColor.hue = 0<BR> pToColor.saturation = 100<BR> pToColor.Value = 96<BR> <BR> Set pAlgorithmicCR = New AlgorithmicColorRamp<BR> pAlgorithmicCR.Algorithm = esriHSVAlgorithm<BR> pAlgorithmicCR.FromColor = pFromColor<BR> pAlgorithmicCR.ToColor = pToColor<BR> pAlgorithmicCR.Size = ClassesCount<BR> pAlgorithmicCR.CreateRamp True<BR> Set pEnumColors = pAlgorithmicCR.Colors<BR> <BR> For lBreakIndex = 0 To ClassesCount - 1<BR> Set pColor = pEnumColors.Next<BR>'********************原先的代码***********************************<BR>' Set pSimpleFillS = New SimpleFillSymbol<BR>' pSimpleFillS.Color = pColor<BR>' pSimpleFillS.Style = esriSFSSolid<BR>' pClassBreaksRender.Symbol(lBreakIndex) = pSimpleFillS<BR>' pClassBreaksRender.Break(lBreakIndex) = Classes(lBreakIndex + 1)<BR>'********************改动后的代码***********************************<BR> Set pLineSymbol = New SimpleLineSymbol<BR> pLineSymbol.Color = pColor<BR> pLineSymbol.Style = esriSLSSolid<BR> pClassBreaksRender.Symbol(lBreakIndex) = pLineSymbol<BR> pClassBreaksRender.Break(lBreakIndex) = Classes(lBreakIndex + 1)<BR> <BR> Next lBreakIndex<BR> Set pGeoFeatureLayer.Renderer = pClassBreaksRender ' 这句运行时就出错，查看错误是空，没有提示，<BR> g_pActiveView.refresh<BR> <BR> <BR>ErrorHandler:<BR> MsgBox Err.Description<BR>End Function<BR></P> |
|