Buffering an IElement that is in the Geographic Coordinate System (GCS)

[MeToo]

Hi:

I need to properly buffer an element (IElement) that is on a data frame in Geographic Coordinate System.

The buffer distance can be linear (Km, miles, etc.) or angular (degrees). The element can be located anywhere on earth and I would like to minimize distance distortions.

The issue I am facing is well explained in the Esri cartography blog at http://blogs.esri.com/esri/arcgis/2009/07/15/the-buffer-wizard-in-arcmap/  (apparently one needs to be logged in to access the correct page). What I need to do is emulate through ArcObjects and VB.NET the ArcMap 8.x Buffer wizard's Buffer when its Processing Coordinate System (BPCS) is set to "Feature optimized coordinate system".


[INDENT]Feature optimized coordinate system �?? A BPCS is created for each feature being buffered, and each is based on an azimuthal equidistant projection created for each separate feature. For lines and polygons, the center point of each feature is calculated. [...] This setting also helps minimize distortion regardless of the spatial reference of the Data Frame. Though performance will be slower with this setting, it does offer the least distortion when buffering point features. [/INDENT]


The way I translate this in ArcObject is that I need to create a generic azimuthal equidistant projection and then customize it for the element (either a point element or the center of the element envelope). I think I have found the way to get the generic azimuthal equidistant projection, but would appreciate your help in customizing it/optimizing it to any element.

    Dim pSpatRefFact As ESRI.ArcGIS.Geometry.ISpatialReferenceFactory

    'Set the spatial reference factory to a new spatial reference environment
    pSpatRefFact = New ESRI.ArcGIS.Geometry.SpatialReferenceEnvironment

    'Create a projected coordinate system using the available projected coordinate systems
    Dim pProjCoordSys As ESRI.ArcGIS.Geometry.IProjectedCoordinateSystem = pSpatRefFact.CreateProjectedCoordinateSystem(ESRI.ArcGIS.Geometry.esriSRProjCSType.esriSRProjCS_World_AzimuthalEquidistant)

    'Optimizing the projected coordinate system for an IElement
    pProjCoordSys.??????  = ??????

Thanks,
Dennis

[PhilBlondin]

Here is some VBA code.  make a tool button in ArcMap and put this behind the mouse down event.  This should give you a radius that is equal in distance.  this is done by centering the coordinate system origin on the point.

