Using VBA to offset polygon outline symbol in a layer

[Anonymous User]

Original User: mayad85

Hi folks,

I have a newbie question regarding Symbols & Renderers in Layers. I'm using ArcGIS 10 with a VBA extension (don't have access to any Visual Basic editing software at work, but we do have the VBA editor within ArcMap due to the extension, so I went with what was readily available). I basically have a one-off task involving about 100 layers symbolising polygon feature classes by Unique Values (some are grouped); for each of these layers, I need to offset the polygon symbol outline for a subset of the symbols in each layer (those with, in this instance, a width of 2). I was hoping to put together some VBA code to do this automatically.

I managed to get off to a reasonable start, but the problem I am now encountering is to do with the outline symbology in these layers being set as a Cartographic Line Symbol, and while the line width is accessible/exposable from the Simple Fill Symbol level, the colour is not. The image below hopefully helps to illustrate what I mean.
[ATTACH=CONFIG]12271[/ATTACH]

I've attached the code that I threw together over the last few hours (with much assistance from the archived forums!). As it is, it runs and offsets the boundary of the required symbol values, but the outline becomes black. When I uncomment the 'pCartoLineSymbol.Color = pFillSymbol.Outline.Color' line, it runs and offsets the boundary, but the outline is Null (no colour). I gather this happens because the pFillSymbol does not expose the colour of the Cartographic Line Symbol and if it does (when I uncomment that line of code) it is Null. I'm having trouble trying to figure out a way of exposing this next 'level' of symbology. I've tried using other symbol interfaces (ISimpleFillSymbol, ILineSymbol etc) without success. If anyone has any advice it would be much appreciated. Thanks! 🙂

Option Explicit

Sub OffsetOutline()

Dim pMxDoc As IMxDocument
Dim pMap As IMap
Dim pGeoFeatureLayer As IGeoFeatureLayer
Dim pFeatureRenderer As IFeatureRenderer
Dim pUniqueValueRenderer As IUniqueValueRenderer
Dim pCartoLineSymbol As ICartographicLineSymbol
Dim pFillSymbol As IFillSymbol
Dim i As Integer


Set pMxDoc = ThisDocument
Set pMap = pMxDoc.FocusMap
Set pGeoFeatureLayer = pMap.Layer(0) 'For now focus on getting this working on one layer
Set pFeatureRenderer = pGeoFeatureLayer.Renderer

If TypeOf pFeatureRenderer Is IUniqueValueRenderer Then
Set pUniqueValueRenderer = pFeatureRenderer

With pUniqueValueRenderer
For i = 0 To .ValueCount - 1

Dim refVal As String

Set pFillSymbol = .Symbol(.Value(i))
Set pCartoLineSymbol = New CartographicLineSymbol
'pCartoLineSymbol.Color = pFillSymbol.Outline.Color
pCartoLineSymbol.width = pFillSymbol.Outline.width

On Error Resume Next

refVal = pUniqueValueRenderer.ReferenceValue(i)

If Err.Number <> 0 Then
refVal = "none"
End If

Debug.Print i & "refval = " & refVal

If pFillSymbol.Outline.width = 2 Then

Dim p As Double
Dim pOffset As ILineProperties

p = -1#

Set pOffset = pCartoLineSymbol
pOffset.Offset = p

pFillSymbol.Outline = pCartoLineSymbol

End If

.Symbol(.Value(i)) = pFillSymbol

Next i
End With
End If

Set pGeoFeatureLayer.Renderer = pUniqueValueRenderer
pMxDoc.UpdateContents
pMxDoc.ActiveView.Refresh

End Sub

[NeilClemmons]

I suspect that one of the things that is happening is that you're running into problems caused by objects being returned by value vs. by reference.  When you do something like this, you open your code up to this type of problem:

pCartoLineSymbol.Color = pFillSymbol.Outline.Color

The Outline property can return the line symbol object by value or by reference.  The behavior can be different between the two.  You can tell one vs. the other by looking at the developer help but in short, the best way to keep from running into problems is to simply not chain property calls.  Instead of the code above, do this:

