GIS Translator using ArcObjects

VBA and ArcObjects

This example is executed from within ArcMap as a Macro. The code will translate all "Point", "Polyline", and "Polygon" Featureclasses to over 20 formats which the user selects from a list of output formats.

The following code defines the translation process, and performs the translation by a call to "ExecuteDialog"

Public Type GlobalInfo
   Layer                 As String
   Feature               As String
   Mav                   As MaverickPro
   Shape                 As Long

   RowCount              As Long
   ActiveLayer           As Long
   ActiveFeature         As Long

   Table                 As New MaverickPro_Table
End Type

Private Type ArcObjects
   IMxDocument           As IMxDocument
   Imap                  As Imap
   IMaps                 As IMaps
   IGeoFeatureLayer      As IGeoFeatureLayer

   IField                As IField
   IFields               As IFields
   IFieldsEdit           As IFieldsEdit
   IFieldEdit            As IFieldEdit
   ICursor               As ICursor
   IRow                  As IRow
   ITable                As ITable
   ISelectionSet         As ISelectionSet
   IQueryFilter          As IQueryFilter
   IFeatureSelection     As IFeatureSelection
   IFeatureLayer         As IFeatureLayer
   IFeatureCursor        As IFeatureCursor
   IFeature              As IFeature
   IDataSet              As IDataSet
   IFeatureClass         As IFeatureClass
   IEnumVertex           As IEnumVertex

   IWorkspaceFactory     As IWorkspaceFactory
   IPropertySet          As IPropertySet
   IWorkspace            As IWorkspace
   IFeatureWorkspace     As IFeatureWorkspace
   IPoint                As IPoint
   IPointCollection      As IPointCollection
   ICurve                As ICurve
   IPolygon              As IPolygon
   ILine                 As ILine
   IGeometry             As IGeometry
   IGeometryCollection   As IGeometryCollection
   IGeometryDefEdit      As IGeometryDefEdit
   IGeometryDef          As IGeometryDef
   ISpatialReference     As ISpatialReference
   IWorkspaceEdit        As IWorkspaceEdit
   SpatialReferenceEnvironment As SpatialReferenceEnvironment

   IProjectedCoordinateSystem As IProjectedCoordinateSystem
   IAnnotateLayerPropertiesCollection As IAnnotateLayerPropertiesCollection

End Type

Public P As ArcObjects ' Arc Objects
Public G As GlobalInfo ' Global Info

'==============================================================
'                         Translate
'==============================================================
Public Sub Translate()

Set G.Mav = New MaverickPro

'***************************************************
'* MAKE SURE TO Attach MaverickPro COM Object      *
'* Tools | References... | CollinsSoftware Library *
'***************************************************

'---------- ArcMap Source CLD Definition ----------

G.Mav.ControlText = "Database /Log=(Input,Output,Stats);" & vbCrLf & _
                    "Source_Database_COM;" & cvCRLF & _
                    "Target_database_ACAD;" & vbCRLF & _
                    "Translate /$ID=Pass1" & vbCrLf & _
                    "Target_Database_Acad" & vbCRLF & _
                    "Source_Translate_COM" & _
                    "/Layers=(*)" & _
                    "/FeatureClasses=(*)" & _
                    "/Elements=(Points,Polylines,Polygons);"

'------ Initialize Callback Routines (Not Used in this Example) -----

Call Feedback.Init
Call Source.Init

'-------- Initialize Translation ---------

G.Mav.SetTrace False, False, False

'---------- Target Database Acad ------------

G.Mav.TargetDatabase "C:\Temp", "Sample"

'---- Add Source file(s) to Translate ---

G.Mav.AddSource "<COM>", "" ' Add a null file

'----------- Translate using MaverickPro Dialog ------------------

G.Mav.ExecuteDialog
End Sub

The following code contain Source Translator Callback Events which perform the translation all the ArcMap Featureclasses.

Option Explicit
'=========================================================
'                    Source
' Date: May 2003               Author: Clif Collins
'---------------------------------------------------------
' Sample VBA Source Database internal translator
'=========================================================
Type CLD_GROUP_STRUCTURE
First As Long

E_Point As Boolean ' Elements To Translate
E_Polyline As Boolean
E_Polygon As Boolean

Layer   As MaverickPro_Select ' Layers to Translate
Feature As MaverickPro_Select ' Features to Translate
End Type

Public GROUP As CLD_GROUP_STRUCTURE

