MY TOTAL CODE....This takes a selected set and changes the colors to user specs....I am doing some selecting in another sub and then call this to render the polygonsSub CreateAndApplyUVRenderer()
Dim pApp As Application
Dim pDoc As IMxDocument
Set pDoc = ThisDocument
Dim pMap As IMap
Set pMap = pDoc.FocusMap
Dim pLayer As ILayer
Set pLayer = pMap.Layer(0)
Dim pFLayer As IFeatureLayer
Set pFLayer = pLayer
Dim pLyr As IGeoFeatureLayer
Set pLyr = pFLayer
Dim pFeatCls As IFeatureClass
Set pFeatCls = pFLayer.FeatureClass
Dim pQueryFilter As IQueryFilter
Set pQueryFilter = New QueryFilter 'empty supports: SELECT *
Dim pFeatCursor As IFeatureCursor
Set pFeatCursor = pFeatCls.Search(pQueryFilter, False)
'** Make the renderer
Dim pRender As IUniqueValueRenderer, n As Long
Set pRender = New UniqueValueRenderer
Dim symd As ISimpleFillSymbol
Set symd = New SimpleFillSymbol
symd.Style = esriSFSSolid
symd.Outline.Width = 0.4
'** These properties should be set prior to adding values
pRender.FieldCount = 1
pRender.Field(0) = "CLASS"
pRender.DefaultSymbol = symd
pRender.UseDefaultSymbol = True
Dim pFeat As IFeature
n = pFeatCls.FeatureCount(pQueryFilter)
'** Loop through the features
Dim i As Integer
i = 0
Dim ValFound As Boolean
Dim NoValFound As Boolean
Dim uh As Integer
Dim pFields As IFields
Dim iField As Integer
Set pFields = pFeatCursor.Fields
iField = pFields.FindField("CLASS")
Do Until i = n
Dim symx As ISimpleFillSymbol
Set symx = New SimpleFillSymbol
symx.Style = esriSFSSolid
symx.Outline.Width = 0.4
Set pFeat = pFeatCursor.NextFeature
Dim x As String
x = pFeat.Value(iField) '*new Cory*
'** Test to see if we've already added this value
'** to the renderer, if not, then add it.
ValFound = False
For uh = 0 To (pRender.ValueCount - 1)
If pRender.Value(uh) = x Then
NoValFound = True
Exit For
End If
Next uh
If Not ValFound Then
pRender.AddValue x, "Tornado Damage Totals", symx
pRender.Label(x) = x
pRender.Symbol(x) = symx
End If
i = i + 1
Loop
For ny = 0 To (pRender.ValueCount - 1)
Dim xv As String
xv = pRender.Value(ny)
If xv <> "" Then
Dim pColor As IRgbColor
Set pColor = New RgbColor
Select Case xv
Case "1"
pColor.RGB = RGB(255, 0, 0)
Case "2"
pColor.RGB = RGB(0, 92, 230)
Case "3"
pColor.RGB = RGB(112, 168, 0)
Case "4"
pColor.RGB = RGB(169, 0, 230)
Case "5"
pColor.RGB = RGB(0, 77, 168)
Case "6"
pColor.RGB = RGB(255, 115, 223)
Case "7"
pColor.RGB = RGB(209, 255, 115)
Case "8"
pColor.RGB = 115
Case "9"
pColor.RGB = RGB(230, 230, 0)
Case "10"
pColor.RGB = RGB(115, 115, 0)
Case "11"
pColor.RGB = RGB(115, 76, 0)
Case "12"
pColor.RGB = RGB(112, 68, 137)
Case "13"
pColor.RGB = RGB(230, 152, 0)
Case "14"
pColor.RGB = RGB(200, 150, 100)
End Select
Dim pPoly As ISimpleFillSymbol
Set pPoly = pRender.Symbol(pRender.Value(ny))
pPoly .Color = pColor
pRender.Symbol(pRender.Value(ny)) = pPoly
End If
Next ny
'** If you didn't use a color ramp that was predefined
'** in a style, you need to use "Custom" here, otherwise
'** use the name of the color ramp you chose.
pRender.ColorScheme = "General"
pRender.fieldType(0) = True
Set pLyr.Renderer = pRender
pLyr.DisplayField = "CLASS"
'** This makes the layer properties symbology tab show
'** show the correct interface.
Dim hx As IRendererPropertyPage
Set hx = New UniqueValuePropertyPage
pLyr.RendererPropertyPageClassID = hx.ClassID
' Set the transpareny of the new layer
If TypeOf pLyr Is ILayerEffects Then
Dim pLayerEffects As ILayerEffects
Set pLayerEffects = pLyr
pLayerEffects.Transparency = 50
End If
'** Refresh the TOC
pDoc.ActiveView.ContentsChanged
pDoc.UpdateContents
'** Draw the map
pDoc.ActiveView.Refresh
End Sub
