📄 geocoder.frm
字号:
Height = 255
Index = 6
Left = -73440
TabIndex = 49
Top = 3600
Visible = 0 'False
Width = 2895
End
Begin VB.Label lblBatchMatch
Caption = "Output shapefile:"
Height = 225
Index = 5
Left = -74520
TabIndex = 48
Top = 3360
Visible = 0 'False
Width = 1455
End
Begin VB.Label lblBatchMatch
Caption = "Navigate to the dBASE table which contains the addresses to be matched."
Height = 495
Index = 0
Left = -74520
TabIndex = 46
Top = 600
Width = 4095
End
Begin VB.Label lblBatchMatch
Alignment = 2 'Center
BackColor = &H00FFFFFF&
Height = 255
Index = 2
Left = -73440
TabIndex = 45
Top = 1440
Visible = 0 'False
Width = 2895
End
Begin VB.Label lblBatchMatch
BackColor = &H00C0C0C0&
Caption = "Select the fields that contain the addresses to be matched."
Height = 255
Index = 3
Left = -74520
TabIndex = 44
Top = 1920
Visible = 0 'False
Width = 4215
End
Begin VB.Label lblBatchMatch
Caption = "Source table:"
Height = 225
Index = 1
Left = -74520
TabIndex = 43
Top = 1200
Visible = 0 'False
Width = 1455
End
Begin VB.Label lblBatchMatch
BackColor = &H00C0C0C0&
Caption = "...and draw them using this color, marker style, and size:"
Height = 285
Index = 4
Left = -74640
TabIndex = 42
Top = 3960
Visible = 0 'False
Width = 3975
End
Begin VB.Label lblSingleMatch
Caption = "Find this address..."
Height = 255
Index = 0
Left = -73320
TabIndex = 35
Top = 960
Width = 1575
End
Begin VB.Label lblSingleMatch
Caption = "...and draw it using this color, marker style, and size:"
Height = 495
Index = 1
Left = -73680
TabIndex = 34
Top = 2760
Width = 2175
End
Begin VB.Label lblInstructions
Caption = "Select the fields in the street base layer that hold the address information."
Height = 375
Left = 240
TabIndex = 23
Top = 600
Width = 4215
End
Begin VB.Label lblBaseFields
Alignment = 1 'Right Justify
Caption = "Right Zone:"
Height = 255
Index = 10
Left = 1245
TabIndex = 12
Top = 4140
Width = 1455
End
Begin VB.Label lblBaseFields
Alignment = 1 'Right Justify
Caption = "Left Zone:"
Height = 255
Index = 9
Left = 1245
TabIndex = 11
Top = 3840
Width = 1455
End
Begin VB.Label lblBaseFields
Alignment = 1 'Right Justify
Caption = "Suffix Direction:"
Height = 255
Index = 8
Left = 1245
TabIndex = 10
Top = 3540
Width = 1455
End
Begin VB.Label lblBaseFields
Alignment = 1 'Right Justify
Caption = "Street Type:"
Height = 255
Index = 7
Left = 1245
TabIndex = 9
Top = 3240
Width = 1455
End
Begin VB.Label lblBaseFields
Alignment = 1 'Right Justify
Caption = "Street Name:"
Height = 255
Index = 6
Left = 1245
TabIndex = 8
Top = 2940
Width = 1455
End
Begin VB.Label lblBaseFields
Alignment = 1 'Right Justify
Caption = "Prefix Type:"
Height = 255
Index = 5
Left = 1245
TabIndex = 7
Top = 2640
Width = 1455
End
Begin VB.Label lblBaseFields
Alignment = 1 'Right Justify
Caption = "Prefix Direction:"
Height = 255
Index = 4
Left = 1245
TabIndex = 6
Top = 2340
Width = 1455
End
Begin VB.Label lblBaseFields
Alignment = 1 'Right Justify
Caption = "Right To:"
Height = 255
Index = 3
Left = 1245
TabIndex = 5
Top = 2040
Width = 1455
End
Begin VB.Label lblBaseFields
Alignment = 1 'Right Justify
Caption = "Right From:"
Height = 255
Index = 2
Left = 1245
TabIndex = 4
Top = 1740
Width = 1455
End
Begin VB.Label lblBaseFields
Alignment = 1 'Right Justify
Caption = "Left To:"
Height = 255
Index = 1
Left = 1245
TabIndex = 3
Top = 1440
Width = 1455
End
Begin VB.Label lblBaseFields
Alignment = 1 'Right Justify
Caption = "Left From:"
Height = 255
Index = 0
Left = 1245
TabIndex = 1
Top = 1140
Width = 1455
End
End
End
Attribute VB_Name = "frmGeocoder"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private dc As New mapobjects2.DataConnection
Private mlyrBase As mapobjects2.MapLayer
Private tblAddresses As New mapobjects2.Table
Private ptSingleMatch As mapobjects2.Point
Private strsFieldNames As New mapobjects2.Strings
Private geo As New mapobjects2.Geocoder
Private stan As New mapobjects2.Standardizer
Private m_FromLeft, m_ToLeft, m_FromRight, m_ToRight As String
Private m_PreDir, m_PreType, m_StreetType, m_SufDir As String
Private m_StreetName As String
Private m_LeftZone, m_RightZone As String
Private strKeyFields(10) As String
Private strBaseFields(10) As String
Private strInFileName, strOutFileName As String
Private Sub cmdBatchMatch_Click()
Dim pts As mapobjects2.Points
Dim strFieldNameSource, strAddress, strZone, strReport As String
Dim i As Long
Dim mlyrOutput As New mapobjects2.MapLayer
Dim count As Integer
Dim rectNewLayerExtent As mapobjects2.Rectangle
'Get the address and zone from the user's ComboBox selections
strAddress = cboBatchMatch(2).List(cboBatchMatch(2).ListIndex)
strZone = cboBatchMatch(3).List(cboBatchMatch(3).ListIndex)
'Set default minimum match score
geo.MinimumMatchScore = 60
'Point batchmatch variable field to
geo.BatchMatchVariableField("LeftZone") = strZone
geo.BatchMatchVariableField("RightZone") = strZone
'As long as the folder to store the output shapefile is
'valid and connected, perform the batch match now.
If dc.Connected Then
count = geo.BatchMatch(tblAddresses, strAddress, dc, strOutFileName, Nothing)
Else
MsgBox dc.Database & " no longer connected.", vbCritical, "Stop"
Exit Sub
End If
'If at least one address was matched. Add the new geocoded
'point shapefile to the map as a layer.
If count > 0 Then
Set mlyrOutput.GeoDataset = dc.FindGeoDataset(strOutFileName)
With mlyrOutput.Symbol
.SymbolType = moPointSymbol
.style = cboBatchMatch(0).ListIndex
.Size = cboBatchMatch(1).List(cboBatchMatch(1).ListIndex)
.color = picBatchMatch.BackColor
End With
frmMain.mapDisp.Layers.Add mlyrOutput
frmMain.legMapDisp.LoadLegend
Set rectNewLayerExtent = mlyrOutput.Extent
rectNewLayerExtent.ScaleRectangle 1.2
Set frmMain.mapDisp.Extent = rectNewLayerExtent
frmMain.refreshMapTips
frmMain.mapDisp.Refresh
End If
'Add the "moView2" standard shapefile tag.
frmMain.mapDisp.Layers(0).tag = "[SHAPEFILE]" & dc.Database & "|" & mlyrOutput.Name
'Report the results to the user
strReport = "Input address table: " & strInFileName & vbCrLf & _
"Input record count: " & mlyrOutput.Records.count & vbCrLf & _
"Matched address count: " & count
MsgBox strReport, vbModal, "Batch Match Results"
'Synchronize the symbol controls contained within both
'the Single Match and Batch Match tabs.
Call SyncSymbolCombos(2)
'Conclude the geocoding process by closing the Geocode form.
Unload Me
End Sub
Private Sub cmdBuildIndex_Click()
' Set up USA addressing rules with the Standardizer and Geocoder object.
'
Dim gd As Object
Dim lyr As New MapLayer
Dim cline As String
Dim aFieldName As String
Dim i As Integer
Dim path, sfn As String
Dim pipeloc As Integer
'
' Use the US rules for street addresses and intersection standardizing
' by telling the Standardizer object where they are.
'
stan.StandardizingRules = App.path & "\..\..\..\GeoRules\us_addr.stn"
If Not stan.Valid Then
MsgBox "Couldn't make the Standardizer Valid. This standardizing rules" & vbCrLf & _
"file could not be found: " & stan.StandardizingRules, vbCritical, "Stop"
Unload Me
End If
'Extract the shapefile path and name from the layer's tag property.
'The Tag stores this information in the following format:
' [SHAPEFILE]C:\MYDATAPATH|MYSHAPEFILE_NAME
' [SHAPEFILZ]C:\MYDATAPATH|MY_Z_SHAPEFILE_NAME
pipeloc = InStr(mlyrBase.tag, "|")
path = Mid(mlyrBase.tag, 12, Len(mlyrBase.tag) - 12 - (Len(mlyrBase.tag) - pipeloc))
sfn = Right(mlyrBase.tag, Len(mlyrBase.tag) - pipeloc)
'
' Connect to the shape file database (directory)
'
dc.Database = path
dc.Connect
If Not dc.Connected Then
MsgBox dc.ConnectError, vbCritical, "Connect Failed"
End
End If
'
' Get the Redlands shape file from this database and add it to the Map control.
'
Set gd = dc.FindGeoDataset(sfn)
' Hand the Geocoder the Standardizer and a set of match rules for street and
' intersections. Also give it the Redlands GeoDataset object so it knows what
' to geocode against.
'
Set geo.Standardizer = stan
Set geo.StreetTable = gd
geo.MatchRules = App.path & "\..\..\..\GeoRules\us_addr1.mat" 'US Streets with Zone
'geo.MatchRules = App.Path & "\GeoRules\us_addr2.mat" 'US Streets without Zone
'Load the base layer's matching fields into a string array
For i = 0 To 10
strBaseFields(i) = cboBaseFields(i).List(cboBaseFields(i).ListIndex)
Next
'Populate the base layer's matching fields into the Geocoder's
'MatchVariableField property array. Nullify any fields that
'the base layer does not contain, or those that the user does
'not want considered during the matching process.
For i = 0 To 10
aFieldName = strBaseFields(i)
If aFieldName <> "<NONE>" Then
geo.MatchVariableField(strKeyFields(i)) = aFieldName
Else
geo.MatchVariableField(strKeyFields(i)) = ""
End If
Next
' If the indices have been built then set the queries up. Otherwise build the
' indices which will also set the queries.
If Not IsIndexBuilt Then
If Not BuildIndex Then
MsgBox "Geocoding index could not be built.", vbCritical, "Stop"
Exit Sub
End If
End If
Call SetIndexQueries
'Initialize other tabs for matching.
sstGeocoder.TabEnabled(1) = True
sstGeocoder.TabEnabled(2) = True
sstGeocoder.Tab = 1
End Sub
Private Sub cmdOpenDatabase_Click()
'Have the user navigate to the dBASE file which contains
'the addresses to be matched against the base street layer.
Dim fnsource, pathsource As String
Dim i As Integer
Dim recs As mapobjects2.Recordset
Dim tDesc As mapobjects2.TableDesc
'Find the dBASE file
cdlGeocoder.Filter = "dBASE Files (*.dbf)|*.dbf"
cdlGeocoder.ShowOpen
If Len(cdlGeocoder.filename) = 0 Then Exit Sub
fnsource = Left(cdlGeocoder.FileTitle, Len(cdlGeocoder.FileTitle) - 4)
strInFileName = fnsource
pathsource = Left(cdlGeocoder.filename, _
Len(cdlGeocoder.filename) - Len(fnsource) - 4)
'Build a MO Table object, get its recordset and fieldname list.
tblAddresses.Database = "dBASE IV;DATABASE=" & pathsource
tblAddresses.Name = fnsource
Set recs = tblAddresses.Records
Set tDesc = recs.TableDesc
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -