AnsweredAssumed Answered

Using VBA to offset polygon outline symbol in a layer

Question asked by geonetadmin on Feb 27, 2012
Latest reply on Feb 29, 2012 by geonetadmin
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

Outcomes