Home arrow GIS Data & Resources arrow Scripts and Code arrow Visual Basic / VBA arrow VBA: Utah Transportation Data Model, Data Loader Script
VBA: Utah Transportation Data Model, Data Loader Script PDF Print E-mail

Written by Bert Granberg,

This script is designed to circumvent the restrictions in the ArcCatalog 'Load Data' functionality for transferring local streets data that is roughly compliant with the Utah Transportation Data Model (UTDM) format into the UTDM format.

Run it in ArcMap with the local data (Source) and an empty UTDM feature class (Target) added as layers and set the 3 parameters accordingly.

Public Sub UTDMAttributeMapAndTransfer()

    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
    Dim countyStr As String
    Dim pQF As IQueryFilter
    Dim f As Integer
    Dim pInCursor As IFeatureCursor
    Dim pInBuff As IFeatureBuffer
    Dim fType As Integer
    Dim fLen As Integer
    Dim pPolyline As IPolyline
   
    Dim count As Integer
    Set pMxDoc = ThisDocument
    Set pMap = pMxDoc.FocusMap
   
    '***SET PARAMETERS HERE!
    Set countyStr = "CO18" '= salt lake county
    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
    '***END PARAMETERS

    Set pQF = New QueryFilter
    pQF.WhereClause = ""
   
    Set pSrcFeatureCursor = pSrcLayer.Search(pQF, True)
    Set pSrcFeature = pSrcFeatureCursor.NextFeature
   

    Set pInCursor = pTarFeatureClass.Insert(True)

    Set pInBuff = pTarFeatureClass.CreateFeatureBuffer

    count = 0
    Do Until pSrcFeature Is Nothing
        count = count + 1
        'Set pTarFeature = pTarFeatureClass.CreateFeature ' makes new feature record
        Set pInBuff = pTarFeatureClass.CreateFeatureBuffer
       
        'Loop Through All Fields in the UTDM-based  Target FC (the FC to be populated)
        For f = 0 To pTarFeatureClass.Fields.FieldCount - 1
       
            'Debug.Print pTarFeatureClass.Fields.Field(f).Name
           
            'Is Geometry Field?
            If pTarFeatureClass.Fields.Field(f).Name = pTarFeatureClass.ShapeFieldName Then
                Set pInBuff.Shape = pSrcFeature.Shape
           
            'Is AGRC SRC field? If so then set with County Code
            ElseIf UCase(pTarFeatureClass.Fields.Field(f).Name) = "AGRC_SRC" Then
                pInBuff.Value(f) = countyStr 'set above in parameters
           
            'Write your own mapping exceptions here if needed with
            'Example:
            '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"))
           
            'Is Non-Editable Field, or doesn't exist in Source Feature Class
            ElseIf pTarFeatureClass.Fields.Field(f).Name = pTarFeatureClass.OIDFieldName _
                 Or UCase(pTarFeatureClass.Fields.Field(f).Name) = "SHAPE_LENGTH" Or _
               (Not pSrcFeatureClass.FindField(LCase(pTarFeatureClass.Fields.Field(f).Name)) >= 0 And _
               (Not pSrcFeatureClass.FindField(pTarFeatureClass.Fields.Field(f).Name) >= 0)) Then
                'do nothing
               
            'Is String-Based Field, truncate to UTDM specified length
            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)

            'All other fields handled here...
            ElseIf pSrcFeatureClass.FindField(pTarFeatureClass.Fields.Field(f).Name) > 0 Then
                tempVal = pSrcFeature.Value(pSrcFeatureClass.FindField(pTarFeatureClass.Fields.Field(f).Name))
               
                'handle short integer fields, avoid out of range errors
                If pTarFeatureClass.Fields.Field(f).Type = 1 Then
                    If CLng(tempVal) <= 32767 And CLng(tempVal) >= -32768 Then
                        pInBuff.Value(f) = tempVal
                    Else
                        'do nothing
                    End If
                'all other fields
                Else
                    pInBuff.Value(f) = tempVal
                End If
        Next f
               
        Debug.Print pSrcFeature.OID
        pInCursor.InsertFeature pInBuff
           
        'pTarFeature.Store
        If count >= 200 Then
            pInCursor.Flush
            count = 0
        End If
        Set pSrcFeature = pSrcFeatureCursor.NextFeature

    Loop
   
    pInCursor.Flush

End Sub


Users' Comments  
 

No comment posted

Add your comment

01, Jan. 2007
Last Updated ( 21, Jan. 2009 )
 
< Prev   Next >

AGRC Contacts | UGIC Contacts

feed image feed image

Utah GIS Portal © 2009 AGRC

Optimized for