topic Re: Using VBA to offset polygon outline symbol in a layer in ArcObjects SDK Questions

Using VBA to offset polygon outline symbol in a layer

Anonymous User — Tue, 28 Feb 2012 04:06:44 GMT

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

Re: Using VBA to offset polygon outline symbol in a layer

NeilClemmons — Tue, 28 Feb 2012 12:26:06 GMT

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.

Re: Using VBA to offset polygon outline symbol in a layer

Anonymous User — Thu, 01 Mar 2012 01:14:02 GMT

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