Original User: ddurgaprasadI am parsing a multipatch file ,representing 3d buildings using the following VBA script.Though multipatch is a collection of rings,trainglefans,triaglestrips and triangles,I am getting onyl "Rings" for all buildings.Consequently ,my rendering in OpenGL or any other external graphics library is showing correct result in wireframe mode.Since ,the output is only "Rings" type,I am unable to fill the buildings polygons.Attachment has sampe multipatch file,Snapshots of redndered image.Can the anyone point out what went wrong...Sub MultipatchInfo()
Dim pDoc As IMxDocument
Dim pMap As IMap
Set pDoc = ThisDocument
Set pMap = pDoc.FocusMap
Dim pPolygon As IPolygon
Dim pMultiPatch As IMultiPatch
'-- Get the selected layer
Dim pFLayer As IFeatureLayer
Set pFLayer = pDoc.SelectedLayer
Dim pFc As IFeatureClass
Set pFc = pFLayer.FeatureClass
'-- Loop through the features and get the area
Dim pFCursor As IFeatureCursor
Set pFCursor = pFLayer.Search(Nothing, False)
Dim pFeat As IFeature
Set pFeat = pFCursor.NextFeature
Dim multiPatchGeometryCollection As IGeometryCollection
Set multiPatchGeometryCollection = New MultiPatch
Dim strType As String
Dim strRingType As String
Do Until pFeat Is Nothing
If pFeat.Shape.GeometryType = esriGeometryMultiPatch Then
Set multiPatchGeometryCollection = pFeat.ShapeCopy
UserForm1.ListBox1.AddItem pFeat.OID & "-----------" & multiPatchGeometryCollection.GeometryCount
'MsgBox ("Yes:" & multiPatchGeometryCollection.GeometryCount)
Dim pMP As IMultiPatch2
Set pMP = New MultiPatch
Set pMP = multiPatchGeometryCollection
For i = 0 To multiPatchGeometryCollection.GeometryCount - 1
Select Case multiPatchGeometryCollection.Geometry(i).GeometryType
Case 11
strType = "Ring"
Case 18
strType = "TriangleStrip"
Case 19
strType = "TriangleFan"
Case 22
strType = "Triangles"
End Select
Select Case pMP.GetRingType(multiPatchGeometryCollection.Geometry(i), True)
Case 1
strRingType = "esriMultiPatchInvalidRing"
Case 2
strRingType = "esriMultiPatchUndefinedRing"
Case 4
strRingType = "esriMultiPatchFirstRing"
Case 8
strRingType = "esriMultiPatchRing"
Case 16
strRingType = "esriMultiPatchOuterRing"
Case 32
strRingType = "esriMultiPatchInnerRing"
Case 28
strRingType = "esriMultiPatchBeginningRingMask"
Case 40
strRingType = "esriMultiPatchFollowingRingMask"
Case 3
strRingType = "esriMultiPatchProblemCaseRingMask"
End Select
UserForm1.ListBox2.AddItem strType & "---" & i & "---" & strRingType
Next i
End If
Set pFeat = pFCursor.NextFeature
Loop
UserForm1.Show
End Sub