Home arrow GIS Data & Resources arrow Scripts and Code arrow Visual Basic / VBA arrow VBA: Convert Mileposts to Address Ranges
VBA: Convert Mileposts to Address Ranges PDF Print E-mail

Written by Bert Granberg,


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
       
        pfeature.Store
       
        Set pfeature = pFCursor.NextFeature
    Loop
   
End Sub



Users' Comments  
 

No comment posted

Add your comment

01, Jan. 2009
Last Updated ( 10, Feb. 2009 )
 
< Prev   Next >

AGRC Contacts | UGIC Contacts

feed image feed image

Utah GIS Portal © 2009 AGRC

Optimized for