You are here: > ESRI Forums > arcgis desktop discussion forums > Thread Replies

ArcGIS Desktop Discussion Forums

ArcGIS Desktop - ArcObjects General forum

Compressing a legend to show displayed feat...   Andy Marchant Apr 19, 2002
Re: Compressing a legend to show displayed...   Kirk Kuykendall Apr 19, 2002
Re: Compressing a legend to show displayed...   Kirk Kuykendall Apr 19, 2002
Re: Compressing a legend to show displayed...   Andy Marchant Apr 22, 2002
Re: Compressing a legend to show displayed...   Scott McCulloch May 13, 2003
Re: Compressing a legend to show displayed...   Scott McCulloch May 29, 2003
Re: Compressing a legend to show displayed...   Wendy Hartog May 11, 2006
Reset Layer   Keary Larson Sep 22, 2004
Report Inappropriate Content • Top • Print • This Forum is closed for replies.    
Subject Compressing a legend to show displayed features only 
Author Andy Marchant 
Date Apr 19, 2002 
Message I've written a generic report generator in ArcObjects which for each theme in the GIS exports a layout (containing map & legend) to Microsoft Word. However sometimes the there are too many classes in the legend for a theme & it doesn't fit in the space allocated to it in the layout. What i would like to be able to do is only show those items in the legend which are actually displayed in the map display at the time. I could do this in Avenue but have no idea about how to do it in ArcObjects. Any ideas?

Many thanks
Andy Marchant
GIS developer
British Geological Survey 
   
Report Inappropriate Content • Top • Print • This Forum is closed for replies.    
Subject Re: Compressing a legend to show displayed features only 
Author Kirk Kuykendall 
Date Apr 19, 2002 
Message You'll need to first save a layer file that has all legend values for the particular layer. 
 
Option Explicit
Sub Test()
    '
    ' Under Tools>References scroll down to "Microsoft Scripting Runtime"
    ' and check it, otherwise it won't recognize the Scripting.Dictionary
    ' and therefore won't compile
    '
    Dim pMxDoc As IMxDocument
    Set pMxDoc = ThisDocument
    
    ' MyLayer.lyr has the entire legend (all values)
    Dim pRenderer As IFeatureRenderer
    Set pRenderer = GetRenderer("D:\ambergis\MyLayer.lyr")
    
    ' remove those that aren't visible
    If TypeOf pRenderer Is IUniqueValueRenderer Then
        FixLegend pMxDoc.FocusMap.Layer(0), pMxDoc.FocusMap, pRenderer
        pMxDoc.CurrentContentsView.Refresh pMxDoc.FocusMap.Layer(0)
    Else
        Debug.Print "layer file doesn't contain a UVR"
    End If
End Sub

Function GetRenderer(strLyrFile As String) As IFeatureRenderer
    Dim pGxLayer As IGxLayer
    Set pGxLayer = New GxLayer
    
    Dim pGxFile As IGxFile
    Set pGxFile = pGxLayer
    pGxFile.Path = strLyrFile
    
    Dim pLayer As ILayer
    Set pLayer = pGxLayer.Layer
    If TypeOf pLayer Is IGeoFeatureLayer Then
        Dim pGFLayer As IGeoFeatureLayer
        Set pGFLayer = pLayer
        Set GetRenderer = pGFLayer.Renderer
    End If
    
End Function

Sub FixLegend(pGFLayer As IGeoFeatureLayer, _
              pAV As IActiveView, pUVR As IUniqueValueRenderer)
    '
    ' removes all UVR legend items that are not within current
    ' map extent
    '
    If pUVR.FieldCount > 1 Then
        MsgBox "this only supports layers rendered on one field"
        Exit Sub
    End If
        
    Dim pDict As Scripting.Dictionary
    Set pDict = GetFreq(pAV.ScreenDisplay.DisplayTransformation.FittedBounds, _
                        esriSpatialRelIntersects, _
                        pUVR.Field(0), _
                        pGFLayer.FeatureClass)
    
    Dim pOutUVR As IUniqueValueRenderer
    Set pOutUVR = New UniqueValueRenderer
    pOutUVR.FieldCount = 1
    pOutUVR.Field(0) = pUVR.Field(0)
    
    Dim l As Long, strKey As String
    For l = 0 To pUVR.ValueCount - 1
        strKey = CStr(pUVR.Value(l))
        If pDict.Exists(strKey) Then
            pOutUVR.AddValue strKey, pUVR.Heading(strKey), pUVR.Symbol(strKey)
        End If
    Next l
    '
    ' replace it with the new renderer
    '
    Set pGFLayer.Renderer = pOutUVR
    pAV.PartialRefresh esriViewGeography, pGFLayer, Nothing
                               
