'*********************************************************************
'                   class_arcmap_Graphic
'*********************************************************************
Private Type My_ArcObjects
    IMxApplication              As IMxApplication
    IPrinter                    As IPrinter
    IPaper                      As IPaper
    IPageLayout                 As IPageLayout
    IEmfPrinter                 As IEmfPrinter
    IExport                     As IExport
    IScreenDisplay              As IScreenDisplay
    ISimpleRenderer             As ISimpleRenderer
    ISimpleFillSymbol           As ISimpleFillSymbol
    IDraw                       As IDraw
    IClone                      As IClone
    ImouseCursor                As ImouseCursor
    ICartographicLineSymbol     As ICartographicLineSymbol
    IPolyline                   As IPolyline
    IArrowMarkerSymbol          As IArrowMarkerSymbol
    IRing                       As IRing
    ISpatialFilter              As ISpatialFilter
    IEnumGeometry               As IEnumGeometry
    IEnumGeometryBind           As IEnumGeometryBind
    
    IMxDocument                 As IMxDocument
    IActiveView                 As IActiveView
    Imap                        As Imap
    IMaps                       As IMaps
    iGeoFeatureLayer            As iGeoFeatureLayer
    ILayer                      As ILayer
    IDisplayTransformation      As IDisplayTransformation
    ITextsymbol                 As ITextsymbol
    IFontDisp                   As IFontDisp

    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
    IEnvelope                   As IEnvelope
    IFeatureClass               As IFeatureClass
    IEnumVertex                 As IEnumVertex
    IFillSymbol                 As IFillSymbol

    ICommandItem                As ICommandItem
    ICommandBar                 As ICommandBar
    ICommandBars                As ICommandBars

    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

'--------------- Indexes ------------
    RowCount                    As Long         ' Row Count
    PartCount                   As Long         ' Part Count
    PointCount                  As Long         ' Point Count
    
    Shape                       As Long         ' Graphic Table Index
    Row                         As Long         ' Current Row
    Part                        As Long         ' Current Polygon / Polyline PART
    Point                       As Long         ' Current Polygon / Polyline Point Index

    FeatureType                 As String

End Type

Dim P As My_ArcObjects
'=======================================================
'                Class_Initilize
'=======================================================
Private Sub Class_Initialize()

    Set P.IMxDocument = ThisDocument
    Set P.IMxApplication = Application
    Set P.IMaps = P.IMxDocument.Maps
    
    P.RowCount = 0
    P.PartCount = 0
    P.PointCount = 0
    
    P.Shape = 0
    P.Row = 0
    P.Part = 0
    P.Point = 0
    
    P.FeatureType = ""

End Sub
'=======================================================
'                FindLayer
'=======================================================
Public Function FindLayer(name) As Boolean
    Dim i, j

    FindLayer = True
    P.FeatureType = ""

    Set P.IMaps = P.IMxDocument.Maps
    
    For i = 1 To P.IMaps.Count
        Set P.Imap = P.IMaps.Item(i - 1)
        
        For j = 1 To P.Imap.LayerCount
            Set P.iFeatureLayer = P.Imap.Layer(j - 1)
            Set P.IFeatureClass = P.iFeatureLayer.FeatureClass
            
            If (UCase(P.iFeatureLayer.name) = UCase(name)) Then
                If ((P.IFeatureClass.ShapeType = esriGeometryPoint)) Then P.FeatureType = "point"
                If ((P.IFeatureClass.ShapeType = esriGeometryPolyline)) Then P.FeatureType = "polyline"
                If ((P.IFeatureClass.ShapeType = esriGeometryPolygon)) Then P.FeatureType = "polygon"
                
                If (P.FeatureType <> "") Then
                
                    Set P.IFeatureCursor = Nothing
                    Set P.ICursor = Nothing
                
                    Set P.IFields = P.IFeatureClass.Fields
                    P.Shape = FindShapeField(P.IFields)
                    Set P.ITable = P.IFeatureClass
            
                    
                    P.RowCount = P.ITable.RowCount(Nothing)
                    P.PartCount = 0
                    P.Row = 0
                    P.Part = 0
                    P.Point = 0
                   
                    Exit Function
                End If
            End If

        Next j
    Next i
    
    FindLayer = False
End Function
'=======================================================================
'                      FindShapeField
'=======================================================================
Private Function FindShapeField(Fields As IFields) As Long

Dim i

For i = 0 To Fields.FieldCount - 1
   FindShapeField = i + 1
   Set P.IField = Fields.Field(i)
   If P.IField.Type = esriFieldTypeGeometry Then Exit Function
Next

FindShapeField = -1

End Function

'=======================================================
'                Read
'=======================================================
Public Function Read() As Boolean
    Read = False
    
    Select Case P.FeatureType
    Case "point"
            Read = ReadPoint()
    Case "polygon"
            Read = ReadPolygon()
    Case "polyline"
            Read = ReadPolyline()
    End Select

