AnsweredAssumed Answered

ArcGIS 9.0 - Symbology - Color Scheme

Question asked by geonetadmin on Sep 27, 2010
Original User: PiHellz

Hi,

I'm trying to create a symbology with a color scheme name "Cool Grey". I have tested and try a lots of thing and different method but nothing works as I wish.

I think my problem is in the second code wrap.

Thanks you for your help


Sub CreateAndApplyUVRenderer()
    Dim pMxDoc As IMxDocument
    Set pMxDoc = ThisDocument

    Dim pWorkspaceFactory As IWorkspaceFactory
    Dim pWorkspace As IWorkspace
    
    Set pWorkspaceFactory = New ShapefileWorkspaceFactory
    
    Set pWorkspace = pWorkspaceFactory.OpenFromFile _
    ("U:\Mise en oeuvre\", 0)
 
    Dim pFeatureWorkspace As IFeatureWorkspace
    Dim pFClass As IFeatureClass

    Set pFeatureWorkspace = pWorkspace
    Set pFClass = pFeatureWorkspace.OpenFeatureClass _
      ("Caserne_Operationnel")
      
    Dim pFLayer As IFeatureLayer
    Set pFLayer = New FeatureLayer
    Set pFLayer.FeatureClass = pFClass
    
    Dim pGFLayer As IGeoFeatureLayer
    Set pGFLayer = pFLayer
    
    Dim pQueryFilter As IQueryFilter
    Set pQueryFilter = New QueryFilter 'empty supports: SELECT *
    Dim pFeatCursor As IFeatureCursor
    Set pFeatCursor = pFClass.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.Name = "Cool Grey"  ' Première tentative pour la rampe de couleur prédéfinis
    rx.MinSaturation = 20
    rx.MaxSaturation = 40
    rx.MinValue = 85
    rx.MaxValue = 100
    rx.StartHue = 76
    rx.EndHue = 188
    rx.UseSeed = True
    rx.Seed = 43

  
    
'Add class breaks renderer code here.
   
    Dim pUVR As IUniqueValueRenderer, n As Long
    Set pUVR = New UniqueValueRenderer
    
    Dim symd As ISimpleFillSymbol
    Set symd = New SimpleFillSymbol
    symd.Style = esriSFSSolid
    symd.Outline.Width = 0.4
    
    pUVR.FieldCount = 1
    pUVR.Field(0) = "NO_CAS_OP"
    pUVR.DefaultSymbol = symd
    'pUVR.ColorScheme = "Cool Grey" ' Deuxième tentative pour la rampe de couleur prédéfinis
  
 '******* Code pris en référence sur le site de ForumSIG ****************
 'http://www.forumsig.org/showthread.php?t=8562&highlight=symbologie+add
 
   
    Dim pFeat As IFeature
     n = pFClass.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("NO_CAS_OP")
     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 (pUVR.ValueCount - 1)
           If pUVR.Value(uh) = x Then
             NoValFound = True
             Exit For
           End If
         Next uh
         If Not ValFound Then
             pUVR.AddValue x, "Name", symx
             pUVR.Label(x) = x
             pUVR.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 = pUVR.ValueCount
        rx.CreateRamp (True)
        Dim RColors As IEnumColors, ny As Long
        Set RColors = rx.Colors
        RColors.Reset
        For ny = 0 To (pUVR.ValueCount - 1)
        Dim xv As String
        xv = pUVR.Value(ny)
        If xv <> "" Then
        Dim jsy As ISimpleFillSymbol
        Set jsy = pUVR.Symbol(xv)
        jsy.Color = RColors.Next
        pUVR.Symbol(xv) = jsy
        End If
        Next ny




    Dim hx As IRendererPropertyPage
    Set hx = New UniqueValuePropertyPage
    pGFLayer.RendererPropertyPageClassID = hx.ClassID
        
     Set pGFLayer.Renderer = pUVR
    
    pFLayer.Name = "Caserne_Operationnel"
    pMxDoc.FocusMap.AddLayer pFLayer
    
    pMxDoc.ActiveView.Refresh
    pMxDoc.UpdateContents

End Sub

Attachments

Outcomes