Dim outline As ILineSymbol = pFillSymbol.Outline
pCartoLineSymbol.Color = outline.Color

Try changing you code so that you aren't chaining any property calls and see if it behaves any differently.

[Anonymous User]

Original User: mayad85

Hi Neil,

Thanks very much for your feedback, much appreciated. I adapted the code as you recommended and briefly read up on the differences between ByVal vs ByRef methods. Unfortunately what you suggested didn't solve the problem. I eventually figured out the problem of the Null colour of the outline was due to the fact that the symbology in the layers I was working with was locked (I should have noticed that in the first place!), so I had to apply the ILayerColorLock interface to unlock it and be able to access the colours of the line symbology in question. After that, the code worked perfectly. It still needs some tidying up and additional lines to make it run through multiple layers and save changes, but I've attached it here in case it is of interest to anyone else.

Again, many thanks!


Option Explicit

Sub OffsetOutline()
  Dim pMxDoc As IMxDocument
  Dim pMap As IMap
  Dim pGeoFeatureLayer As IGeoFeatureLayer
  Dim pFeatureRenderer As IFeatureRenderer
  Dim pUniqueValueRenderer As IUniqueValueRenderer
  Dim pCartoLineSymbol As ICartographicLineSymbol
  Dim pFillSymbol As IFillSymbol
  Dim i As Integer
 
  Set pMxDoc = ThisDocument
  Set pMap = pMxDoc.FocusMap
  Set pGeoFeatureLayer = pMap.Layer(0)
  Set pFeatureRenderer = pGeoFeatureLayer.Renderer
 
  If TypeOf pFeatureRenderer Is IUniqueValueRenderer Then
    Set pUniqueValueRenderer = pFeatureRenderer

    
      For i = 0 To pUniqueValueRenderer.ValueCount - 1

        
        Dim pHeading As String

         Dim refVal As String

        
        pHeading = pUniqueValueRenderer.Value(i)

          
        Set pFillSymbol = pUniqueValueRenderer.Symbol(pHeading)

        
            If TypeOf pFillSymbol Is IMultiLayerFillSymbol Then

        
                Dim pMultiLayerFill As IMultiLayerFillSymbol

                 Set pMultiLayerFill = pFillSymbol
       
                Dim pLayerLockFill As ILayerColorLock
                Set pLayerLockFill = pMultiLayerFill
       
                Dim x As Long
       
                    For x = 0 To pMultiLayerFill.LayerCount - 1
                        pLayerLockFill.LayerColorLock(x) = False
                    Next x
       
            End If
       
        Dim pOutline As ILineSymbol
        Set pOutline = pFillSymbol.outline
       
            If TypeOf pOutline Is IMultiLayerLineSymbol Then
       
                Dim pMultiLayerLine As IMultiLayerLineSymbol
                Set pMultiLayerLine = pOutline
       
                Dim pLayerLockLine As ILayerColorLock
                Set pLayerLockLine = pMultiLayerLine
       
                Dim y As Long
       
                For y = 0 To pMultiLayerFill.LayerCount - 1
                    pLayerLockLine.LayerColorLock(y) = False
                Next y
       
            End If
        
        Set pCartoLineSymbol = New CartographicLineSymbol
        pCartoLineSymbol.Color = pOutline.Color
        pCartoLineSymbol.width = pOutline.width
       
        On Error Resume Next
       
        refVal = pUniqueValueRenderer.ReferenceValue(i)
           
            If Err.Number <> 0 Then
                refVal = "none"
            End If
       
        Debug.Print i & "refval = " & refVal
     
        If pFillSymbol.outline.width = 2 Then
       
            Dim p As Double
            Dim pOffset As ILineProperties
           
            p = -1#

            Set pOffset = pCartoLineSymbol
            pOffset.Offset = p
                      
            pFillSymbol.outline = pCartoLineSymbol
       
        End If
      
       pUniqueValueRenderer.Symbol(pHeading) = pFillSymbol
           
      Next i

  End If
 
  Set pGeoFeatureLayer.Renderer = pUniqueValueRenderer
  pMxDoc.UpdateContents
  pMxDoc.ActiveView.Refresh

End Sub