Solved! Go to Solution.
Protected Overrides Sub OnClick()
Dim pCV As ESRI.ArcGIS.ArcMapUI.IContentsView
Dim pGFLayer As ESRI.ArcGIS.Carto.IGeoFeatureLayer
Dim pLayer As ESRI.ArcGIS.Carto.ILayer
Dim pRPPage As ESRI.ArcGIS.CartoUI.IRendererPropertyPage
Dim pSet As ESRI.ArcGIS.esriSystem.ISet = New ESRI.ArcGIS.esriSystem.Set
Dim ShapeType As String
Try
If Not theDict.ContainsKey("HDX.Point Legend") Then CreateRenderer()
pCV = My.ArcMap.Document.CurrentContentsView
If TypeOf pCV.SelectedItem Is ESRI.ArcGIS.Carto.IGeoFeatureLayer Then
pGFLayer = pCV.SelectedItem
If pGFLayer.FeatureClass.ShapeType = ESRI.ArcGIS.Geometry.esriGeometryType.esriGeometryPoint Then
ShapeType = "Point"
ElseIf pGFLayer.FeatureClass.ShapeType = ESRI.ArcGIS.Geometry.esriGeometryType.esriGeometryPolyline Then
ShapeType = "Line"
ElseIf pGFLayer.FeatureClass.ShapeType = ESRI.ArcGIS.Geometry.esriGeometryType.esriGeometryPolygon Then
ShapeType = "Polygon"
Else
Exit Sub
End If
pGFLayer.Renderer = theDict.Item("HDX." & ShapeType & " Legend")
pRPPage = New ESRI.ArcGIS.CartoUI.UniqueValuePropertyPage
pGFLayer.RendererPropertyPageClassID = pRPPage.ClassID
ElseIf TypeOf pCV.SelectedItem Is ESRI.ArcGIS.esriSystem.ISet Then
pSet = pCV.SelectedItem
pLayer = pSet.Next
Do Until pLayer Is Nothing
If TypeOf pLayer Is ESRI.ArcGIS.Carto.IGeoFeatureLayer Then
pGFLayer = pLayer
If pGFLayer.FeatureClass.ShapeType = ESRI.ArcGIS.Geometry.esriGeometryType.esriGeometryPoint Or pGFLayer.FeatureClass.ShapeType = ESRI.ArcGIS.Geometry.esriGeometryType.esriGeometryPolyline Or pGFLayer.FeatureClass.ShapeType = ESRI.ArcGIS.Geometry.esriGeometryType.esriGeometryPolygon Then
If pGFLayer.FeatureClass.ShapeType = ESRI.ArcGIS.Geometry.esriGeometryType.esriGeometryPoint Then
ShapeType = "Point"
ElseIf pGFLayer.FeatureClass.ShapeType = ESRI.ArcGIS.Geometry.esriGeometryType.esriGeometryPolyline Then
ShapeType = "Line"
ElseIf pGFLayer.FeatureClass.ShapeType = ESRI.ArcGIS.Geometry.esriGeometryType.esriGeometryPolygon Then
ShapeType = "Polygon"
Else
Exit Sub
End If
pGFLayer.Renderer = theDict.Item("HDX." & ShapeType & " Legend")
pRPPage = New ESRI.ArcGIS.CartoUI.UniqueValuePropertyPage
pGFLayer.RendererPropertyPageClassID = pRPPage.ClassID
End If
End If
pLayer = pSet.Next
Loop
End If
My.ArcMap.Document.ActiveView.ContentsChanged()
My.ArcMap.Document.UpdateContents()
My.ArcMap.Document.ActiveView.Refresh()
Catch ex As Exception
System.Windows.Forms.MessageBox.Show(ex.ToString, "Create Legend error")
End Try
End Sub
Friend Sub CreateRenderer()
Dim FieldInfo() As Object
Dim IsOK As Boolean
Dim ItemCount As Integer = 0
Dim ItemList() As Object
Dim LegendText As String
Dim pBlack As ESRI.ArcGIS.Display.IRgbColor = New ESRI.ArcGIS.Display.RgbColor
Dim pLineColorEnum As ESRI.ArcGIS.Display.IEnumColors
Dim pLineSym As ESRI.ArcGIS.Display.ISimpleLineSymbol = New ESRI.ArcGIS.Display.SimpleLineSymbol
Dim pLineUVRenderer As ESRI.ArcGIS.Carto.IUniqueValueRenderer = New ESRI.ArcGIS.Carto.UniqueValueRenderer
Dim pPink As ESRI.ArcGIS.Display.IRgbColor = New ESRI.ArcGIS.Display.RgbColor
Dim pPointColorEnum As ESRI.ArcGIS.Display.IEnumColors
Dim pPointSym As ESRI.ArcGIS.Display.ISimpleMarkerSymbol = New ESRI.ArcGIS.Display.SimpleMarkerSymbol
Dim pPointUVRenderer As ESRI.ArcGIS.Carto.IUniqueValueRenderer = New ESRI.ArcGIS.Carto.UniqueValueRenderer
Dim pPolygonColorEnum As ESRI.ArcGIS.Display.IEnumColors
Dim pPolygonOutline As ESRI.ArcGIS.Display.ISimpleLineSymbol = New ESRI.ArcGIS.Display.SimpleLineSymbol
Dim pPolygonSym As ESRI.ArcGIS.Display.ISimpleFillSymbol = New ESRI.ArcGIS.Display.SimpleFillSymbol
Dim pPolygonUVRenderer As ESRI.ArcGIS.Carto.IUniqueValueRenderer = New ESRI.ArcGIS.Carto.UniqueValueRenderer
Dim pRColorRamp As ESRI.ArcGIS.Display.IColorRamp = New ESRI.ArcGIS.Display.RandomColorRamp
Dim pRed As ESRI.ArcGIS.Display.IRgbColor = New ESRI.ArcGIS.Display.RgbColor
Try
For Each Key As Object In theDict.Keys
If IsNumeric(Key) Then ItemCount += 1
If CStr(Key) = "HDX.Field0" Then FieldInfo = theDict.Item(Key)
Next
pRColorRamp.Size = ItemCount
pRColorRamp.CreateRamp(IsOK)
If Not IsOK Then
System.Windows.Forms.MessageBox.Show("There was a problem in creating the legends for this scheme.", "No legends created", Windows.Forms.MessageBoxButtons.OK, Windows.Forms.MessageBoxIcon.Warning)
Exit Sub
End If
pPointColorEnum = pRColorRamp.Colors
pLineColorEnum = pRColorRamp.Colors
pPolygonColorEnum = pRColorRamp.Colors
pBlack.RGB = RGB(0, 0, 0)
pRed.RGB = RGB(255, 0, 0)
pPink.RGB = RGB(255, 190, 232)
pPointSym.Color = pRed
pPointSym.Size = 6
pPointSym.Style = ESRI.ArcGIS.Display.esriSimpleMarkerStyle.esriSMSX
With pPointUVRenderer
.FieldCount = 1
.Field(0) = FieldInfo(1)
.DefaultLabel = "Incorrectly classified"
.DefaultSymbol = pPointSym
.UseDefaultSymbol = True
End With
pLineSym.Color = pRed
pLineSym.Width = 2
pLineSym.Style = ESRI.ArcGIS.Display.esriSimpleLineStyle.esriSLSDash
With pLineUVRenderer
.FieldCount = 1
.Field(0) = FieldInfo(1)
.DefaultLabel = "Incorrectly classified"
.DefaultSymbol = pLineSym
.UseDefaultSymbol = True
End With
pPolygonOutline.Color = pRed
pPolygonOutline.Width = 2
pPolygonSym.Color = pPink
pPolygonSym.Outline = pPolygonOutline
With pPolygonUVRenderer
.FieldCount = 1
.Field(0) = FieldInfo(1)
.DefaultLabel = "Incorrectly classified"
.DefaultSymbol = pPolygonSym
.UseDefaultSymbol = True
End With
For Each Key As Object In theDict.Keys
If IsNumeric(Key) Then
pPointSym = New ESRI.ArcGIS.Display.SimpleMarkerSymbol
pPointSym.Color = pPointColorEnum.Next
pPointSym.Size = 6
pPointSym.Style = ESRI.ArcGIS.Display.esriSimpleMarkerStyle.esriSMSCircle
pLineSym = New ESRI.ArcGIS.Display.SimpleLineSymbol
pLineSym.Color = pLineColorEnum.Next
pLineSym.Width = 0.4
pPolygonSym = New ESRI.ArcGIS.Display.SimpleFillSymbol
pPolygonOutline = New ESRI.ArcGIS.Display.SimpleLineSymbol
pPolygonSym.Color = pPolygonColorEnum.Next
pPolygonOutline.Color = pBlack
pPolygonOutline.Width = 0.4
pPolygonSym.Outline = pPolygonOutline
ItemList = theDict.Item(Key)
LegendText = ""
For i As Integer = 1 To ItemList.GetUpperBound(0)
LegendText = LegendText & ItemList(i) & " | "
Next
LegendText = Left(LegendText, Len(LegendText) - 3)
With pPointUVRenderer
.AddValue(Key, "Description", pPointSym)
.Label(Key) = LegendText
.Symbol(Key) = pPointSym
End With
With pLineUVRenderer
.AddValue(Key, "Description", pLineSym)
.Label(Key) = LegendText
.Symbol(Key) = pLineSym
End With
With pPolygonUVRenderer
.AddValue(Key, "Description", pPolygonSym)
.Label(Key) = LegendText
.Symbol(Key) = pPolygonSym
End With
End If
Next
If theDict.ContainsKey("HDX.Point Legend") Then theDict.Remove("HDX.Point Legend")
theDict.Add("HDX.Point Legend", pPointUVRenderer)
If theDict.ContainsKey("HDX.Line Legend") Then theDict.Remove("HDX.Line Legend")
theDict.Add("HDX.Line Legend", pLineUVRenderer)
If theDict.ContainsKey("HDX.Polygon Legend") Then theDict.Remove("HDX.Polygon Legend")
theDict.Add("HDX.Polygon Legend", pPolygonUVRenderer)
Catch ex As Exception
System.Windows.Forms.MessageBox.Show(ex.ToString, "CreateRenderer")
End Try
End Sub