'==========================================================
'                       MavPoint
'==========================================================
Function MavPoint(Pnt As IPoint) As MaverickPro_Point

MavPoint.X = Pnt.X
MavPoint.Y = Pnt.Y
MavPoint.Z = Pnt.Z
MavPoint.M = Pnt.M

End Function

'==========================================================
'                      MavFieldDef
'==========================================================
Function MavFieldDef(Fld As IField) As String
Dim Fmt

Fmt = "A" & Fld.Length

If (Fld.Type = esriFieldTypeDate) Then Fmt = "D"
If (Fld.Type = esriFieldTypeDouble) Then Fmt = "R8:F15." & Fld.Precision
If (Fld.Type = esriFieldTypeInteger) Then Fmt = "I4"
If (Fld.Type = esriFieldTypeOID) Then Fmt = "A24"
If (Fld.Type = esriFieldTypeSingle) Then Fmt = "R8:F15." & Fld.Precision
If (Fld.Type = esriFieldTypeSmallInteger) Then Fmt = "I2"
If (Fld.Type = esriFieldTypeString) Then Fmt = "A" & Fld.Length

MavFieldDef = Fld.Name & ":" & Fmt

End Function

'==========================================================
'                       Init (Source)
'==========================================================
Function Init() As Long
Dim n As Long

G.Mav.Source.CldText = "Define Database " & _
vbCrLf & "" & _
vbCrLf & "Define Translate" & _
vbCrLf & " Keyword Elements value(type=EType,required,list)" & _
vbCrLf & " Keyword Layers value(required,list)" & _
vbCrLf & " Keyword FeatureClasses value(Required,List)" & _
vbCrLf & "" & _
vbCrLf & "Define Type EType" & _
vbCrLf & " Keyword Points" & _
vbCrLf & " Keyword Polylines" & _
vbCrLf & " Keyword Polygons"

G.Mav.Source.SetCldRegion GROUP.First, Len(GROUP)

G.Mav.Source.Events.onCldDatabase AddressOf SCOM_CldDatabase
G.Mav.Source.Events.onCldTranslate AddressOf SCOM_CldTranslate
G.Mav.Source.Events.OnInitialize AddressOf SCOM_Initialize
G.Mav.Source.Events.onFinalize AddressOf SCOM_Finalize
G.Mav.Source.Events.onOpenDatabase AddressOf SCOM_OpenDatabase
G.Mav.Source.Events.onOpenGroup AddressOf SCOM_OpenGroup
G.Mav.Source.Events.onOpenFeature AddressOf SCOM_OpenFeature
G.Mav.Source.Events.onTranslate AddressOf SCOM_Translate
G.Mav.Source.Events.onCloseFeature AddressOf SCOM_CloseFeature
G.Mav.Source.Events.onCloseDatabase AddressOf SCOM_CloseDatabase
End Function

'==========================================================
'                    SCOM_Initialize
'==========================================================
Public Function SCOM_Initialize() As Long

SCOM_Initialize = 0

Set P.IMxDocument = ThisDocument
Set P.IMaps = P.IMxDocument.Maps

' TODO -- Main Initilization, Called Once before all others

End Function
'==========================================================
'                    SCOM_CldDatabase
'==========================================================
Public Function SCOM_CldDatabase() As Long

SCOM_CldDatabase = True

' TODO -- Determine Database Command Line Definiton
' See:
' G.Mav.Functions.Cld.Present("qualifier")
' G.Mav.Functions.Cld.GetValue("qualifier")

End Function
'==========================================================
'                      SCOM_CldTranslate
'==========================================================
Public Function SCOM_CldTranslate() As Long

SCOM_CldTranslate = True

G.Mav.Functions.Cld.GetSelect "Layers", GROUP.Layer
G.Mav.Functions.Cld.GetSelect "FeatureClasses", GROUP.Feature

GROUP.E_Point = True
GROUP.E_Polyline = True
GROUP.E_Polygon = True

If (G.Mav.Functions.Cld.Present("Elements")) Then
GROUP.E_Point = G.Mav.Functions.Cld.Present("Elements.Points")
GROUP.E_Polyline = G.Mav.Functions.Cld.Present("Elements.Polylines")
GROUP.E_Polygon = G.Mav.Functions.Cld.Present("Elements.Polygons")
End If

' TODO -- Determine Database Group Command Line Defintions
' Store all values in structure "GROUP"

