The following procedure takes in a few paramaters that define the "extent" of the grid and the intervals. If the destination feature class (Selected in the TOC) has a field named "Label" then the coordinates are stored in this field.
Paste procedure into VBA, create your shapefile/feature class of the desired coordinate system, add to ArcMap, start editing, select the layer in the TOC and run procedure from the immediate window passing it the desired parameters. Alternatively you could create a form where you type the coordinates and intervals into text boxes for simplicity.
Public Sub CreateGrid(UpperLeftX As Double, UpperLeftY As Double, BottomRightX As Double, BottomRightY As Double, IntervalX As Double, IntervalY As Double)
'©Jakub Sisak, 2009
Dim pUID As New UID
Dim pEditor As IEditor
Dim pEditLayers As IEditLayers
Dim pActiveView As IActiveView
Dim pEnumFeature As IEnumFeature
Dim pNewFeature As IFeature
Dim pPolyline As IPolyline5
Dim pFromPoint As IPoint
Dim pToPoint As IPoint
Dim TargetFeatureClass As IFeatureClass
Dim c As Long
Dim incrementX As Double
Dim incrementY As Double
Dim labelindex As Integer
pUID = "esriCore.Editor"
Set pEditor = Application.FindExtensionByCLSID(pUID)
Set pEditLayers = pEditor
Set pActiveView = pEditor.Map
If pEditor.EditState = esriStateNotEditing Then
MsgBox "You be editing to use this!"
Exit Sub
End If
If Not pEditLayers.CurrentLayer.FeatureClass.ShapeType = esriGeometryPolyline Then
MsgBox "Destination layer must be a polyline type!"
Exit Sub
Else
Set TargetFeatureClass = pEditLayers.CurrentLayer.FeatureClass
labelindex = TargetFeatureClass.FindField("label")
If labelindex = -1 Then
If MsgBox("Label field does not exist in the target feature class." & Chr(13) & _
"Longitude & Latitude numeric values will not be stored!" & Chr(13) & _
"Continue Anyaway") = vbNo Then
Exit Sub
End If
End If
End If
'Start an edit operation
pEditor.StartOperation
incrementX = UpperLeftX
Do While incrementX < BottomRightX
Application.StatusBar.message(0) = "Creating Latitude " & incrementX
Set pFromPoint = New Point
Set pToPoint = New Point
Set pPolyline = New Polyline
pFromPoint.x = incrementX
pFromPoint.y = UpperLeftY
pPolyline.FromPoint = pFromPoint
pToPoint.x = incrementX
pToPoint.y = BottomRightY
pPolyline.ToPoint = pToPoint
Set pNewFeature = pEditLayers.CurrentLayer.FeatureClass.CreateFeature
Set pNewFeature.Shape = pPolyline
If labelindex <> -1 Then pNewFeature.Value(labelindex) = incrementX
pNewFeature.Store
incrementX = (incrementX) + (IntervalX) 'negative values probably
Loop
incrementY = BottomRightY
Do While incrementY < UpperLeftY
Application.StatusBar.message(0) = "Creating Longtitude " & incrementY
Set pFromPoint = New Point
Set pToPoint = New Point
Set pPolyline = New Polyline
pFromPoint.x = UpperLeftX
pFromPoint.y = incrementY
pPolyline.FromPoint = pFromPoint
pToPoint.x = BottomRightX
pToPoint.y = incrementY
pPolyline.ToPoint = pToPoint
Set pNewFeature = pEditLayers.CurrentLayer.FeatureClass.CreateFeature
Set pNewFeature.Shape = pPolyline
If labelindex <> -1 Then pNewFeature.Value(labelindex) = incrementY
pNewFeature.Store
incrementY = (incrementY) + (IntervalY) 'negative values probably
Loop
'Complete the edit operation
pEditor.StopOperation "Create Polylines"
pActiveView.Refresh
End Sub