End Sub

Function GetFreq(pGeom As IGeometry, _
                 lSpRel As esriSpatialRelEnum, _
                 strFld As String, _
                 pFC As IFeatureClass) As Scripting.Dictionary
                 
    Dim pSF As ISpatialFilter
    Set pSF = New SpatialFilter
    Set pSF.Geometry = pGeom
    pSF.SpatialRel = lSpRel

    Dim lFld As Long
    lFld = pFC.FindField(strFld)
    
    Dim pFCur As IFeatureCursor
    Set pFCur = pFC.Search(pSF, False)
    
    Dim pDict As New Scripting.Dictionary
    
    Dim pFeat As IFeature, strKey As String
    Set pFeat = pFCur.NextFeature
    Do While Not pFeat Is Nothing
        If Not IsNull(pFeat.Value(lFld)) Then
            strKey = CStr(pFeat.Value(lFld))
            If pDict.Exists(strKey) Then
                pDict.Item(strKey) = pDict.Item(strKey) + 1
            Else
                pDict.Add strKey, 1
            End If
        End If
        Set pFeat = pFCur.NextFeature
    Loop
    Set GetFreq = pDict
End Function
 
  Kirk Kuykendall
AmberGIS Programming Services & Sales
http://www.ambergis.com
Now Answering questions at:
http://gis.stackexchange.com/


 
   
Report Inappropriate Content • Top • Print • This Forum is closed for replies.    
Subject Re: Compressing a legend to show displayed features only 
Author Kirk Kuykendall 
Date Apr 19, 2002 
Message After testing this I noticed the mapsurroundframe containing the legend moves around. So the code below has been modified to include a workaround for this.

I still can't get the legend's mapframe to refresh properly - the legend doesn't re-scale to fill the frame unless I manually click on the element & move it a tad. (Please let me know if you get this fixed.)

kkeywords ILegend refresh size 
 
Option Explicit
Private Sub UIButtonControl1_Click()
    '
    ' Under Tools>References scroll down to "Microsoft Scripting Runtime"
    ' and check it, otherwise it won't recognize the Scripting.Dictionary
    ' and therefore won't compile
    '
    Dim pMxDoc As IMxDocument
    Set pMxDoc = ThisDocument
    
    ' MyLayer.lyr has the entire legend (all values)
    Dim pRenderer As IFeatureRenderer
    Set pRenderer = GetRenderer("D:\ambergis\MyLayer.lyr")
    
    ' remove those that aren't visible
    If TypeOf pRenderer Is IUniqueValueRenderer Then
        Dim pLegendPoint As IPoint
        Set pLegendPoint = GetLegendPoint(pMxDoc.FocusMap, "UL")
        
        FixLegend pMxDoc.FocusMap.Layer(0), pMxDoc.FocusMap, pRenderer
        pMxDoc.CurrentContentsView.Refresh pMxDoc.FocusMap.Layer(0)
        
        ' (workaround for bug)
        If Not pLegendPoint Is Nothing Then
            MoveLegend pMxDoc.FocusMap, pLegendPoint, "UL"
        End If
        
        ' refresh the legend on the layout
        Dim pElement As IElement
        Set pElement = GetLegendElement(pMxDoc.FocusMap)
        If Not pElement Is Nothing Then
            RefreshLegend GetLegendElement(pMxDoc.FocusMap), pMxDoc.PageLayout
        End If
    Else
        Debug.Print "layer file doesn't contain a UVR"
    End If
End Sub

Sub RefreshLegend(pElement As IElement, pAV As IActiveView)
    
    Dim pMSF As IMapSurroundFrame
    Set pMSF = pElement
    Dim pLegend As ILegend
    Set pLegend = pMSF.MapSurround
    pLegend.Refresh
    pMSF.MapSurround.FitToBounds pAV.ScreenDisplay, pElement.Geometry.Envelope, True
    
    pAV.PartialRefresh esriViewGraphics, pElement, Nothing
End Sub

Function GetRenderer(strLyrFile As String) As IFeatureRenderer
    Dim pGxLayer As IGxLayer
    Set pGxLayer = New GxLayer
    
    Dim pGxFile As IGxFile
    Set pGxFile = pGxLayer
    pGxFile.Path = strLyrFile
    
    Dim pLayer As ILayer
    Set pLayer = pGxLayer.Layer
    If TypeOf pLayer Is IGeoFeatureLayer Then
        Dim pGFLayer As IGeoFeatureLayer
        Set pGFLayer = pLayer
        Set GetRenderer = pGFLayer.Renderer
    End If
    
End Function