End Function
'==========================================================
' SCOM_OpenDatabase
'==========================================================
Public Function SCOM_OpenDatabase(Filename As MaverickPro_String, Range As MaverickPro_Range) As Long

SCOM_OpenDatabase = True

' TODO -- Open Database given as Filename, Return Range if Possible

End Function
'==========================================================
' SCOM_OpenFeature
'==========================================================
Public Function SCOM_OpenFeature(Sequence As Long, Feature As MaverickPro_String) As Long
SCOM_OpenFeature = True

If (G.ActiveFeature >= 0) Then GoTo NextFeature

NextLayer:
   SCOM_OpenFeature = False
   G.ActiveLayer = G.ActiveLayer + 1
   If (G.ActiveLayer >= P.IMaps.Count) Then Exit Function

   Set P.Imap = P.IMaps.Item(G.ActiveLayer)
   If (Not G.Mav.Functions.Select.Text(GROUP.Layer, P.Imap.Name)) Then GoTo NextLayer

   G.ActiveFeature = -1

NextFeature:
   SCOM_OpenFeature = False
   G.ActiveFeature = G.ActiveFeature + 1
   If (G.ActiveFeature >= P.Imap.LayerCount) Then GoTo NextLayer

     Set P.IGeoFeatureLayer = P.Imap.Layer(G.ActiveFeature)
     Set P.IFeatureClass = P.IGeoFeatureLayer.FeatureClass

     If (Not G.Mav.Functions.Select.Text(GROUP.Feature, P.IGeoFeatureLayer.Name)) Then GoTo NextFeature

     If ((P.IFeatureClass.ShapeType = esriGeometryPoint) And (GROUP.E_Point)) Then GoTo Keep
     If ((P.IFeatureClass.ShapeType = esriGeometryPolyline) And (GROUP.E_Polyline)) Then GoTo Keep
     If ((P.IFeatureClass.ShapeType = esriGeometryPolygon) And (GROUP.E_Polygon)) Then GoTo Keep
     GoTo NextFeature

Keep:
   Set P.IFields = P.IFeatureClass.Fields
   G.Shape = FindGraphic(P.IFields)
   G.Mav.Functions.Str.Put P.IGeoFeatureLayer.Name, Feature
   SCOM_OpenFeature = True

End Function
'==========================================================
' SCOM_OpenGroup
'==========================================================
Public Function SCOM_OpenGroup(GroupSeq As Integer) As Long

SCOM_OpenGroup = True

G.ActiveFeature = -1 ' Reset to Scan all Layers and FeatureClasses
G.ActiveLayer = -1

' TODO -- Access / Reject Database Group

End Function
'==========================================================
' SCOM_CloseFeature
'==========================================================
Public Function SCOM_CloseFeature() As Long
SCOM_CloseFeature = True

' TODO -- Close Active Feature

End Function
'==========================================================
' SCOM_CloseDatabase
'==========================================================
Public Function SCOM_CloseDatabase() As Long
SCOM_CloseDatabase = True

' TODO -- Close Database

End Function
'==========================================================
' SCOM_Finalize
'==========================================================
Public Function SCOM_Finalize() As Long
SCOM_Finalize = True

' TODO -- All processing completed, perform final clean up

End Function
'==========================================================
' SCOM_Rewind
'==========================================================
Public Function SCOM_Rewind() As Long
SCOM_Rewind = True

' TODO -- Rewind Source Database

End Function
'==========================================================
' SCOM_GetRange
'==========================================================
Public Function SCOM_GetRange(Filename As MaverickPro_String, Range As MaverickPro_Range) As Long
SCOM_GetRange = True

' TODO -- Return Graphic Range of Filename

End Function
'==========================================================
' SCOM_Translate
'==========================================================
Public Function SCOM_Translate(Abort As Long) As Long

Dim Line As New MaverickPro_Line
Dim Poly As New MaverickPro_Polygon

Dim X As Double
Dim Y As Double
Dim Z As Double
Dim M As Double

Dim PartIndex As Long
Dim VertexIndex As Long
Dim Pnt As MaverickPro_Point
Dim Angle As Double
Dim Size As Double
Dim Height As Double
Dim I
Dim J
Dim k
Dim Text

SCOM_Translate = True

Set P.ITable = P.IFeatureClass
G.RowCount = P.ITable.RowCount(Nothing)
For I = 0 To G.RowCount - 1
If (Abort <> 0) Then Exit Function

