Private Type My_ArcObjects
   IMxDocument                  As IMxDocument
   IActiveView                  As IActiveView
   Imap                         As Imap
   IMaps                        As IMaps
   IGeoFeatureLayer             As IGeoFeatureLayer
   ILayer                       As ILayer
   IDisplayTransformation       As IDisplayTransformation
   

   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

   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

End Type

Private Type this
    A               As My_ArcObjects
    Message         As String
End Type

Dim g As New Class_Global
Private this As this

'=======================================================
'            Class Initialize
'=======================================================
Private Sub Class_Initialize()
    Set this.A.IMxDocument = ThisDocument
    Set this.A.IMaps = this.A.IMxDocument.Maps
End Sub
'=======================================================
'            Messsage (Let)
'=======================================================
Public Property Let Message(text As String)
    this.Message = text
End Property

'=======================================================
'            Message (Get)
'=======================================================
Public Property Get Message() As String
    Message = this.Message
End Property
'=======================================================
'           TurnOnAllLayers
'=======================================================
Public Sub TurnOnAllLayers()
    Dim i
    Dim j
     
    For i = 1 To this.A.IMaps.Count
        Set this.A.Imap = this.A.IMaps.Item(i - 1)
        For j = 1 To this.A.Imap.LayerCount
            Set this.A.ILayer = this.A.Imap.Layer(j - 1)
            this.A.ILayer.Visible = True
        Next j
    Next i

    this.A.IMxDocument.UpdateContents
    this.A.IMxDocument.ActiveView.Refresh
End Sub
'=======================================================
'           TurnOffAllLayers
'=======================================================
Public Sub TurnOffAllLayers()
    Dim i
    Dim j
        
    For i = 1 To this.A.IMaps.Count
        Set this.A.Imap = this.A.IMaps.Item(i - 1)
        For j = 1 To this.A.Imap.LayerCount
            Set this.A.ILayer = this.A.Imap.Layer(j - 1)
            this.A.ILayer.Visible = False
        Next j
    Next i

    this.A.IMxDocument.UpdateContents
    this.A.IMxDocument.ActiveView.Refresh
End Sub

'=======================================================
'               ZoomIn
'=======================================================
Public Sub ZoomIn()
    Dim Center As IPoint
    
    Set this.A.IMxDocument = Application.Document
    Set this.A.IActiveView = this.A.IMxDocument.FocusMap
    
    Set this.A.IDisplayTransformation = this.A.IActiveView.ScreenDisplay.DisplayTransformation
    Set this.A.IEnvelope = this.A.IActiveView.Extent

    Set Center = New Point
    Center.x = (this.A.IEnvelope.XMax + this.A.IEnvelope.XMin) / 2
    Center.y = (this.A.IEnvelope.YMax + this.A.IEnvelope.YMin) / 2
    this.A.IEnvelope.Width = this.A.IEnvelope.Width / 2
    this.A.IEnvelope.Height = this.A.IEnvelope.Height / 2
    this.A.IEnvelope.CenterAt Center
    
    this.A.IDisplayTransformation.VisibleBounds = this.A.IEnvelope
    this.A.IActiveView.Refresh
     
End Sub
'=======================================================
'               ZoomOut
'=======================================================
Public Sub ZoomOut()
    Dim Center As IPoint
    
    Set this.A.IActiveView = this.A.IMxDocument.FocusMap
    
    Set this.A.IDisplayTransformation = this.A.IActiveView.ScreenDisplay.DisplayTransformation
    Set this.A.IEnvelope = this.A.IActiveView.Extent

    Set Center = New Point
    Center.x = (this.A.IEnvelope.XMax + this.A.IEnvelope.XMin) / 2
    Center.y = (this.A.IEnvelope.YMax + this.A.IEnvelope.YMin) / 2
    this.A.IEnvelope.Width = this.A.IEnvelope.Width / 0.2
    this.A.IEnvelope.Height = this.A.IEnvelope.Height / 0.2
    this.A.IEnvelope.CenterAt Center
    
    MsgBox "x value:" & Center.x & "  Y: " & Center.y
    
    this.A.IDisplayTransformation.VisibleBounds = this.A.IEnvelope
    this.A.IActiveView.Refresh
     