Private Sub Create_Circle_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
On Error GoTo EH
    Dim pMxDoc As IMxDocument
    Set pMxDoc = ThisDocument
    Dim pMap As IMap
    Set pMap = pMxDoc.FocusMap
    Dim pAV As IActiveView
    Set pAV = pMxDoc.ActivatedView
    Dim pWGS84CoordSys As IGeographicCoordinateSystem
    Dim pSpatialRefFactory As ISpatialReferenceFactory
   
    Set pSpatialRefFactory = New SpatialReferenceEnvironment
    Set pWGS84CoordSys = pSpatialRefFactory.CreateGeographicCoordinateSystem(esriSRGeoCSType.esriSRGeoCS_WGS1984)
   
    Dim pCenterPoint As IPoint
    Set pCenterPoint = pAV.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)
   
    Dim pPCS As IProjectedCoordinateSystem
    Set pPCS = ProjectToWGSAzimuthal(pCenterPoint.x, pCenterPoint.y)
   
    Set pCenterPoint.SpatialReference = pMap.SpatialReference
    pCenterPoint.Project pPCS
       
    Dim pConstructCircleArc As IConstructCircularArc
    Set pConstructCircleArc = New CircularArc
   
    Dim inputRadius As String
    inputRadius = InputBox("Enter Radius")
   
    If inputRadius = "" Then Exit Sub
    If Not IsNumeric(inputRadius) Then Exit Sub
    If CDbl(inputRadius) <= 0 Then Exit Sub
          
    Dim outRadius As Double
    outRadius = ConvertUnits(CDbl(inputRadius))
          
    pConstructCircleArc.ConstructCircle pCenterPoint, CDbl(outRadius), True
    
    Dim pSegmentCollection As ISegmentCollection
    Dim pPolygon As IPolygon

    Dim pGraphContainer As IGraphicsContainer
    Set pGraphContainer = pMxDoc.ActiveView
    Dim pGCSelect As IGraphicsContainerSelect
    Set pGCSelect = pMxDoc.FocusMap
   
    Dim pElement As IElement
    Set pElement = New PolygonElement
     
    Set pSegmentCollection = New Polygon
    pSegmentCollection.AddSegment pConstructCircleArc
   
    Set pElement = New CircleElement
    pElement.Geometry = pSegmentCollection
        
    Dim pPoly As IPolygon
    Set pPoly = pElement.Geometry
   
    pPoly.Densify 0, 0
   
    Set pPoly.SpatialReference = pPCS
    pPoly.Project pWGS84CoordSys
         
    pElement.Geometry = pPoly
      
    Dim pLineSymbol As ISimpleLineSymbol
    Dim pColor As IColor
    Dim pLineColor As IRgbColor
    Set pLineColor = New RgbColor
    pLineColor.Red = 20
    pLineColor.Green = 36
    pLineColor.Blue = 255
    Set pLineSymbol = New SimpleLineSymbol
    pLineSymbol.Width = 2
    pLineSymbol.Color = pLineColor
           
    Set pColor = New RgbColor
    pColor.NullColor = True
   
    Dim pFillShpElem As IFillShapeElement
    Dim pSFSymbol As ISimpleFillSymbol
    Set pFillShpElem = pElement
     
    Set pSFSymbol = New SimpleFillSymbol
    pSFSymbol.Style = esriSFSHollow
    pSFSymbol.Color = pColor
    pSFSymbol.Outline = pLineSymbol
    pFillShpElem.Symbol = pSFSymbol
  
    Set pGraphContainer = pAV
    pGraphContainer.AddElement pFillShpElem, 0
    pGCSelect.SelectElement pFillShpElem
      
    pMxDoc.ActiveView.PartialRefresh esriViewGraphics, Nothing, Nothing
   
    Set pSpatialRefFactory = Nothing
    Set pWGS84CoordSys = Nothing
    Set pMxDoc = Nothing
    Set pMap = Nothing
    Set pAV = Nothing
    Set pCenterPoint = Nothing
    Set pConstructCircleArc = Nothing
    Set pSegmentCollection = Nothing
    Set pPolygon = Nothing
    Set pGraphContainer = Nothing
    Set pElement = Nothing
    Set pFillShpElem = Nothing
    Set pSFSymbol = Nothing
    Set pColor = Nothing
    Set pLineColor = Nothing
    Set pLineSymbol = Nothing
    Set pPCS = Nothing
 
   
  Exit Sub
EH:
   
    MsgBox Err.Number & " " & Err.Description
End Sub

Public Function ConvertUnits(inUnits As Double) As Double
On Error GoTo EH
    Dim pUI As IUnitConverter
    Set pUI = New UnitConverter
    ConvertUnits = pUI.ConvertUnits(inUnits, esriFeet, esriMeters)

    Set pUI = Nothing
Exit Function
EH:
    MsgBox Err.Number & " " & Err.Description, , "ConvertUnits"
End Function

Public Function ProjectToWGSAzimuthal(ByVal dLon As Double, _
                         ByVal dLat As Double) As IProjectedCoordinateSystem2
    Dim pSRF As ISpatialReferenceFactory2
    Set pSRF = New SpatialReferenceEnvironment
    Set ProjectToWGSAzimuthal = pSRF.CreateProjectedCoordinateSystem(esriSRProjCS_WGS1984N_PoleAziEqui)
    ProjectToWGSAzimuthal.CentralMeridian(True) = dLon
    ProjectToWGSAzimuthal.LatitudeOfOrigin = dLat
   
    Set pSRF = Nothing
End Function

[MeToo]

Hi Al:

Thanks for your reply and sorry it's taken me so long to get back to it. I wanted to incorporate the code with my own first. It works well.

Thanks again,
Dennis