End Function
'=======================================================
'                Update
'=======================================================
Public Function Update() As Boolean
    Update = False
    
    Select Case P.FeatureType
    Case "point"
            Update = UpdatePoint()
    Case "polygon"
'            Update = UpdatePolygon()
    Case "polyline"
'            Update = UpdatePolyline()
    End Select

End Function
'=======================================================
'                SelectByCriteria
'=======================================================
Sub SelectByCriteria(Criteria)

    Set P.IQueryFilter = New QueryFilter
    P.IQueryFilter.WhereClause = Criteria
    
    Set P.IFeatureSelection = P.iFeatureLayer
    P.IFeatureSelection.SelectFeatures P.IQueryFilter, esriSelectionResultNew, False
    
    Set P.ISelectionSet = P.IFeatureSelection.SelectionSet
    P.ISelectionSet.Search Nothing, False, P.IFeatureCursor
    
    P.RowCount = P.ISelectionSet.Count
    P.PartCount = 0
    P.Row = 0
    P.Part = 0
    P.Point = 0
 
End Sub
'=======================================================
'                SelectAll
'=======================================================
Sub SelectAll()
    
   P.IFeatureCursor = Nothing

    P.RowCount = P.ITable.RowCount(Nothing)
    P.PartCount = 0
    P.Row = 0
    P.Part = 0
    P.Point = 0
 
End Sub
'=======================================================
'                SelectSelected
'=======================================================
Sub SelectSelected()

    Set P.IFeatureSelection = P.iFeatureLayer
    Set P.ISelectionSet = P.IFeatureSelection.SelectionSet
    P.ISelectionSet.Search Nothing, False, P.IFeatureCursor
    
    P.RowCount = P.ISelectionSet.Count
    P.Row = 0
    P.Part = 0
    P.Point = 0
 
End Sub
'=======================================================
'               selectByRange
'=======================================================
Sub SelectByRange(x1, y1, x2, y2)

    Set P.IEnvelope = New Envelope
    P.IEnvelope.xmin = x1
    P.IEnvelope.ymin = y1
    P.IEnvelope.XMax = x2
    P.IEnvelope.YMax = y2

    Set P.ISpatialFilter = New SpatialFilter
    Set P.ISpatialFilter.Geometry = P.IEnvelope
    P.ISpatialFilter.SpatialRel = esriSpatialRelCrosses
    
    Set P.IFeatureSelection = P.iFeatureLayer
    
 '   p.IFeatureSelection.Clear
 
    Call P.IFeatureSelection.SelectFeatures(P.ISpatialFilter, esriSelectionResultNew, False)
    
    Set P.ISelectionSet = P.IFeatureSelection.SelectionSet
    P.ISelectionSet.Search Nothing, False, P.IFeatureCursor
    
    P.RowCount = P.ISelectionSet.Count
    P.PartCount = 0
    P.Row = 0
    P.Part = 0
    P.Point = 0

End Sub

'=======================================================
'                FindNearPoint
'=======================================================
Function FindNearPoint(IPoint As IPoint) As Boolean

    Set P.ISpatialFilter = New SpatialFilter
    Set P.ISpatialFilter.Geometry = IPoint
    P.ISpatialFilter.GeometryField = "SHAPE"
    P.ISpatialFilter.SpatialRel = esriSpatialRelIntersects

    Set P.IFeatureCursor = P.IFeatureClass.Search(P.ISpatialFilter, True)
 
End Function
'=======================================================
'                FindInPolygon
'=======================================================
Function FindNearPolygon(IPolygon As IPolygon) As Boolean

    Set P.ISpatialFilter = New SpatialFilter
    Set P.ISpatialFilter.Geometry = IPolygon
    P.ISpatialFilter.GeometryField = "SHAPE"
    P.ISpatialFilter.SpatialRel = esriSpatialRelIntersects

    Set P.IFeatureCursor = P.IFeatureClass.Search(P.ISpatialFilter, True)
    
End Function
'=======================================================
'                UpdatePolyline
'=======================================================
Public Function UpdatePolyline() As Boolean

 '   Set p.IGeometryCollection.Geometry(p.Part - 1) = p.IGeometry
    Set P.IGeometry = P.IGeometryCollection


End Function
'=======================================================
'                ReadPoint
'=======================================================
Public Function ReadPoint() As Boolean
    
    ReadPoint = False
    If ((P.Row + 1) > P.RowCount) Then Exit Function
    
    P.Row = P.Row + 1
    Set P.iRow = P.ITable.GetRow(P.Row - 1)
    Set P.IGeometry = P.iRow.Value(P.Shape - 1)
    Set P.IPoint = P.IGeometry
    ReadPoint = False