End Sub
'=======================================================
'          CenterTo
'=======================================================
Public Sub CenterTo(x, y)
    Dim Center As IPoint
    
    Set this.A.IActiveView = this.A.IMxDocument.FocusMap
    
    Set this.A.IDisplayTransformation = this.A.IActiveView.ScreenDisplay.DisplayTransformation
    Set this.A.IEnvelope = this.A.IActiveView.Extent

    Set Center = New Point
    Center.x = x
    Center.y = y

    this.A.IEnvelope.CenterAt Center
    
    this.A.IDisplayTransformation.VisibleBounds = this.A.IEnvelope
    this.A.IActiveView.Refresh
     
End Sub
'=======================================================
'            ShowCenter
'=======================================================
Public Sub ShowCenter(x, y)
    Dim Center As IPoint
    
    Set this.A.IActiveView = this.A.IMxDocument.FocusMap
    Set this.A.IDisplayTransformation = this.A.IActiveView.ScreenDisplay.DisplayTransformation
    Set this.A.IEnvelope = this.A.IActiveView.Extent

    Set Center = New Point
    Center.x = (this.A.IEnvelope.XMax + this.A.IEnvelope.XMin) / 2
    Center.y = (this.A.IEnvelope.YMax + this.A.IEnvelope.YMin) / 2
    
    MsgBox "X value: " & Center.x & " " & vbCrLf & _
           "Y value: " & Center.y & " " & vbCrLf & _
           "Height: " & this.A.IEnvelope.Height & vbCrLf & _
           "Width: " & this.A.IEnvelope.Width
            
     
End Sub
 
'=======================================================
'                FindLayer
'=======================================================
Public Function FindLayer(name)
    Dim i, j
    
    FindLayer = True
   
    For i = 0 To this.A.IMaps.Count - 1
        Set this.A.Imap = this.A.IMaps.Item(i)
    
        For j = 0 To this.A.Imap.LayerCount - 1
            If TypeOf this.A.Imap.Layer(j) Is IFeatureLayer Then
                Set this.A.IFeatureLayer = this.A.Imap.Layer(j)
                If (LCase(this.A.IFeatureLayer.name) = LCase(name)) Then Exit Function
            End If
        Next j
    Next i
  
    FindLayer = False
End Function
'=======================================================
'                Turn Off Layer
'=======================================================
Public Function TurnOffLayer(name)
    If (Not FindLayer(name)) Then Exit Function
    
    Set this.A.ILayer = this.A.IFeatureLayer
    this.A.ILayer.Visible = False
    this.A.IMxDocument.UpdateContents
    this.A.IMxDocument.ActiveView.Refresh
End Function
'=======================================================
'                Turn On Layer
'=======================================================
Public Function TurnOnLayer(name)
    If (Not FindLayer(name)) Then Exit Function
    
    Set this.A.ILayer = this.A.IFeatureLayer
    this.A.ILayer.Visible = True
    this.A.IMxDocument.UpdateContents
    this.A.IMxDocument.ActiveView.Refresh
End Function
'=======================================================
'               Add Shapefile
'=======================================================
Public Function AddShapeFile(filename)

    Set this.A.IWorkspaceFactory = New ShapefileWorkspaceFactory
    Set this.A.IFeatureWorkspace = this.A.IWorkspaceFactory.OpenFromFile(g.ExtractFilepath(filename), 0)
    Set this.A.IFeatureClass = this.A.IFeatureWorkspace.OpenFeatureClass(g.ExtractFileNam(filename))

    Set this.A.IFeatureLayer = New FeatureLayer
    Set this.A.IFeatureLayer.FeatureClass = this.A.IFeatureClass

    this.A.IFeatureLayer.name = this.A.IFeatureClass.AliasName
    this.A.IMxDocument.AddLayer this.A.IFeatureLayer
    this.A.IMxDocument.ActiveView.PartialRefresh esriViewGeography, this.A.IFeatureLayer, Nothing

End Function