G.Mav.Functions.Sys.SetProgress G.RowCount, I + 1

Line.Clear
Poly.Clear

Set P.IRow = P.ITable.GetRow(I)

Set P.IGeometry = P.IRow.Value(G.Shape)

'------- Point ---------

If (P.IGeometry.GeometryType = esriGeometryPoint) Then
   Set P.IPoint = P.IGeometry
   Pnt.X = P.IPoint.X
   Pnt.Y = P.IPoint.Y
   Pnt.Z = P.IPoint.Z
   Angle = 0
   Size = 0

   G.Mav.Functions.Write.Symbol Pnt, Angle, Size

' ----- Polyline ---------

ElseIf (P.IGeometry.GeometryType = esriGeometryPolyline) Then
   Set P.IGeometryCollection = P.IGeometry

   For J = 0 To P.IGeometryCollection.GeometryCount - 1
     Set P.ICurve = P.IGeometryCollection.Geometry(J)
     Set P.IPointCollection = P.ICurve
     Text = Text & vbCrLf & "Points: " & P.IPointCollection.PointCount
     Set P.IEnumVertex = P.IPointCollection.EnumVertices

     P.IEnumVertex.Reset
     Line.Clear

     For k = 1 To P.IPointCollection.PointCount
        P.IEnumVertex.Next P.IPoint, PartIndex, VertexIndex
        Line.AddPoint MavPoint(P.IPoint)
     Next 'k

     Line.Write G.Mav

   Next 'j

' ----- Polygon ---------

ElseIf (P.IGeometry.GeometryType = esriGeometryPolygon) Then
Set P.IGeometryCollection = P.IGeometry

For J = 0 To P.IGeometryCollection.GeometryCount - 1
     Set P.IGeometry = P.IGeometryCollection.Geometry(J) '

     If (Not (P.IGeometry Is Nothing)) Then
     If (Not P.IGeometry.IsEmpty) Then

'----------------- Polygon Geometry -----------------

     If (P.IGeometry.GeometryType = esriGeometryPolygon) Then
        Set P.IPolygon = P.IGeometry
        Set P.IPointCollection = P.IPolygon
        Set P.IEnumVertex = P.IPointCollection.EnumVertices
        P.IEnumVertex.Reset
        P.IEnumVertex.Next P.IPoint, PartIndex, VertexIndex
        P.IEnumVertex.Reset
        Poly.Clear

        For k = 1 To P.IPointCollection.PointCount
           P.IEnumVertex.Next P.IPoint, PartIndex, VertexIndex
           Poly.AddPoint MavPoint(P.IPoint)
        Next 'k

        Poly.Write G.Mav
     End If

'----------------- Ring Geometry ----------------

     If (P.IGeometry.GeometryType = esriGeometryRing) Then
        Set P.IRing = P.IGeometry
        Set P.IPointCollection = P.IRing
        Set P.IEnumVertex = P.IPointCollection.EnumVertices
        P.IEnumVertex.Reset
        P.IEnumVertex.Next P.IPoint, PartIndex, VertexIndex

        P.IEnumVertex.Reset
        Poly.Clear

        For k = 1 To P.IPointCollection.PointCount
            P.IEnumVertex.Next P.IPoint, PartIndex, VertexIndex
            Poly.AddPoint MavPoint(P.IPoint)
        Next 'k

        Poly.Write G.Mav
     End If

'------------------ Other ---------------------------

   End If
End If
Next 'j

End If

Next 'i

End Function
'=======================================================================
'                       DefineTable
' Make Attributes Available
'=======================================================================
Sub DefineTable(Fields As IFields)
Dim Text
Dim I
Dim F

G.Table.Clear
G.Table.Name = G.ActiveFeature
G.Table.Name = "Table"

For I = 0 To Fields.FieldCount - 1
Set P.IField = Fields.Field(I)
If P.IField.Type <> esriFieldTypeGeometry Then G.Table.Add MavFieldDef(P.IField)
Next

G.Table.Define (G.Mav)

End Sub
'=======================================================================
'                      FindGraphic
'=======================================================================
Function FindGraphic(Fields As IFields) As Long
Dim I

For I = 1 To Fields.FieldCount
   FindGraphic = I
   Set P.IField = Fields.Field(I)
   If P.IField.Type = esriFieldTypeGeometry Then Exit Function
Next

FindGraphic = -1

End Function