Problem: IMultiPatch::XYFootprint returns an empty geometry if the multipatch is vertical


** Fixed at ArcGIS 8.2 **

The IMultiPatch::XYFootprint function returns an empty geometry if the multipatch is vertical.


This method only returns polygon geometries.

Solution or Workaround

If the returned geometry is a polyline, use this code sample.

Public Sub main()

Dim pPoly As IPolyline
Dim pPolyColl As ISegmentCollection
Dim pLine1 As ILine
Dim pLine2 As ILine
Dim pMP As IConstructMultiPatch
Dim pFootprint As IPolyline
Dim pTopo As ITopologicalOperator
Dim pPt0 As IPoint
Dim pPt1 As IPoint
Dim pPt2 As IPoint
Dim pPt3 As IPoint
Set pPt0 = New Point
Set pPt1 = New Point
Set pPt2 = New Point
Set pPt3 = New Point
pPt0.PutCoords 0, 0
pPt1.PutCoords 1, 0
pPt2.PutCoords 2, 0
pPt3.PutCoords 3, 3
Set pMP = New MultiPatch
Set pLine1 = New Line
pLine1.PutCoords pPt0, pPt1
Set pLine2 = New Line
pLine2.PutCoords pPt2, pPt3
Set pPolyColl = New Polyline
pPolyColl.AddSegment pLine1
pPolyColl.AddSegment pLine2
Set pPoly = pPolyColl
Set pTopo = pPoly

pMP.ConstructExtrudeFromTo 0, 1, pPoly
Set pFootprint = FootLine(pMP)

End Sub
Private Function FootLine(pMP As IMultiPatch) As IPolyline
Dim pResultGeoms As IGeometryCollection
Dim pResultTopo As ITopologicalOperator
Dim pStepGeom As IGeometry
Dim pStepGeoms As IGeometryCollection
Dim pPartGeom As IGeometry
Dim pMPGeoms As IGeometryCollection
Dim cCurrentPart As Long
Dim cParts
Set pResultGeoms = New Polyline
Set pResultTopo = pResultGeoms
Set pStepGeoms = New Polyline
Set pStepGeom = pStepGeoms
Set pMPGeoms = pMP

cParts = pMPGeoms.GeometryCount

For cCurrentPart = 0 To cParts - 1
MakePartLine cCurrentPart, pMPGeoms, pStepGeom
Set pPartGeom = pStepGeoms.Geometry(0)
pResultGeoms.AddGeometry pPartGeom
Next cCurrentPart

Set FootLine = pResultTopo
End Function

Private Sub MakePartLine(cCurrentPart As Long, pMP As IGeometryCollection, pOutGeom As IGeometry)
Dim cPartPts As Long
Dim index As Long
Dim leftX As Double
Dim leftY As Double
Dim rightX As Double
Dim rightY As Double
Dim x As Double
Dim y As Double
Dim pPartGeom As IGeometry
Dim pPartPts As IPointCollection
Dim pLeftPt As IPoint
Dim pRightPt As IPoint
Dim pCurrentPt As IPoint
Dim pResultPts As IPointCollection
Set pPartGeom = pMP.Geometry(cCurrentPart)
Set pPartPts = pPartGeom
Set pLeftPt = New Point
Set pRightPt = New Point
Set pCurrentPt = New Point
cPartPts = pPartPts.PointCount

If cPartPts < 1 Then
Exit Sub
End If

pPartPts.QueryPoint 0, pCurrentPt
pCurrentPt.QueryCoords leftX, leftY
rightX = leftX
rightY = leftY

For index = 1 To cPartPts - 1
pPartPts.QueryPoint index, pCurrentPt
pCurrentPt.QueryCoords x, y
If x < leftX Or (x = leftX And y < leftY) Then
leftX = x
leftY = y
ElseIf x > rightX Or (x = rightX And y > rightY) Then
rightX = x
rightY = y
End If
Next index

pLeftPt.PutCoords leftX, leftY
pRightPt.PutCoords rightX, rightY

Set pResultPts = pOutGeom
pResultPts.AddPoint pLeftPt
pResultPts.AddPoint pRightPt
End Sub