Sunday, February 22, 2009

fix annotation

Sub FixAnno()

On Error GoTo ErrorHandler
Open "C:\FixAnnoLog.txt" For Output As #1
Dim iCount As Integer ' progessbar
Dim iTotal As Integer
iCount = 0
iTotal = 0
Dim i As Integer
Dim myStatusBar As IStatusBar
Set myStatusBar = Application.StatusBar

Dim pMxdoc As IMxDocument
Set pMxdoc = ThisDocument
Dim pLayerTarget As IFeatureLayer
Dim pLayerSrc As IFeatureLayer
Dim pMap As IMap
Dim myQuery As IQueryFilter
Set myQuery = New QueryFilter
Dim pFtCursorSrc As IFeatureCursor
Dim pFeatureSrc As IFeature
Dim pFeatureTarget As IFeature
Dim pEditor As IEditor
Dim pid As New UID
pid = "esriEditor.Editor"
Set pEditor = Application.FindExtensionByCLSID(pid)
Dim lEID As Long
Dim pFtCursorTarget As IFeatureCursor
Dim pAnnoSrc As IAnnotationFeature
Dim pAnnoTarget As IAnnotationFeature
Dim pAnnoElement As IElement

Dim strFieldName As String
Dim pDataSrcName As IWorkspaceName
Dim j As Integer
Dim pDataSet As IDataset
For j = 0 To pMxdoc.Maps.Count - 1
'MsgBox pMxdoc.Maps.Item(j).Name
Set pMap = pMxdoc.Maps.Item(j)

Set pLayerTarget = pMap.Layer(1) ' assuming the second layer is to be edit
Set pDataSet = pLayerTarget.FeatureClass.FeatureDataset.Workspace

Set pDataSrcName = pDataSet.FullName
'Debug.Print pDataSrcName.ConnectionProperties.GetProperty("Version")
If InStr(pDataSrcName.ConnectionProperties.GetProperty("Version"), "FixDevAnno") Then 'make sure we are on a version
Set pLayerSrc = pMap.Layer(0)


myQuery.WhereClause = "1=1" 'Get all feature from source


Set pFtCursorSrc = pLayerSrc.Search(myQuery, False)

Set pFeatureSrc = pFtCursorSrc.NextFeature

'start edit session

pEditor.StartEditing pLayerTarget.FeatureClass.FeatureDataset.Workspace
pEditor.StartOperation

strFieldName = ""
For i = 0 To pLayerSrc.FeatureClass.Fields.FieldCount - 1
If InStr(pLayerSrc.FeatureClass.Fields.Field(i).Name, "EID") And UCase(pLayerSrc.FeatureClass.Fields.Field(i).Name) <> "FEATUREID" Then
strFieldName = pLayerSrc.FeatureClass.Fields.Field(i).Name
Exit For
End If
Next
If strFieldName = "" Then
MsgBox "did not find the EID field, check data"
Exit Sub
End If
Print #1, "processing" & pMap.Name
Do While Not pFeatureSrc Is Nothing

'get the EID, which is the only thing we can relate this two feature class
If Not IsNull(pFeatureSrc.Value(pFeatureSrc.Fields.FindField(strFieldName))) Then
lEID = pFeatureSrc.Value(pFeatureSrc.Fields.FindField(strFieldName))
'Debug.Print pFeature.Value(pFeature.Fields.FindField("OBJECTID"))

myQuery.WhereClause = strFieldName & " = " & lEID

Set pFtCursorTarget = pLayerTarget.FeatureClass.Update(myQuery, False)
Set pFeatureTarget = pFtCursorTarget.NextFeature
If Not pFeatureTarget Is Nothing Then
Set pAnnoSrc = pFeatureSrc
Set pAnnoElement = pAnnoSrc.Annotation
If Not pAnnoElement Is Nothing And Not IsNull(pAnnoElement) Then
If Not pFeatureTarget Is Nothing Then
Set pAnnoTarget = pFeatureTarget
pAnnoTarget.Annotation = pAnnoElement
pFeatureTarget.Store
Print #1, lEID & " , has been fixed"
End If
Else
'Debug.Print lEID & " has empty or null element"
Print #1, lEID & " , has empty or null element"
End If
Else
'Debug.Print lEID & " did not find corresponding annotation"
Print #1, lEID & ", did not find corresponding annotation"
End If
Else
'Debug.Print pFeatureSrc.Fields.FindField("ObjectID")
Print #1, pFeatureSrc.Fields.FindField("ObjectID") & ", EID is null"
End If
Set pFeatureSrc = pFtCursorSrc.NextFeature
iCount = iCount + 1
myStatusBar.Message(0) = "Processed " & iCount
Loop


pEditor.StopOperation "Finished"

pEditor.StopEditing True
End If
Next
Close #1
Exit Sub

ErrorHandler:
MsgBox "Error raised: " & Err.Description & lEID & " has issue" & Err.Source

End Sub

No comments: