Le portail francophone de la géomatique

Bonjour Yvan,

Je te remercie pour l'info, qui m'a bien aiguillé! J'obtiens bien dans la table des matières la symbologie associée cependant mes ponctuels n'ont pas cette symbologie... Le résultat est un carré rouge qui englobe chaque ponctuel.

Si quelqu'un a une idée...

Merci,

Grégory.


Sub CreateAndApplyUVRenderer()
     
     '** Paste into VBA
     '** Creates a UniqueValuesRenderer and applies it to first layer in the map.
     '** Layer must have "Name" field

     Dim pApp As Application
     Dim pDoc As IMxDocument
     Set pDoc = ThisDocument
     Dim pMap As IMap
     Set pMap = pDoc.FocusMap

     Dim pLayer As ILayer
     Set pLayer = pMap.Layer(0)
     Dim pFLayer As IFeatureLayer
     Set pFLayer = pLayer
     Dim pLyr As IGeoFeatureLayer
     Set pLyr = pFLayer
     
     Dim pFeatCls As IFeatureClass
     Set pFeatCls = pFLayer.FeatureClass
     Dim pQueryFilter As IQueryFilter
     Set pQueryFilter = New QueryFilter 'empty supports: SELECT *
     Dim pFeatCursor As IFeatureCursor
     Set pFeatCursor = pFeatCls.Search(pQueryFilter, False)

     '** Make the color ramp we will use for the symbols in the renderer
     Dim rx As IRandomColorRamp
     Set rx = New RandomColorRamp
     rx.MinSaturation = 20
     rx.MaxSaturation = 40
     rx.MinValue = 85
     rx.MaxValue = 100
     rx.StartHue = 76
     rx.EndHue = 188
     rx.UseSeed = True
     rx.Seed = 43
     
     '** Make the renderer
     Dim pRender As IUniqueValueRenderer, n As Long
     Set pRender = New UniqueValueRenderer
     
     Dim symd As ISimpleFillSymbol
     Set symd = New SimpleFillSymbol
     symd.Style = esriSFSSolid
     symd.Outline.Width = 0.4
     
     '** These properties should be set prior to adding values
     pRender.FieldCount = 1
     pRender.Field(0) = "Name"
     pRender.DefaultSymbol = symd
     pRender.UseDefaultSymbol = True
     
     Dim pFeat As IFeature
     n = pFeatCls.FeatureCount(pQueryFilter)
     '** Loop through the features
     Dim i As Integer
     i = 0
     Dim ValFound As Boolean
     Dim NoValFound As Boolean
     Dim uh As Integer
     Dim pFields As IFields
     Dim iField As Integer
     Set pFields = pFeatCursor.Fields
     iField = pFields.FindField("Name")
     Do Until i = n
         Dim symx As ISimpleFillSymbol
         Set symx = New SimpleFillSymbol
         symx.Style = esriSFSSolid
         symx.Outline.Width = 0.4
         Set pFeat = pFeatCursor.NextFeature
         Dim x As String
         x = pFeat.Value(iField) '*new Cory*
         '** Test to see if we've already added this value
         '** to the renderer, if not, then add it.
         ValFound = False
         For uh = 0 To (pRender.ValueCount - 1)
           If pRender.Value(uh) = x Then
             NoValFound = True
             Exit For
           End If
         Next uh
         If Not ValFound Then
             pRender.AddValue x, "Name", symx
             pRender.Label(x) = x
             pRender.Symbol(x) = symx
         End If
         i = i + 1
     Loop
     
     '** now that we know how many unique values there are
     '** we can size the color ramp and assign the colors.
     rx.Size = pRender.ValueCount
     rx.CreateRamp (True)
     Dim RColors As IEnumColors, ny As Long
     Set RColors = rx.Colors
     RColors.Reset
     For ny = 0 To (pRender.ValueCount - 1)
         Dim xv As String
         xv = pRender.Value(ny)
         If xv <> "" Then
             Dim jsy As ISimpleFillSymbol
             Set jsy = pRender.Symbol(xv)
             jsy.Color = RColors.Next
             pRender.Symbol(xv) = jsy
         End If
     Next ny

     '** If you didn't use a color ramp that was predefined
     '** in a style, you need to use "Custom" here, otherwise
     '** use the name of the color ramp you chose.
     pRender.ColorScheme = "Custom"
     pRender.FieldType(0) = True
     Set pLyr.Renderer = pRender
     pLyr.DisplayField = "Name"

     '** This makes the layer properties symbology tab show
     '** show the correct interface.
     Dim hx As IRendererPropertyPage
     Set hx = New UniqueValuePropertyPage
     pLyr.RendererPropertyPageClassID = hx.ClassID

     '** Refresh the TOC
     pDoc.ActiveView.ContentsChanged
     pDoc.UpdateContents
     
     '** Draw the map
     pDoc.ActiveView.Refresh
     
End Sub

Dernière modification par Grégory GADRAS (Tue 25 July 2006 16:33)

Salut Yvan,

On m'avait orienté hier sur la même approche que toi et ça marche nickel je te remercie.

Je voudrais même pousser un peu plus loin dans ma recherche, en fait j'aimerais une symbologie avec des objets graphiques (imagettes) suivant la valeur des champs et non me limiter à un simple ponctuel.
Il semblerait que ça soit avec PictureFillSymbol... mais comment?

Si tu as ou quelqu'un d'autre a une idée je suis preneur, en tout cas merci à toi aussi pour ton aide!!!

Grégory.

Bonjour,

Je suis en train de tester IPictureMarkerSymbol et j'ai un problème tout d'abord avec les fichiers BMP ensuite même avec l'EMF le code tourne mais l'imagette ne s'affiche pas... Si quelqu'un a déjà tester l'exemple de code suivant: http://edndoc.esri.com/arcobjects/9.1/d … Symbol.htm  et peut me faire un retour, merci.

Grégory.

Bonjour Ivan,

Non je n'ai point fait cela, comment dois je procéder?

Grégory.

Bonjour,

Tu peux aussi faire "plus court" :

Dim pPictMrk as esriDisplay.IMarkerSymbol

set pPictMrk = new esriDisplay.PictureMarkerSymbol
' ...
' ...
ppPictMrk.Size = 12.0
' ...
' ...

yvan.