|
This ArcMap VBA code outputs a .csv ordered list of corner points from a polygon feature class of USGS Quadrangle boundaries. Nothing fancy, just a quick and dirty example of how to access, quickly assess, and output the needed geometry values stored in a SHAPE type field. You could do the same thing in Python but using ArcObjects in VBA opens the doors to more powerful feature-level manipulation (looking at connectivity or proximity to other features for example) if you want to go beyond this simple analysis. I doubt anyone will have a need to use this again for its specific purpose but its a good starting point for doing other, similar things. Output will look something like this (in this example, my coords are in NAD83) 1, CO-OP SPRING, Q0214, 42112A5, 365680, 4664719, 376012, 4664530, 375768, 4650651, 365416, 4650840, 365680, 4664719 2, GROVER CANYON, Q0215, 42112A4, 376012, 4664530, 386345, 4664356, 386121, 4650477, 375768, 4650651, 376012, 4664530 .
.
. 1540, CHOCOLATE DROP, Q3832, 37110E3, 555153, 4164188, 566184, 4164269, 566295, 4150401, 555246, 4150320, 555153, 4164188
Option Explicit
Public Sub getOrderedQuadCorners()
Open "c:/temp/quadcorners.csv" For Output As #1
Dim pMxDoc As IMxDocument
Dim pMap As IMap
Set pMxDoc = ThisDocument
Set pMap = pMxDoc.FocusMap
Dim pSrcLayer As IFeatureLayer
Dim pSrcFeatureClass As IFeatureClass
Dim pSrcFeatureCursor As IFeatureCursor
Dim pSrcFeature As IFeature
Dim pPolygon As IPolygon
Dim pPC As IPointCollection
Dim pArea As IArea
Dim pQF As IQueryFilter
Set pSrcLayer = pMap.Layer(0) '(Source Layer is first layer in TOC)
Set pSrcFeatureClass = pSrcLayer.FeatureClass
Set pQF = New QueryFilter
pQF.WhereClause = ""
Set pSrcFeatureCursor = pSrcLayer.Search(pQF, True)
Set pSrcFeature = pSrcFeatureCursor.NextFeature
Dim count As Integer
Dim centerX As Double
Dim centerY As Double
Dim NEX As Double
Dim NEY As Double
Dim NWX As Double
Dim NWY As Double
Dim SEX As Double
Dim SEY As Double
Dim SWX As Double
Dim SWY As Double
Dim pPt As IPoint
Dim x As Long
'write csv header
Print #1, "AutoNum,QuadName,QuadNumber,OhioCode, " & _
"NW_x,NW_y,NE_x,NE_y,SE_x,SE_y,SW_x,SW_y,NW_x,NW_y "
'iterate through quad features (which are all polygons with 5 points)
Do Until pSrcFeature Is Nothing
count = count + 1
Set pPolygon = pSrcFeature.Shape
Set pArea = pPolygon
Set pPC = pPolygon
centerX = pArea.Centroid.x
centerY = pArea.Centroid.Y
'iterate through points and check for corner location
For x = 0 To pPC.PointCount - 1
Set pPt = pPC.Point(x)
If pPt.x > centerX And pPt.Y > centerY Then
NEX = CLng(pPt.x)
NEY = CLng(pPt.Y)
End If
If pPt.x < centerX And pPt.Y > centerY Then
NWX = CLng(pPt.x)
NWY = CLng(pPt.Y)
End If
If pPt.x > centerX And pPt.Y < centerY Then
SEX = CLng(pPt.x)
SEY = CLng(pPt.Y)
End If
If pPt.x < centerX And pPt.Y < centerY Then
SWX = CLng(pPt.x)
SWY = CLng(pPt.Y)
End If
Next x
Print #1, count & "," & _
pSrcFeature.Value(pSrcFeature.Fields.FindField("NAME")) & "," & _
pSrcFeature.Value(pSrcFeature.Fields.FindField("LOCATION")) & "," & _
pSrcFeature.Value(pSrcFeature.Fields.FindField("OHIO_CODE")) & "," & _
NWX & "," & NWY & "," & _
NEX & "," & NEY & "," & _
SEX & "," & SEY & "," & _
SWX & "," & SWY & "," & _
NWX & "," & NWY
Set pSrcFeature = pSrcFeatureCursor.NextFeature
Loop
Close #1
End Sub |
