Parsing Multipacth Shapefile

Anonymous User

Original User: ddurgaprasad

I 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

WireframeMode.PNG

PolygonMode.PNG

Multipatch.zip

ForrestLin_1-1764767987352.png

ForrestLin_0-1764767799900.png

CMcDonald_1-1764759028697.png

Anonymous User

Original User: ddurgaprasad

I 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 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

Appreciate if folks from ESRI could answer this....