Sub FixLegend(pGFLayer As IGeoFeatureLayer, _
              pAV As IActiveView, pUVR As IUniqueValueRenderer)
    '
    ' removes all UVR legend items that are not within current
    ' map extent
    '
    If pUVR.FieldCount > 1 Then
        MsgBox "this only supports layers rendered on one field"
        Exit Sub
    End If

    ' make a dictionary for each field value thats visible
    Dim pDict As Scripting.Dictionary
    Set pDict = GetFreq(pAV.ScreenDisplay.DisplayTransformation.FittedBounds, _
                        esriSpatialRelIntersects, _
                        pUVR.Field(0), _
                        pGFLayer.FeatureClass)
    
    Dim pOutUVR As IUniqueValueRenderer
    Set pOutUVR = New UniqueValueRenderer
    pOutUVR.FieldCount = 1
    pOutUVR.Field(0) = pUVR.Field(0)
    
    ' populate the new renderer with only the visible symbols
    Dim l As Long, strKey As String
    For l = 0 To pUVR.ValueCount - 1
        strKey = CStr(pUVR.Value(l))
        If pDict.Exists(strKey) Then
            pOutUVR.AddValue strKey, pUVR.Heading(strKey), pUVR.Symbol(strKey)
        End If
    Next l
    '
    ' replace it with the new renderer
    '
    Set pGFLayer.Renderer = pOutUVR
    pAV.PartialRefresh esriViewGeography, pGFLayer, Nothing
                               
End Sub

Function GetFreq(pGeom As IGeometry, _
                 lSpRel As esriSpatialRelEnum, _
                 strFld As String, _
                 pFC As IFeatureClass) As Scripting.Dictionary
                 
    Dim pSF As ISpatialFilter
    Set pSF = New SpatialFilter
    Set pSF.Geometry = pGeom
    pSF.SpatialRel = lSpRel

    Dim lFld As Long
    lFld = pFC.FindField(strFld)
    
    Dim pFCur As IFeatureCursor
    Set pFCur = pFC.Search(pSF, False)
    
    Dim pDict As New Scripting.Dictionary
    
    Dim pFeat As IFeature, strKey As String
    Set pFeat = pFCur.NextFeature
    Do While Not pFeat Is Nothing
        If Not IsNull(pFeat.Value(lFld)) Then
            strKey = CStr(pFeat.Value(lFld))
            If pDict.Exists(strKey) Then
                pDict.Item(strKey) = pDict.Item(strKey) + 1
            Else
                pDict.Add strKey, 1
            End If
        End If
        Set pFeat = pFCur.NextFeature
    Loop
    Set GetFreq = pDict
End Function

Sub MoveLegend(pMap As IMap, pFromPoint As IPoint, strPos As String)
    Dim pToPoint As IPoint
    Set pToPoint = GetLegendPoint(pMap, strPos)
    
    Dim pTrans2D As ITransform2D
    Set pTrans2D = GetLegendElement(pMap)
    pTrans2D.Move (pToPoint.X - pFromPoint.X), _
                  (pToPoint.Y - pFromPoint.Y)
End Sub

Function GetLegendPoint(pMap As IMap, strPos As String) As IPoint
    ' assumes a map has only one legend element
    
    Dim pElement As IElement
    Set pElement = GetLegendElement(pMap)
    If pElement Is Nothing Then Exit Function
    
    Dim pEnv As IEnvelope
    Set pEnv = pElement.Geometry.Envelope
    Select Case UCase(strPos)
    Case "UL"
        Set GetLegendPoint = pEnv.UpperLeft
    Case "UR"
        Set GetLegendPoint = pEnv.UpperRight
    Case "LL"
        Set GetLegendPoint = pEnv.LowerLeft
    Case "LR"
        Set GetLegendPoint = pEnv.LowerRight
    Case Else
        MsgBox "position not supported: " & strPos
    End Select

End Function


Function GetLegendElement(pMap As IMap) As IElement
    Dim pMxDoc As IMxDocument
    Set pMxDoc = ThisDocument
    
    Dim pGC As IGraphicsContainer
    Set pGC = pMxDoc.PageLayout
    pGC.Reset
    
    Dim pElement As IElement
    Set pElement = pGC.Next
    Do While Not pElement Is Nothing
        If TypeOf pElement Is IMapSurroundFrame Then
            Dim pMSF As IMapSurroundFrame
            Set pMSF = pElement
            If pMSF.MapFrame.Map Is pMap Then
                If TypeOf pMSF.MapSurround Is ILegend Then
                    Set GetLegendElement = pElement
                End If
            End If
        End If
        Set pElement = pGC.Next
    Loop
End Function

 
  Kirk Kuykendall
AmberGIS Programming Services & Sales
http://www.ambergis.com
Now Answering questions at:
http://gis.stackexchange.com/


 
   
