Select points in box

1

Hello,
I am trying to select the points in side of the cmselection box but nothing gets selected. I get values returned when i debug.print left, right, bottom and top, but I suspect the problem is that I need to convert these values? Here is my code:

Private Sub Map0_SelectBoxFinal(ByVal left As Long, ByVal right As Long, ByVal bottom As Long, ByVal top As Long)
Dim gs As New MapWinGIS.GlobalSettings
gs.AllowProjectionMismatch = True
Me.Map0.SendSelectBoxFinal = True
Dim sf As New MapWinGIS.Shapefile
Dim ext As New MapWinGIS.Extents
Dim lh As Integer
Dim xmin As Double
Dim ymin As Double
Dim zmin As Double
Dim xmax As Double
Dim ymax As Double
Dim zmax As Double
Dim i As Long
Dim results As Object

With Me.Map0

xmin = left
ymin = bottom
zmin = 0#
xmax = right
ymax = top
zmax = 0#


ext.SetBounds xmin, ymin, zmin, xmax, ymax, zmax

lh = Me.Map0.LayerHandle(0)

sf.StartEditingShapes (True)

sf.SelectShapes ext, 0#, SelectMode.INTERSECTION, results

For i = 0 To 100
sf.ShapeSelected(i) = True
Next


Debug.Print sf.NumShapes

End With

End Sub
2

Another possible solution is to be able to get the details of the points highlighted with cmselection. I am able to draw a box and have the points within the box highlighted, but Iā€™m not able to interact with the selected points as I am with the cmidentify tool. Any help would be greatly appreciated!

4

i figured it out. the shapes were being selected, i just needed the correct code to extract the information.

5

@mikeradtke Great that you solved your own issue.
Would you mind sharing your working code? It might help others.

1 Like
8

Sure! Here it is:

Me.Map0.SetFocus
Dim gs As New MapWinGIS.GlobalSettings
gs.AllowProjectionMismatch = True
Me.Map0.SendSelectBoxFinal = True

Dim lh As Integer
Dim xmin As Double
Dim ymin As Double
Dim zmin As Double
Dim xmax As Double
Dim ymax As Double
Dim zmax As Double
Dim i As Long
Dim results As Object
Dim ext As New extents
Dim Y As Integer
Dim z As Integer
Dim sf As Shapefile
xmin = Left
ymin = Bottom
zmin = 0#
xmax = Right
ymax = Top
zmax = 0#
mn = DCount("[ID]", "Status")
mx = mn + DMax("lyrlookup", "CSI Divisions") - 1
DoCmd.SetWarnings (False)
DoCmd.RunSQL "DELETE * FROM Emails where [Work State] <> 'Nationwide'"


With Me.Map0
For sb = mn To mx
Set sf = Me.Map0.Shapefile(sb)
If DCount("[shapeno]", "Master", "[Layer] = " & sb) = 0 Then GoTo nxt
ext.SetBounds xmin, ymin, zmin, xmax, ymax, zmax
sf.SelectShapes ext, 0#, SelectMode.INCLUSION, results
Y = DMin("[shapeno]", "Master", "[Layer] = " & sb)
z = DMax("[shapeno]", "Master", "[Layer] = " & sb)
    For i = Y To z
    If sf.ShapeSelected(i) = False Then GoTo nn
    If sf.ShapeSelected(i) = True Then
    subbb = DLookup("[Subcontractor]", "Master", "[shapeno] = " & i & " AND [Layer] = " & sb)

        If IsNull(subbb) Then GoTo nn
        strSQL = "INSERT INTO Emails ([Subcontractor],[Union],[Trade],[Trade 2],[Trade 3],[Trade 4],[Trade 5],[Trade 6],[Division],[Work State],[Rating],[E-mail 1],[E-mail 2],[E-mail 3])" & _
        "SELECT [Subcontractor],[Union/Non Union],[Trade],[Trade2],[Trade3],[Trade4],[Trade5],[Trade6], [CSI Division], [Work State], [Rating],[E-mail 1],[E-mail 2],[E-mail 3] FROM Master" & _
        " WHERE [Subcontractor] = '" & subbb & "'"
        DoCmd.RunSQL strSQL
          
nn:
    End If

sf.ShapeSelected(i) = False
    Next
nxt:
Next
cc:

End With

Me.Map0.CursorMode = cmPan
DoCmd.RunSQL "DELETE * FROM Emails WHERE isnull([E-mail 1])"
If DCount("[ID]", "Emails") = 0 Then
Forms!Jobtemplate.SetFocus
GoTo skpop
End If
DoCmd.OpenForm "MassReviewRecipients", , , , , , Me.Name
skpop:
DoCmd.SetWarnings (True)



Set pr = Nothing
Set rq = Nothing
Set sf = Nothing
Exit Sub
1 Like