| |
Public Sub GridQuadrilateral()
Dim pMxDoc As IMxDocument
Dim pInFtrLyr As IFeatureLayer
Dim pFtrSel As IFeatureSelection
Dim pOutFtrLyr As IFeatureLayer
Dim pPolygon As IPolygon
Dim pSegColl As ISegmentCollection
Dim lIdx As Long
Dim lCornerIdx(3, 1) As Double
Dim l As Long
' Get the first selected polygon on the first layer
Set pMxDoc = ThisDocument
Set pInFtrLyr = pMxDoc.FocusMap.Layer(0)
Set pFtrSel = pInFtrLyr
Set pPolygon = pInFtrLyr.FeatureClass.GetFeature(pFtrSel.SelectionSet.IDs.Next).Shape
Set pSegColl = pPolygon
' Get the corner coords of the quad
lIdx = 0
For l = 0 To 3
lIdx = GetIndexOfNextCornerSegment(lIdx, pPolygon)
lCornerIdx(l, 0) = pSegColl.Segment(lIdx).FromPoint.X
lCornerIdx(l, 1) = pSegColl.Segment(lIdx).FromPoint.Y
Next l
' Calculate the grid coordinates and store in array
Const GRID_SIZE = 10
Dim dStep As Double
Dim i As Long, j As Long
Dim dx As Double, dy As Double
Dim pt1x As Double, pt1y As Double, pt2x As Double, pt2y As Double
Dim nx As Double, ny As Double
Dim dCoords(GRID_SIZE, GRID_SIZE, 1) As Double
dStep = 1 / CDbl(GRID_SIZE)
For i = 0 To GRID_SIZE
dx = (lCornerIdx(1, 0) - lCornerIdx(0, 0)) * dStep * i
dy = (lCornerIdx(1, 1) - lCornerIdx(0, 1)) * dStep * i
pt1x = lCornerIdx(0, 0) + dx
pt1y = lCornerIdx(0, 1) + dy
dx = (lCornerIdx(2, 0) - lCornerIdx(3, 0)) * dStep * i
dy = (lCornerIdx(2, 1) - lCornerIdx(3, 1)) * dStep * i
pt2x = lCornerIdx(3, 0) + dx
pt2y = lCornerIdx(3, 1) + dy
For j = 0 To GRID_SIZE
dx = (pt2x - pt1x) * dStep * j
dy = (pt2y - pt1y) * dStep * j
nx = pt1x + dx
ny = pt1y + dy
dCoords(j, i, 0) = nx
dCoords(j, i, 1) = ny
Next j
Next i
' Now create the polygons
Dim pFtrCls As IFeatureClass
Dim pFtrCsr As IFeatureCursor
Dim pFtrBfr As IFeatureBuffer
Dim pPtColl As IPointCollection
Dim pPt As IPoint
Set pOutFtrLyr = pMxDoc.FocusMap.Layer(1)
Set pFtrCls = pOutFtrLyr.FeatureClass
Set pFtrBfr = pFtrCls.CreateFeatureBuffer
Set pFtrCsr = pFtrCls.Insert(True)
For i = 0 To GRID_SIZE - 1
For j = 0 To GRID_SIZE - 1
Set pPtColl = New Polygon
Set pPt = New Point
pPt.PutCoords dCoords(j, i, 0), dCoords(j, i, 1)
pPtColl.AddPoint pPt
pPt.PutCoords dCoords(j, i + 1, 0), dCoords(j, i + 1, 1)
pPtColl.AddPoint pPt
pPt.PutCoords dCoords(j + 1, i + 1, 0), dCoords(j + 1, i + 1, 1)
pPtColl.AddPoint pPt
pPt.PutCoords dCoords(j + 1, i, 0), dCoords(j + 1, i, 1)
pPtColl.AddPoint pPt
pPt.PutCoords dCoords(j, i, 0), dCoords(j, i, 1)
pPtColl.AddPoint pPt
Set pFtrBfr.Shape = pPtColl
pFtrCsr.InsertFeature pFtrBfr
Next j
Next i
pMxDoc.ActiveView.Refresh
End Sub
Private Function GetIndexOfNextCornerSegment(lStartIdx As Long, pPolygon As IPolygon) As Long
Dim PI As Double
Dim pSegColl As ISegmentCollection
Dim pLine1 As ILine, pLine2 As ILine
Dim l As Long
Dim lNxtIdx As Long
Dim dAng As Double
PI = Atn(1) * 4
Set pSegColl = pPolygon
For l = 0 To pSegColl.SegmentCount - 2
lNxtIdx = lStartIdx + l
If lNxtIdx = pSegColl.SegmentCount Then lNxtIdx = 0
Set pLine1 = pSegColl.Segment(lNxtIdx)
lNxtIdx = lNxtIdx + 1
If lNxtIdx = pSegColl.SegmentCount Then lNxtIdx = 0
Set pLine2 = pSegColl.Segment(lNxtIdx)
dAng = Abs(pLine1.Angle - pLine2.Angle) * 180 / PI
If dAng > 20 Then
' The start point of this segment is a corner point
GetIndexOfNextCornerSegment = lNxtIdx
Exit Function
End If
Next l
GetIndexOfNextCornerSegment = -1
End Function
|
