Hi,
I have a POINT shapefile with over 300 points in it. Each point has a label with 5 different fields.
In the labels field index 5, the value is an integer between 0 and 20.
I want to colour the circle point shape a different colour on this value.
I could create different layers for each field index(5)'s value and put the points on respective layers, or I could look at using catergories and the colour scheme class.
Another option is using a coloured circle icon image and using that, similar to the pointicon.cs example
I am having trouble getting my head around using the catergories and doing this in VB.net.
The question is, it looks like there is a few ways of doing this, and which is the most efficient and simplest way.
Any examples or help much appreciated,
Regards
Terry
Hello @TLee, and welcome.
Your best bet is to set up drawing Categories. They take a little getting used to, but they can do a lot. And you would set up categories whether you are looking for something simple, like colored circles (or other simple shape), or for assigning images to each distinct point type.
In your specific case, 20 categories is not too many, so you can set up 20 distinct categories (or 21 if zero carries a specific color as well) or you can set up less categories to support ranges of values (0-4, 5-8, etc).
Here’s some code to hopefully get you started. Assuming your shapefile is named sf.
Dim utils As New Utils()
With sf.DefaultDrawingOptions
.Visible = True
.FillColor = utils.ColorByName(tkMapColor.Red)
'' set default properties that will apply to all categories
.PointSize = 10
'' there are a number of predefined shapes
'' and you can set a different shape or size within each category
.SetDefaultPointSymbol(tkDefaultPointSymbol.dpsStar)
End With
With sf.Categories
Dim cat As ShapefileCategory
'' when Field5 = 0
cat = .Add("Value0")
'' substitute actual name of field at index 5
cat.Expression = "[Field5] = 0"
cat.DrawingOptions.FillColor = utils.ColorByName(tkMapColor.Green)
'' when Field5 = 1
cat = .Add("Value1")
cat.Expression = "[Field5] = 1"
cat.DrawingOptions.FillColor = utils.ColorByName(tkMapColor.Blue)
'' continue on through value 20
End With
'' apply the expressions (should only have to do once, unless you add/remove shapes)
sf.Categories.ApplyExpressions()
Let me know if something goes wrong.
Regards,
Jerry.
Thanks Jerry, will give it a go and let you know soon,
Regards
Terry
Hi Jerry,
Not having much success with the Category functions in VB.net.
Code below a simple program with one point and trying to get it to change point shape, colour and size by using Categories without success.
Again, any help appreciated,
Regards
Terry
Imports MapWinGIS
Imports System.IO
Imports AxMapWinGIS
Public Class Form1
Dim filename As String
Dim m_layerHandle As Integer = -1
Dim pnt As Point = New Point()
Dim utls = New Utils()
Dim lat_x As Double = -6.200322
Dim lon_y As Double = 53.276001
Dim x1 As Double = 0
Dim y1 As Double = 0
Private Sub btnLoadMapWithPoints_Click(sender As Object, e As EventArgs) Handles btnLoadMapWithPoints.Click
AxMap1.Projection = tkMapProjection.PROJECTION_GOOGLE_MERCATOR
AxMap1.GrabProjectionFromData = False
AxMap1.MapUnits = tkUnitsOfMeasure.umMeters
AxMap1.TileProvider = tkTileProvider.BingMaps
AxMap1.CursorMode = tkCursorMode.cmPan
Dim gb As New GlobalSettings
gb.BingApiKey = "A####################################V"
'needs an existing shp file to start with.
filename = System.IO.Path.GetDirectoryName(System.Reflection.Assembly.GetExecutingAssembly.GetModules()(0).FullyQualifiedName) & "\Test.shp"
Debug.Print("File location = " & filename)
If Not File.Exists(filename) Then
MessageBox.Show("Couldn't file the file: " & filename)
Return
End If
'create a new shape....
Dim shp As Shape = New Shape()
shp.Create(ShpfileType.SHP_POINT)
'creates a new shape file ....
Dim sf = New Shapefile()
' open the existing shp file....
sf.Open(filename, Nothing)
m_layerHandle = AxMap1.AddLayer(sf, True)
sf = AxMap1.get_Shapefile(m_layerHandle)
If Not sf.CreateNewWithShapeID("", ShpfileType.SHP_POINT) Then
MessageBox.Show("Failed to create shapefile: " & sf.ErrorMsg(sf.LastErrorCode))
Return
End If
'adds it to a layer.....
m_layerHandle = AxMap1.AddLayer(sf, True)
'locates the point shp on the map with the x and y, converts from dec degress to x/y location
AxMap1.DegreesToProj(lat_x, lon_y, x1, y1)
pnt.x = x1
pnt.y = y1
'inserts the new point shp
Dim index As Integer = shp.numPoints
shp.InsertPoint(pnt, 0)
Debug.Print("No.of pts = " & shp.numPoints)
index = sf.NumShapes
Debug.Print("New shape index = " & index)
If Not sf.EditInsertShape(shp, index) Then
MessageBox.Show("Failed to insert shape: " & sf.ErrorMsg(sf.LastErrorCode))
Return
End If
' now that its in there we need to edit it...
sf.EditInsertShape(shp, index)
' we add fields to the point ....
sf.EditAddField("Site", FieldType.STRING_FIELD, 0, 20)
'then we edit the fields we created above
sf.EditCellValue(0, 0, "11")
'draws it with certain default options
Dim utils As New Utils()
With sf.DefaultDrawingOptions
.Visible = True
.FillColor = utils.ColorByName(tkMapColor.Red)
.PointSize = 10
.SetDefaultPointSymbol(tkDefaultPointSymbol.dpsCircle)
End With
'see if the field is present..........
Dim field As Field = sf.Field(1)
Dim s As String = String.Format("Name = {0}; type = {1}; width = {2}; precision = {3}", field.Name, field.Type.ToString(), field.Width.ToString(), field.Precision.ToString())
Debug.Print(s)
Dim str As String = sf.CellValue(0, 0)
'add labels with proprties below
With sf.Labels
.AddLabel(str, pnt.x, pnt.y, 0, -1)
.AvoidCollisions = True
.CollisionBuffer = 0
.AutoOffset = False
.OffsetX = 10
.OffsetY = 10
.Alignment = tkLabelAlignment.laCenterRight
.FontColor = utls.ColorByName(tkMapColor.DarkBlue)
.Visible = True
End With
Debug.Print("SF categories count before = " & sf.Categories.Count)
With sf.Categories
Dim cat As ShapefileCategory
cat = sf.Categories.Add("Site_Id_11")
' substitute actual name of field at index 0
cat.Expression = "[Site]=11"
cat.DrawingOptions.FillColor = utils.ColorByName(tkMapColor.Yellow)
cat.DrawingOptions.PointShape = tkPointShapeType.ptShapeFlag
cat.DrawingOptions.PointSize = 25
' continue on through value 20
End With
Debug.Print("SF categories count after = " & sf.Categories.Count)
' apply the expressions (should only have to do once, unless you add/remove shapes)
sf.Categories.ApplyExpressions()
With AxMap1
.ZoomToLayer(1)
.Refresh()
.ZoomToTileLevel(16)
.Redraw()
End With
End Sub
End Class
Hi All,
Have come up with a solution for this problem that works.
Basically i am creating a layer for all the SHP points that have a certain range of values, and modify that shapefiles layer attributes to show a different colour. Its seems to work okay, have tried it up to 500 points with 10 layers. Below is the code and an example…
Imports MapWinGIS
Imports System.IO
Imports AxMapWinGIS
Partial Public Class Form1
'creates a new shape file array of size 4 items....
Dim sf_array(3) As Shapefile
'creates a layer handle array of size same as shapefile array...
Dim map_layerHandleArray(sf_array.Length) As Integer
'create AxMap utilities class
Dim utls = New Utils()
'some temp starting co-ords
Dim lat_x As Double = -2.03229
Dim lon_y As Double = 49.165346
'some point co-ords for conversion
Dim x1 As Double = 0
Dim y1 As Double = 0
'a random number for generating the points
Dim rnd1 As Random = New Random
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
AxMap1.Projection = tkMapProjection.PROJECTION_GOOGLE_MERCATOR
AxMap1.GrabProjectionFromData = False
AxMap1.MapUnits = tkUnitsOfMeasure.umMeters
AxMap1.TileProvider = tkTileProvider.BingMaps
AxMap1.CursorMode = tkCursorMode.cmPan
'create a shape file array of nn length set by dim.....
For i As Integer = 0 To sf_array.Length - 1
sf_array(i) = New Shapefile()
Next
End Sub
Private Sub btnLoadMapWithColouredPointsperLayer_Click(sender As Object, e As EventArgs) Handles btnLoadMapWithColouredPointsperLayer.Click
'clear the map of any existing layers
AxMap1.RemoveAllLayers()
'create new shape file of type point for each layer
For i As Integer = 0 To sf_array.Length - 1
Dim result1 As Boolean = sf_array(i).CreateNew("", ShpfileType.SHP_POINT)
Next
'loop to create 20 example random points for demonstration
'this could be reading rows in a data table, list or array etc to show points depending on
'a value. in this case if the count is 1 to 5 make the point and labels aqua etc.
'the number of shapeiles here is dependant on the size of the shapefile array....
For icount As Integer = 1 To 20
Select Case icount
Case 1 To 5
call CreatePointsInShapefile(sf_array(0), icount, tkMapColor.Aqua)
Case 6 To 10
call CreatePointsInShapefile(sf_array(1), icount, tkMapColor.Red)
Case 11 To 15
call CreatePointsInShapefile(sf_array(2), icount, tkMapColor.Lime)
Case 15 To 20
call CreatePointsInShapefile(sf_array(3), icount, tkMapColor.Gold)
End Select
Next
Debug.Print("No.of Imsi pts : " & sf_array(1).NumShapes + sf_array(2).NumShapes + sf_array(3).NumShapes + sf_array(3).NumShapes)
'after doing everything we need to add the layers to the map MUST BE DONE....
For i As Integer = 0 To sf_array.Length - 1
map_layerHandleArray(i) = AxMap1.AddLayer(sf_array(i), True)
Next
AxMap1.ZoomToMaxVisibleExtents()
Debug.Print("SF0 layer Handle = " & map_layerHandleArray(0))
Debug.Print("SF1 layer Handle = " & map_layerHandleArray(1))
Debug.Print("SF2 layer Handle = " & map_layerHandleArray(2))
Debug.Print("SF3 layer Handle = " & map_layerHandleArray(3))
Debug.Print("Number of total layers : " & AxMap1.NumLayers)
AxMap1.Refresh()
AxMap1.Redraw()
End Sub
'the sub that does the point shape creation, called from the select case above.....
Private Sub CreatePointsInShapefile(ByVal sfile As Shapefile, ByRef icount As Integer, ByRef pointColour As tkMapColor)
Dim pnt = New Point()
'lat x y comes from earlier declared tem lat lon....
AxMap1.DegreesToProj(lat_x, lon_y, x1, y1)
'move the points around so they are not all on top of each other
pnt.x = x1 - (rnd1.Next(1, 2000) * icount)
pnt.y = y1 - (rnd1.Next(1, 1000) * icount)
Dim shp As Shape = New Shape()
shp.Create(ShpfileType.SHP_POINT)
'insert the new shape point
shp.InsertPoint(pnt, 0)
'now that its in there we need to edit it...
sfile.EditAddShape(shp)
'we add some table fields to the point ....
sfile.EditAddField("aNumb", FieldType.STRING_FIELD, 0, 20)
sfile.EditAddField("sText", FieldType.STRING_FIELD, 0, 20)
'then we edit the fields we created above, here i am just demonstrating
'some random text and numbers....
sfile.EditCellValue(0, 0, "Numb= " & rnd1.Next(10000, 20000))
sfile.EditCellValue(1, 0, "Str= " & GetRandomText())
'create a string using the fields we created text...
Dim s As String = ""
s = sfile.CellValue(0, 0) & vbCrLf & sfile.CellValue(1, 0)
'now add labels with properties and the string...
With sfile.Labels
.AddLabel(s, pnt.x, pnt.y, 0, -1)
.AvoidCollisions = False
.CollisionBuffer = 0
.AutoOffset = True
.Alignment = tkLabelAlignment.laBottomRight
.OffsetX = 5
.OffsetY = 5
.FontSize = 9
.FontColor = utls.ColorByName(tkMapColor.DarkBlue)
.FrameBackColor = utls.ColorByName(pointColour)
.FrameTransparency = 150
.Visible = True
End With
'modify the point shape types
sfile.DefaultDrawingOptions.PointShape = tkPointShapeType.ptShapeCircle
sfile.DefaultDrawingOptions.PointSize = 10
sfile.DefaultDrawingOptions.FillColor = utls.ColorByName(pointColour)
sfile.CollisionMode = tkCollisionMode.AllowCollisions
End Sub
Private Function GetRandomText() As String
Dim txtChars As New System.Text.StringBuilder
Dim tmpId = Guid.NewGuid
Dim b64 = Convert.ToBase64String(tmpId.ToByteArray)
For Each c In b64
If Char.IsLetterOrDigit(c) Then
txtChars.Append(Char.ToUpper(c))
If txtChars.Length = 6 Then Exit For
End If
Next
Return txtChars.ToString
End Function
End Class
1 Like