Attribute Transfer Mapping

SpencerTrevor — Wed, 27 Jul 2011 02:59:58 GMT

Good day,

I found a code in this forum where it is for Attribute Transfer Mapping, it is actually to transfer the attribute from a shapefile to another shapfile. But once i implement the code, and click the button, nothing happen. Bellow is the code.

=====================================

Public Sub PutViaAttributeTransfer()

    'Copy geometry and attributes from selected features to a target layer
    'Define source, target and attributes to be transfered via
    'Spatial Adjustment Attribute Transfer Mapping dialog.

    Dim pMxDoc As IMxDocument
    Dim pMap As IMap
    Dim pEditor As IEditor
    Dim pAttTransType As IAttributeTransferType
    Dim pAttTrans As IAttributeTransfer
    Dim pATDS As IAttributeTransferDefaultSettings

    Dim pSourceFeatLyr As IFeatureLayer2
    Dim pTargetFeatLyr As IFeatureLayer2
    Dim pFieldMap As IFieldMap

    Dim pEnumFeat As IEnumFeature
    Dim pSourceFeature As IFeature
    Dim pTargetFeature As IFeature
    Dim bATSucess As Boolean

    'Get the doc and Map
    Set pMxDoc = ThisDocument
    Set pMap = pMxDoc.FocusMap

    'Get the editor
    Set pEditor = Application.FindExtensionByName("ESRI Object Editor")

    'QI for Attribute Transfer Type and get IAttributeTransfer
    Set pAttTransType = pEditor
    Set pAttTrans = pAttTransType.AttributeTransfer

    'QI for default settings and return source/target layers
    Set pATDS = pAttTrans
    Set pSourceFeatLyr = ReturnLayer(pMap, pATDS.SourceName)

    'If no mapping set, pSourceFeatLyr will be nothing (null sourcename) so bail
    If pSourceFeatLyr Is Nothing Then
        MsgBox "Attribute Transfer field mapping not set"
        Exit Sub
    End If

    'Get the fieldmap for the source layer
    Set pFieldMap = pAttTrans.FindFieldMap(pSourceFeatLyr.FeatureClass, Nothing)

    'If fieldmap is nothing then warn user
    If pFieldMap Is Nothing Then
        MsgBox "Attribute Transfer field mapping not set"
        Exit Sub
    End If

    'get target feature layer
    Set pTargetFeatLyr = ReturnLayer(pMap, pATDS.TargetName)

    'Check if source and target have same geometry type
    If Not (pSourceFeatLyr.FeatureClass.ShapeType = pTargetFeatLyr.FeatureClass.ShapeType) Then
        MsgBox "Source and Target Layer geometries do not match", vbExclamation
        Exit Sub
    End If


    'Enumerate through each selected feature (source)
    Set pEnumFeat = pEditor.EditSelection
    pEnumFeat.Reset
    Set pSourceFeature = pEnumFeat.Next

    pEditor.StartOperation

    Do Until pSourceFeature Is Nothing

        'Create a new feature in the target
        Set pTargetFeature = pTargetFeatLyr.FeatureClass.CreateFeature
        Set pTargetFeature.Shape = pSourceFeature.ShapeCopy
        pTargetFeature.Store

        'Transfer the attributes
        If Not (pTargetFeature Is Nothing) Then
            'Transfer attributes to the new target feature
            pAttTrans.Transfer pFieldMap, pSourceFeature, pTargetFeature, bATSucess
            'Debug.Print bATSucess
        End If

        Set pSourceFeature = pEnumFeat.Next
    Loop

    pEditor.StopOperation "PUT"

End Sub

Private Function ReturnLayer(pMap As IMap, sLayerName As String) As ILayer

    'Find a layer in a map document
    'Return the layer or nothing if not found

    Dim pEnumLayers As IEnumLayer
    Dim pLayer As ILayer

    Set pEnumLayers = pMap.Layers(Nothing, True)
    pEnumLayers.Reset
    Set pLayer = pEnumLayers.Next

    Set ReturnLayer = Nothing

    Do Until pLayer Is Nothing
        If pLayer.Name = sLayerName Then
            Set ReturnLayer = pLayer
            Exit Do
        End If
        Set pLayer = pEnumLayers.Next
    Loop

End Function

=====================================

Do I have to change the code to make it work...? any help will do. Thank you in advance

Re: Attribute Transfer Mapping

AlexanderGray — Wed, 27 Jul 2011 17:15:55 GMT

I suggest adding an error handler (onError GoTo) and stepping through the code to see where it stops.

topic Attribute Transfer Mapping in ArcObjects SDK Questions

Attribute Transfer Mapping

Re: Attribute Transfer Mapping