Move UTRANS to StreetCenterlines

Home

GIS Data & Resources

Scripts and Code

Visual Basic / VBA

Move UTRANS to StreetCenterlines

Written by Bert Granberg,

An ArcMap VBA script to move features from AGRC editing database to the public facing street centerlines feature class. 'UPDATED 3/26/08

Public Sub UTransToStatewideStreets()

    On Error GoTo errorhandler
    Dim pMxDoc As IMxDocument
    Dim pMap As IMap

    Dim pSrcLayer As IFeatureLayer
    Dim pSrcFeatureClass As IFeatureClass
    Dim pSrcFeatureCursor As IFeatureCursor
    Dim pSrcFeature As IFeature
    Dim pTarLayer As IFeatureLayer
    Dim pTarFeatureClass As IFeatureClass
    Dim pTarFeature As IFeature

    Set pMxDoc = ThisDocument
    Set pMap = pMxDoc.FocusMap

    Dim pGP As Object
    Set pGP = CreateObject("esriGeoprocessing.GPDispatch.1")

    Set pSrcLayer = pMap.Layer(0) '(Source Layer is first layer in TOC)
    Set pSrcFeatureClass = pSrcLayer.FeatureClass
    Set pTarLayer = pMap.Layer(1) '(Target layer is second layer in TOC)
    Set pTarFeatureClass = pTarLayer.FeatureClass

    pGP.DeleteFeatures (pTarLayer.name)

    Dim pqf As IQueryFilter
    Set pqf = New QueryFilter
    pqf.WhereClause = ""

    Set pSrcFeatureCursor = pSrcLayer.Search(pqf, True)
    Set pSrcFeature = pSrcFeatureCursor.NextFeature

    Dim pID As New UID
    pID = "esriEditor.Editor"
    Dim pEditor As IEditor
    Set pEditor = Application.FindExtensionByCLSID(pID)

    Dim pDataset As IDataset
    Dim pWorkspace As IWorkspace
    Set pDataset = pTarFeatureClass 'qi
    Set pWorkspace = pDataset.Workspace
    Dim pWSEdit As IWorkspaceEdit
    Set pWSEdit = pWorkspace

    'pEditor.StartEditing pWorkspace

    Dim f As Integer
    Dim pInCursor As IFeatureCursor
    Set pInCursor = pTarFeatureClass.Insert(True)
    Dim pInBuff As IFeatureBuffer
    Set pInBuff = pTarFeatureClass.CreateFeatureBuffer
    Dim ftype As Integer
    Dim flen As Integer
    Dim pPolyline As IPolyline
    Dim pZAware As IZAware
    Dim pGeometry As IGeometry
    Dim count As Integer
    count = 0
    Do Until pSrcFeature Is Nothing

        If Not IsNull(pSrcFeature.value(pSrcFeature.fields.FindField("Shape.len")))Then
            If pSrcFeature.value(pSrcFeature.fields.FindField("Shape.len")) > 0 Then
                count = count + 1
                Set pInBuff = pTarFeatureClass.CreateFeatureBuffer
                For f = 0 To pTarFeatureClass.Fields.FieldCount - 1

                    If pTarFeatureClass.Fields.Field(f).name = pTarFeatureClass.ShapeFieldName Then
                        Set pInBuff.Shape = pSrcFeature.Shape
                    ElseIf pTarFeatureClass.Fields.Field(f).name = pTarFeatureClass.OIDFieldName Or UCase(pTarFeatureClass.Fields.Field(f).name) = UCase(pTarFeatureClass.LengthField.name) Or _
                       (Not pSrcFeatureClass.FindField(LCase(pTarFeatureClass.Fields.Field(f).name)) >= 0 And _
                       (Not pSrcFeatureClass.FindField(pTarFeatureClass.Fields.Field(f).name) >= 0)) Then
                        'Debug.Print "ignoring: " & pTarFeatureClass.Fields.Field(f).Name
                        'do nothing
                    ElseIf pTarFeatureClass.Fields.Field(f).name = "S_ACCUR" Or _
                        pTarFeatureClass.Fields.Field(f).name = "S_WIDTH" Or _
                        pTarFeatureClass.Fields.Field(f).name = "S_DATE" Or _
                        pTarFeatureClass.Fields.Field(f).name = "NOTES" Or _
                        pTarFeatureClass.Fields.Field(f).name = "S_FUNC" Or _
                        pTarFeatureClass.Fields.Field(f).name = "S_ROW" Or _
                        pTarFeatureClass.Fields.Field(f).name = "S_AGFUNC" Or _
                        pTarFeatureClass.Fields.Field(f).name = "S_ACCESS" Or _
                        pTarFeatureClass.Fields.Field(f).name = "S_JURIS" Or _
                        pTarFeatureClass.Fields.Field(f).name = "S_FUNC" Or _
                        pTarFeatureClass.Fields.Field(f).name = "CLASS" Or _
                        pTarFeatureClass.Fields.Field(f).name = "S_USE" Or _
                        pTarFeatureClass.Fields.Field(f).name = "NOTES" Or _
                        pTarFeatureClass.Fields.Field(f).name = "SOURCE" Or _
                        pTarFeatureClass.Fields.Field(f).name = "STATUS" Then


                    ElseIf UCase(pTarFeatureClass.Fields.Field(f).name) = "JURIS_RIGHT" And _
                        Not pSrcFeatureClass.FindField("JURIS_RIGHT") > 0 And _
                        pSrcFeatureClass.FindField("JURIS_RGHT") Then
                        pInBuff.Value(f) = pSrcFeature.Value(pSrcFeatureClass.FindField("JURIS_RGHT"))

                    ElseIf UCase(pTarFeatureClass.Fields.Field(f).Name) = "SUF_DIR" Then
                        If IsNumeric(Left(pSrcFeature.Value(pSrcFeatureClass.FindField("S_NAME")), 2)) Then
                            flen = pTarFeatureClass.Fields.Field(f).Length
                            pInBuff.Value(f) = Left(pSrcFeature.Value(pSrcFeatureClass.FindField(pTarFeatureClass.Fields.Field(f).Name)), flen)
                        Else
                            pInBuff.Value(f) = ""
                  'this makes a blank suffix direction value for named street
                        End If

                    ElseIf pTarFeatureClass.Fields.Field(f).Type = esriFieldTypeString Then
                        flen = pTarFeatureClass.Fields.Field(f).Length
                        pInBuff.Value(f) = Left(pSrcFeature.Value(pSrcFeatureClass.FindField(pTarFeatureClass.Fields.Field(f).name)), flen)
                    ElseIf pSrcFeatureClass.FindField(pTarFeatureClass.Fields.Field(f).name) > 0 Then
                        pInBuff.Value(f) = pSrcFeature.Value(pSrcFeatureClass.FindField(pTarFeatureClass.Fields.Field(f).name))
                    End If
                Next f

                Debug.Print pSrcFeature.OID
                pInCursor.InsertFeature pInBuff

                'pTarFeature.Store
                If count >= 200 Then
                    pInCursor.Flush
                    count = 0
                End If
            End If
        End If
        Set pSrcFeature = pSrcFeatureCursor.NextFeature

    Loop
    pInCursor.Flush
    'pEditor.StopEditing True
    Exit Sub
errorhandler:
    Resume Next
End Sub

Users' Comments

No comment posted

Add your comment

25, Oct. 2007

Last Updated ( 13, Aug. 2008 )

< Prev		Next >

[ Back ]

Main Menu

Registered User Menu

User Login