Newsgroup: it.comp.lang.visual-basic
Titolo: [VBA-ArgGis] Copiare Campi della Tabella degli Attributo facendo conti. Ma come?

Ciao sto cercando di scrivere una semplicissima funzione che lavori 
all'interno di ArcView e che praticamente lavori sulla tabella degli 
attributi di un Layer.
Deve leggere un campo alla riga 1 e fare due conti e scrivere nel campo 2 
alla stessa riga. Ovviamente questo procedimento deve farlo per tutte le 
righe.
Purtroppo non riesco a farglielo fare nemmeno per una riga :-(
Public Sub Calcola_Sezione(Nome_Campo As String)
    Dim pmxDoc As IMxDocument
    Dim pLayer As ILayer
    Dim pFLayer As IFeatureLayer
    Dim pFeatClass As IFeatureClass
    Dim pFields As IFields
    Dim pField As IField
    Dim pFieldEdit As IFieldEdit
    Dim pMap As IMap
    Set pmxDoc = ThisDocument
    Set pMap = pmxDoc.FocusMap
    Set pLayer = pMap.Layer(0)
    Set pFLayer = pLayer
    Set pFeatClass = pFLayer.featureClass
    'Creazione del campo necessario per memorizzare il dato
    AggiuntaCampo Nome_Campo, 5, esriFieldTypeInteger
    'Calcola la Sezione in Base all'angolo del lato maggiore
    Dim pRow As IRow
    Dim pTheValue As IRow
    Dim First As Long
    Dim Second As Long
    Set pFields = pFeatClass.Fields
    Set First = pFields.Field(pFields.FindField("Bearing_起"))'Here receive 
Error
    Set Second = pFields.Field(pFields.FindField(Nome_Campo)) 'Here receive 
Error
    pTheValue = pRow.Value(First)'Here receive Error
    If (pTheValue > 0 And pTheValue <= 30) Then 'For Example
        pRow.Value(Second) = pTheValue 'Here receive Error
        pRow.Store
    Else
        MsgBox "Angle Error", vbInformation, "Answer"
    End If
End Sub 

Faccio un esempio vedi se ti piace...
Ho usato "Tua funzione" lì ci metti quello che serve a te.
Buon divertimento.
Public Sub GISOperation(NomeCampo as string)
Dim pMxDocument As IMxDocument
Dim pLayer As ILayer
Set pMxDocument = Application.Document
Set pLayer = pMxDocument.SelectedLayer
Set pMxDocument = Application.Document
    Set pLayer = pMxDocument.SelectedLayer
    If pLayer Is Nothing Then
        MsgBox "Seleziona un Feature Layer"
        Exit Sub
    End If
    If TypeOf pLayer Is IGeoFeatureLayer Then
        'FeatureLayer
        Dim pFeatureSelection As IFeatureSelection
        Set pFeatureSelection = pLayer
        Dim pCursor As ICursor
        Set m_pQueryFilter = New QueryFilter
        If m_pQueryFilter Is Nothing Then
            Set m_pQueryFilter = Nothing
        Else
            m_pQueryFilter.WhereClause = ""
        End If
        Call pFeatureSelection.SelectionSet.Search(m_pQueryFilter, False,
pCursor)
        Dim pFeature As IFeature
        Set pFeature = pCursor.NextRow
        If pFeature Is Nothing Then
            MsgBox "Seleziona una Feature"
            Exit Sub
        End If
        Dim lngPosCampo As Long
        lngPosCampo = pCursor.FindField(NomeCampo)
        If lngPosCampo < 0 Then
            If AddCampo(pFeatureSelection) = False Then
                MsgBox "Errore"
                Exit Sub
            End If
        End If
        Dim bSoprascrivi As Boolean
        bSoprascrivi = True
        Dim i As Integer
        While (Not pFeature Is Nothing)
            Dim pTable As ITable
            Dim pRow As IRow
            Set pTable = pFeatureSelection
            Set pRow = pTable.GetRow(pFeature.OID)
            If pRow.Value(pTable.FindField(NomeCampo)) <> "" Then
                If bSoprascrivi = True Then
                    If MsgBox("Il campo NomeCampo contiene già un codice
precedentemente inserito!" & vbCrLf _
                                & "Lo vuoi sovrascrivere con ?", vbQuestion
+ vbYesNo) = vbNo Then
                        Exit Sub
                    Else
                        bSoprascrivi = False
                    End If
                End If
            End If
            pRow.Value(pTable.FindField(NomeCampo)) = Tua Operazione
            pRow.Store
            Set pFeature = pCursor.NextRow
            DoEvents
        Wend
    End If
    If Err.Number = 0 Then MsgBox "Finito", vbInformation
End Sub
Private Function AddCampo(pFLayer As IFeatureLayer) As Boolean
On Error GoTo Errore
Dim pTable As ITable
Dim pFieldEdit As IFieldEdit
        Set pFieldEdit = New Field
        pFieldEdit.Name = NomeCampo
        pFieldEdit.Type = esriFieldTypeString
        pFieldEdit.Length = 16
        Set pTable = pFLayer
        pTable.AddField pFieldEdit
AddCampo = True
Exit Function
Errore:
AddCampo = False
End Function

 Faccio un esempio vedi se ti piace...
[cut]
Io sono arrivato a questo: (ma ricevo questo errore)
"The Calculated value is invalid for the row with ObjectId=0. For Example, 
the calculated value may be too large for the field or you may be trying to 
add a string to a number field. This row not be updated"
Public Sub Calcola_Sezione(Nome_Campo As String)
    Dim pmxDoc As IMxDocument
    Dim pLayer As ILayer
    Dim pFLayer As IFeatureLayer
    Dim pFeatClass As IFeatureClass
    Dim pFields As IFields
    Dim pField As IField
    Dim pFieldEdit As IFieldEdit
    Dim pMap As IMap
    Set pmxDoc = ThisDocument
    Set pMap = pmxDoc.FocusMap
    Set pLayer = pMap.Layer(0)
    Set pFLayer = pLayer
    Set pFeatClass = pFLayer.featureClass
    'Creazione del campo necessario per memorizzare il dato
    AggiuntaCampo Nome_Campo, 20, esriFieldTypeInteger
    'Calcola la Sezione in Base all'angolo del lato maggiore
    'Terza Prova
    Dim pCalc As ICalculator
    Set pCalc = New Calculator
    Dim pCursor As ICursor
    Dim preExp As String
    preExp = "Dim expVap as String" + vbCrLf + _
             "If [Bearing_°_] > 0 And [Bearing_°_] <= 30 Then preExp = 
""6""" + vbCrLf + _
             "If [Bearing_°_] > 30 And [Bearing_°_] <= 60 Then preExp = 
""5""" + vbCrLf + _
             "If [Bearing_°_] > 60 And [Bearing_°_] <= 90 Then preExp = 
""4""" + vbCrLf + _
             "If [Bearing_°_] > 90 And [Bearing_°_] <= 120 Then preExp = 
""3""" + vbCrLf + _
             "If [Bearing_°_] > 120 And [Bearing_°_] <= 150 Then preExp = 
""2""" + vbCrLf + _
             "If [Bearing_°_] > 150 And [Bearing_°_] <= 180 Then preExp = 
""1"""
    Set pCursor = pFeatClass.Update(Nothing, False)
    With pCalc
        Set .Cursor = pCursor
        .PreExpression = preExp
        .Expression = "expVal"
        .Field = Nome_Campo
        .ShowErrorPrompt = True
    End With
    pCalc.Calculate
    Set pCursor = Nothing
    Set pCalc = Nothing
    'Seconda Tipo di Prova
    'Dim pRow As IRow
    'Dim pTheValue As IRow
    'Dim First As Long
    'Dim Second As Long
    'Set pFields = pFeatClass.Fields
    'Set First = pFields.Field(pFields.FindField("Bearing_°_"))
    'Set Second = pFields.Field(pFields.FindField(Nome_Campo))
    'pTheValue = pRow.Value(3)
    'If (pTheValue > 0 And pTheValue <= 30) Then 'For Example
     '   pRow.Value(4) = pTheValue
      '  pRow.Store
    'Else
       ' MsgBox "Angle Error", vbInformation, "Answer"
   ' End If
   'Prima Tipo di Prova
    'Dim pCalc As ICalculator
    'Set pCalc = New Calculator
    'Dim pCursor As ICursor
    'Set pCursor = pFeatClass.Update(Nothing, True)
    'With pCalc
    'Set .Cursor = pCursor
        '.Expression = ["
        'If [Bearing_°_] > 0 And [Bearing_°_] <= 30 Then "1"
        'End If
        'If [Bearing_°_] >= 30 And [Bearing_°_] <= 60 Then "1"
        'End If
        '.Field = "Sezione_O"
        '.ShowErrorPrompt = True
   ' End With
   ' pCalc.Calculate
   ' Set pCursor = Nothing
    'Set pCalc = Nothing
    ' Delete the old filed
    'Set pFields = pFeatClass.Fields
    'Set pField = pFields.Field(pFields.FindField("Bearing_°_"))
    'pFeatClass.DeleteField pField
End Sub
Public Sub AggiuntaCampo(Nome_Campo As String, Lunghezza As Integer, 
Tipo_Dato As String)
     'Quando chiamiamo { AggiuntaCampo "Sezione_O", Lunghezza,Tipo_Dato } 
dobbiamo inserire:
     'nel primo spazio il nome che vogliamo dare al campo compreso tra 
virgolette;
     'nel secondo un numero che ne indica la lunghezza;
     'nel terzo il tipo di campo voluto. Possibili scelte: 
esriFieldTypeInteger, esriFieldTypeSingle, esriFieldTypeDouble, 
esriFieldTypeString
    Dim pmxDoc As IMxDocument
    Dim pLayer As ILayer
    Dim pFLayer As IFeatureLayer
    Dim pFeatClass As IFeatureClass
    Dim pField As IField
    Dim pFieldEdit As IFieldEdit
    Dim pMap As IMap
    Dim esist As Long
    Set pmxDoc = ThisDocument
    Set pMap = pmxDoc.FocusMap
    Set pLayer = pMap.Layer(0)
    Set pFLayer = pLayer
    Set pFeatClass = pFLayer.featureClass
    'Controllo dell'esistenza o meno del campo
    esist = pFeatClass.FindField(Nome_Campo)
    If (esist = -1) Then 'Il campo non esiste e va quindi creato
    'Creazione del campo vero e proprio
    Set pField = New Field
    Set pFieldEdit = pField
    With pFieldEdit
        .Length = Lunghezza
        .Name = Nome_Campo
        .Type = Tipo_Dato
    End With
    pFeatClass.AddField pField
    Else
    MsgBox "Il Campo esiste già, non serve aggiungerlo", vbInformation, 
"Aggiunta Campo"
    End If
End Sub