This script takes start and end milepost values for a given feature and converts them to address range attributes for both sides of the street using a factor (usually 100 or 1000) to provide enough precision that the addresses are useable after they are truncated to whole numbers
Public Sub CreateAddressRangesFromMilepostValues()
'Works on Selected Set of Features, ONLY
Dim pMxDoc As IMxDocument Dim pMap As IMap Set pMxDoc = ThisDocument Set pMap = pMxDoc.FocusMap
Dim pFLayer As IFeatureLayer Dim pFClass As IFeatureClass Dim pTable As ITable Dim milePostAddressFactor As Double
Dim lFIndex As Integer Dim lTIndex As Integer Dim rFIndex As Integer Dim rTIndex As Integer Dim milePostStartIndex As Integer Dim milePostEndIndex As Integer Dim milepostStartFieldName As String Dim milepostEndFieldName As String Dim leftAddFromName As String Dim leftAddToName As String Dim rightAddFromName As String Dim rightAddToName As String
'*** SET THESE PARAMETERS
'set index number for street layer, first layer in the TOC display tab is layer 0 Set pFLayer = pMap.Layer(0) 'factor by which to multiply milepost values before conversion to whole numbers milePostAddressFactor = 100 '*** milepostStartFieldName = "L_F_ADD" milepostEndFieldName = "L_T_ADD" leftAddFromName = "L_F_ADD" leftAddToName = "L_T_ADD" rightAddFromName = "R_F_ADD" rightAddToName = "R_T_ADD"
'*** END SET PARAMETERS
Set pFClass = pFLayer.FeatureClass Set pTable = pFClass ' QI
Dim pFSel As IFeatureSelection Dim pSelSet As ISelectionSet Set pFSel = pFLayer 'QI Set pSelSet = pFSel.SelectionSet
'Get the index number corresponding to each field's position: milePostStartIndex = pFClass.FindField(milepostStartFieldName) milePostEndIndex = pFClass.FindField(milepostEndFieldName)
'Get the index number corresponding to each field's position: lFIndex = pFClass.FindField(leftAddFromName) lTIndex = pFClass.FindField(leftAddToName) rFIndex = pFClass.FindField(rightAddFromName) rTIndex = pFClass.FindField(rightAddToName)
Dim lFvalue As Long Dim lTvalue As Long Dim rFvalue As Long Dim rTvalue As Long
'Get a cursor to iterate thru the features in order of the tablesort Dim pfeature As IFeature Dim pFCursor As IFeatureCursor pSelSet.Search Nothing, True, pFCursor
'Set preconditions before looping structure Set pfeature = pFCursor.NextFeature
Do Until pfeature Is Nothing
'Multiplies values in address range field by milePostAddressFactor lFvalue = CLng(pfeature.Value(milePostStartIndex) * milePostAddressFactor) lTvalue = CLng(pfeature.Value(milePostEndIndex) * milePostAddressFactor) rFvalue = CLng(pfeature.Value(milePostStartIndex) * milePostAddressFactor) rTvalue = CLng(pfeature.Value(milePostEndIndex) * milePostAddressFactor)
'Determines whether each address range is odd or even 'L_F_ADD: If lFvalue / 2 <> CLng(lFvalue / 2) Then 'L_F_ADD is odd pfeature.Value(lFIndex) = CDbl(lFvalue) Else 'L_F_ADD is even pfeature.Value(lFIndex) = CDbl(lFvalue + 1)
End If 'R_F_ADD: If rFvalue / 2 = CLng(rFvalue / 2) Then 'R_F_ADD is even pfeature.Value(rFIndex) = CDbl(rFvalue) Else 'R_F_ADD is odd pfeature.Value(rFIndex) = CDbl(rFvalue + 1)
End If 'L_T_ADD: If lTvalue / 2 <> CLng(lTvalue / 2) Then 'L_T_ADD is odd pfeature.Value(lTIndex) = CDbl(lTvalue - 2) Else 'L_T_ADD is even pfeature.Value(lTIndex) = CDbl(lTvalue - 1)
End If 'R_T_ADD: If rTvalue / 2 = CLng(rTvalue / 2) Then 'R_T_ADD is even pfeature.Value(rTIndex) = CDbl(rTvalue - 2) Else 'R_T_ADD is odd pfeature.Value(rTIndex) = CDbl(rTvalue - 1) End If