Hallo allerseits an alle Mitlesende,

mein Problem ist folgendes:

Ich will eine Karte per vba nach Merkmalen einfärben lassen.
Daß ich dafür shd_simple statt shd_categories nehmen muss, hab ich schon rausgefunden.
(Muss wohl irgenwo ein Fehler sein, da das Beispiel in der Hilfe gegenteiliges suggeriert)

Allerdings sieht es mir nicht so aus, als könnte ich die Grenzen meiner Ranges per vba bestimmen ?

Über rgcRangeCalcMode kann ich zwar zwischen Individuell, Gleichverteilt, und Gleiche Distanzen umschalten, aber wie gehts dann bei Individuell weiter ?

Falls jemand eine Lösung kennt ...

Vielen Dank im Vorraus,

Jürgen

Public Sub MakeMapLayerToShd_Simple()

Dim shd_SimpleTest As rgShd_Simple

Dim brushSimple As cBrush

Dim rangeSimple As rgRange

Dim laySimple As rgLayer

Dim lMaxValue As Double, lMinValue As Double, dValue As Double

Dim lActCol As Integer, lNoOfClass As Integer, lRunRange As Integer, lRunLayer As Long

Dim dRndNumber As Double

' ... Objekt für "Einfache Einfärbung" auslesen

Set shd_SimpleTest = ActiveMap.WorkLayer.SimpleShading

' ... Auszuwertende Spalte und Anzahl Klassen angeben

' ... Achten Sie darauf, das nur numerische Spalten für diese Darstellung verwendet werden können

lActCol = 3

lNoOfClass = 7

' ... Worklayer auslesen

Set laySimple = ActiveMap.WorkLayer.Layer

' ... Überprüfen ob angegebene Spalte auch numerisch ist

If laySimple.ColumnDef(lActCol).DataType = dtString Then

    MsgBox "Ausgewählte Datenspalte ist nicht numerisch!", vbOKOnly

    Exit Sub

End If

' ... "Einfache Einfärbung" mit Datenspalte und Anzahl Klassen initialisieren

shd_SimpleTest.Init lActCol, lNoOfClass

' ... Mode auf "Gleiche Distanzen"

shd_SimpleTest.RangeCalcMode = rcmEqualDistance

' ... Min - MaxWerte mit erstem Wert initialisieren

lMaxValue = laySimple.GetValue(0, lActCol)

lMinValue = laySimple.GetValue(0, lActCol)

For lRunLayer = 0 To laySimple.ObjectCount - 1

    dValue = laySimple.GetValue(lRunLayer, lActCol)

    If dValue > lMaxValue Then lMaxValue = dValue

    If dValue < lMinValue Then lMinValue = dValue

Next

' ... Zufallszahl zum Einfärben der Klassen ermitteln

dRndNumber = Rnd(1) * 20000

' ... Alle Klassengrenzen und jeweils Farbe setzen

For lRunRange = 0 To shd_SimpleTest.RangeCount - 1

    ' ... Range-Objekt auslesen und setzen

    Set rangeSimple = shd_SimpleTest.Range(lRunRange)

    ' ... Die Abstufungen für Einfärbung setzen

    ' ... In diesem Beispiel werden die Grenzen für 'gleiche Distanzen' ... berechnet

    rangeSimple.LowValue = (lRunRange) * ((lMaxValue - lMinValue) / shd_SimpleTest.RangeCount)

    rangeSimple.HighValue = (lRunRange + 1) * ((lMaxValue - lMinValue) / shd_SimpleTest.RangeCount)

   

    ' ... Den jeweiligen Brush auslesen und dann die Farbe = Grundfarbe + Zufallsfarbe setzen

    ' ... Danach den Brush wieder zurückgeben.

    Set brushSimple = shd_SimpleTest.Range(lRunRange).Brush

    brushSimple.BrushType = btSolid

    brushSimple.FrontColor = 33000 + dRndNumber * (lRunRange + 1)

    Set shd_SimpleTest.Range(lRunRange).Brush = brushSimple

   

Next lRunRange

' ... Ausgabe auf "Einfache Einfärbung" setzen

ActiveMap.WorkLayer.ShadingType = shdSimple

' ... Die Karte neu zeichnen

ActiveMap.Refresh

End Sub