End Function
'=======================================================
'                   UpdatePoint
'=======================================================
Public Function UpdatePoint() As Boolean
    
    UpdatePoint = False
    If ((P.Row + 1) > P.RowCount) Then Exit Function
    
    P.ITable.GetRow (P.Row - 1)
    Set P.IGeometry = P.iRow.Value(P.Shape - 1)
    Set P.IPoint = P.IGeometry
    UpdatePoint = False

End Function

'=======================================================
'                ReadPolyline
'=======================================================
Public Function ReadPolyline() As Boolean
    
    ReadPolyline = False
    
    If (P.Part < P.PartCount) Then GoTo NextPart
        
NextRow:
    If ((P.Row + 1) > P.RowCount) Then Exit Function

    P.Row = P.Row + 1
    
    If (P.IFeatureCursor Is Nothing) Then
        Set P.iRow = P.ITable.GetRow(P.Row - 1)
    Else
        Set P.iRow = P.IFeatureCursor.NextFeature
    End If

    Set P.IGeometry = P.iRow.Value(P.Shape - 1)
    
    If (P.IGeometry Is Nothing) Then GoTo NextRow
    If (P.IGeometry.IsEmpty) Then GoTo NextRow
    
    Set P.IGeometryCollection = P.IGeometry

    P.PartCount = P.IGeometryCollection.GeometryCount
    P.Part = 0
    P.Point = 0
    
NextPart:
    If ((P.Part + 1) > P.PartCount) Then GoTo NextRow
    P.Part = P.Part + 1
    Set P.ICurve = P.IGeometryCollection.Geometry(P.Part - 1)
    
    If (P.ICurve Is Nothing) Then GoTo NextPart
    If (P.ICurve.IsEmpty) Then GoTo NextPart
    
    Set P.IPointCollection = P.ICurve
    Set P.IEnumVertex = P.IPointCollection.EnumVertices
    P.IEnumVertex.Reset
    P.PointCount = P.IPointCollection.PointCount
    P.Point = 0

    ReadPolyline = False
End Function

'=======================================================
'                ReadPolygon
'=======================================================
Public Function ReadPolygon() As Boolean
    
    ReadPolygon = False
    
    If (P.Part < P.PartCount) Then GoTo NextPart
        
NextRow:
    If ((P.Row + 1) > P.RowCount) Then Exit Function

    P.Row = P.Row + 1
    Set P.iRow = P.ITable.GetRow(P.Row - 1)
    Set P.IGeometry = P.iRow.Value(P.Shape)
    
    If (P.IGeometry Is Nothing) Then GoTo NextRow
    If (P.IGeometry.IsEmpty) Then GoTo NextRow
    
    Set P.IGeometryCollection = P.IGeometry
        
   Set P.IEnumVertex = P.IPointCollection.EnumVertices
   P.PartCount = P.IPointCollection.PointCount
   
    P.Part = 0
    P.Point = 0
    
NextPart:
    If ((P.Part + 1) > P.PartCount) Then GoTo NextRow
    P.Part = P.Part + 1
    
    Set P.IGeometry = P.IGeometryCollection.Geometry(P.Part - 1)

    If (P.IGeometry Is Nothing) Then GoTo NextPart
    If (P.IGeometry.IsEmpty) Then GoTo NextPart

    If (P.IGeometry.GeometryType = esriGeometryPolygon) Then
        Set P.IPolygon = P.IGeometry
        Set P.IPointCollection = P.IPolygon
    End If

    If (P.IGeometry.GeometryType = esriGeometryRing) Then
        Set P.IRing = P.IGeometry
        Set P.IPointCollection = P.IRing
    End If
        
    Set P.IEnumVertex = P.IPointCollection.EnumVertices
    P.IEnumVertex.Reset
    P.PointCount = P.IPointCollection.PointCount
    P.Point = 0

    ReadPolygon = False
End Function

'===================================================================================
'                       Point
'===================================================================================
Public Property Get Point(n As Variant) As IPoint
    Set Point = P.IPointCollection.Point(n - 1)
End Property

Public Property Let Point(n As Variant, Point As IPoint)
    P.IPointCollection.UpdatePoint n - 1, Point
End Property

'===================================================================================
'                       Row
'===================================================================================
Public Property Get Row() As Long
    Row = P.Row
End Property

Public Property Let Row(ByVal iRow As Long)
    P.Row = iRow - 1
    If (P.Row < 0) Then P.Row = 0
    If (P.Row > P.RowCount) Then P.Row = P.RowCount + 1

    P.Part = 0
    P.Point = 0
    Me.Read

End Property

'===================================================================================
'                       RowCount
'===================================================================================
Public Property Get RowCount() As Variant
    RowCount = P.RowCount
End Property

'===================================================================================
'                       PointCount
'===================================================================================
Public Property Get PointCount() As Variant
    PointCount = P.PointCount
End Property