Report Inappropriate Content • Top • Print • This Forum is closed for replies.    
Subject Re: Compressing a legend to show displayed features only 
Author Andy Marchant 
Date Apr 22, 2002 
Message thanks for your help - this works perfectly 
   
Report Inappropriate Content • Top • Print • This Forum is closed for replies.    
Subject Re: Compressing a legend to show displayed features only 
Author Scott McCulloch 
Date May 13, 2003 
Message I have also experienced my legend not refreshing properly in an auto-generated layout. As Kirk said, my work around was also to manually move the legend a bit to trigger a refresh, but all code-based refreshes I tried would not do the trick. Has anyone discovered a way to properly refresh a legend when it is part of a layout being customized/created via ArcObjects? 
  Scott McCulloch
Geo-Information Analyst
EPW Geomatics, Geo-Information & GIS
Shell Exploration & Production Co.
scott.mcculloch@shell.com
 
   
Report Inappropriate Content • Top • Print • This Forum is closed for replies.    
Subject Re: Compressing a legend to show displayed features only 
Author Scott McCulloch 
Date May 29, 2003 
Message In Case anyone is interested, ESRI Developer support provided me with an updated method for refreshing your legend when constructing a layout on the fly. I have tested this and it works. I provided it in both VBA and C#. 
 
VBA:

Sub RefreshLegend(ByRef pElement As IElement, pAV As IActiveView)
    
    Dim pMSF As IMapSurroundFrame
    Dim pMS As IMapSurround
    Set pMSF = pElement
    Dim pLegend As ILegend
    Set pLegend = pMSF.MapSurround
    Dim pNewEnv As IEnvelope
    Set pNewEnv = New Envelope
    Set pElement = pMSF
    Set pMS = pMSF.MapSurround
    pMS.Refresh
    pLegend.QueryBounds pAV.ScreenDisplay, pElement.Geometry.Envelope, pNewEnv
    'Assign the boundary to the map surround frame
    pElement.Draw pAV.ScreenDisplay, Nothing
    pElement.Geometry = pNewEnv
    
    pMS.FitToBounds pAV.ScreenDisplay, pElement.Geometry.Envelope, True
    pMS.Refresh
    pAV.PartialRefresh esriViewGraphics, pElement, Nothing
End Sub

C#:

		private void RefreshLegend(IElement element, IActiveView activeView)
		{
			IMapSurroundFrame mapSurroundFrame = (IMapSurroundFrame)element;
			IMapSurround mapSurround = mapSurroundFrame.MapSurround;
			ILegend legend = (ILegend)mapSurround;

			IEnvelope newEnvelope = new EnvelopeClass();

			mapSurround.Refresh();

			legend.QueryBounds(activeView.ScreenDisplay, element.Geometry.Envelope, newEnvelope);
			element.Draw(activeView.ScreenDisplay, null);
			element.Geometry = newEnvelope;
    
			bool junk = true;
			mapSurround.FitToBounds(activeView.ScreenDisplay, element.Geometry.Envelope, out junk);

			mapSurround.Refresh();
			activeView.PartialRefresh(esriViewDrawPhase.esriViewGraphics, element, null);
		}
 
  Scott McCulloch
Geo-Information Analyst
EPW Geomatics, Geo-Information & GIS
Shell Exploration & Production Co.
scott.mcculloch@shell.com
 
   
Report Inappropriate Content • Top • Print • This Forum is closed for replies.    
Subject Re: Compressing a legend to show displayed features only 
Author Wendy Hartog 
Date May 11, 2006 
Message The code Kirk provided is using a renderer of type IUniqueValueRenderer. I tried to rewrite the code a bit to see if I could get it working for a ClassBreaksrenderer, but I am not familiar enough with all the ins and outs of VBA to get it working (got totally stuck at the FixLegend Sub). Does anyone know or has written a code to show only displayed features in a legend that is based on a classbreaksrenderer?

In my case I have monthly precipitation shapefiles and broke up the legend in 20mm intervals, with a total of 20 breaks. When I zoom in on a relatively dry area, I don't like to see a legend with 20 values when only 6 intervals are displayed on the map, the same counts for displaying relatively wet areas.

Wendy Hartog
Senior Consultant Meteorology and Oceanography
NNTE 
   
Report Inappropriate Content • Top • Print • This Forum is closed for replies.    
Subject Reset Layer 
Author Keary Larson 
Date Sep 22, 2004 
Message Hi Kirk,

I'm using peices of the code you've posted. It's working great. Thank you.

I'm hoping you can offer some feedback on how to further modify it. Once I collapse a layer to show only features displayed in the extent I can no longer redefine the extent and run the script again.

Before the script runs I'd like to reset the layer files so they show all features with all symbols.

Help is greatly appreciated.

 
  K.