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