How does IZ.InterpolateFromSurface work?

[MarAlcaraz1]

Hi, I am trying to convert a tin to a 3D polygon feature class. Could someone help me with this code? I am not sure it is correct.

I got this error "The geometry has null Z values" on the line  "Set pFeat.Shape = pPoly"

Hope Neil to be there!!! Thanks, Mar


Dim pSxDoc As ISxDocument
Set pSxDoc = ThisDocument

Dim pScene As IScene
Set pScene = pSxDoc.Scene

Dim pTinLayer As ITinLayer
Set pTinLayer = pScene.Layer(0)

Dim pTin As ITin
Set pTin = pTinLayer.Dataset

Dim pTinAdv As ITinAdvanced2
Set pTinAdv = pTin

Dim pTinTriangle As ITinTriangle
Dim pTinPoly As ITinPolygon
Dim pPoly As IPolygon5
Dim pZAware As IZAware
Dim pPolyLayer As IFeatureLayer
Dim pPolyFC As IFeatureClass
Dim pFeat As IFeature
Dim pFunSurf As IFunctionalSurface
Dim pIZ As IZ

Dim i As Long
For i = 1 To pTinAdv.TriangleCount

Set pTinTriangle = pTinAdv.GetTriangle(i)

Set pTinPoly = pTinAdv.ExtractPolygon(pTinTriangle, Nothing, False)

Set pPoly = pTinPoly.AsPolygon(Nothing, True)

Set pPolyLayer = pScene.Layer(1)

Set pPolyFC = pPolyLayer.FeatureClass

Set pZAware = pPoly
pZAware.ZAware = True

Set pFunSurf = pTin

Set pIZ = pPoly
pIZ.InterpolateFromSurface pFunSurf

Set pFeat = pPolyFC.CreateFeature
Set pFeat.Shape = pPoly        "The geometry has null Z values"
pFeat.Store

Next

[AlexanderGray]

The polygon extracted doesn't contain Z values, you have to apply them by overlaying it with the surface. 
It also concerns me that you are looping through all the triangles and calling extract polygon with the triangle and no filter and stop at edge false.  That means that if your TIN is a continuous surface, you will get a polygon representing the entire surface for each call to extract polygon.

If your intention is to create a triangular polygon for each triangle of the TIN, I think you are better off creating a new polygon for each triangle and adding the three nodes of the triangle as points to that polygon.

[MarAlcaraz1]

Thanks Alexsander, I followed your instructions and coded it again.

This code creates some polygons, but there are tintriangles that return again the error "The geometry has null Z values" when the line "Set pFeat.Shape = pPolygon" runs.

I don't know enough about the geometry of TINs. I suppose the definition of those tintriangles is wrong.

This is the new code: Any idea???

Private Sub Tin2Poly_Click()

Dim pSxDoc As ISxDocument
Set pSxDoc = ThisDocument

Dim pScene As IScene
Set pScene = pSxDoc.Scene

Dim pTinLayer As ITinLayer
Set pTinLayer = pScene.Layer(0)

Dim pTin As ITin
Set pTin = pTinLayer.Dataset

Dim pTinAdv As ITinAdvanced2
Set pTinAdv = pTin

    Dim pTinTriangle As ITinTriangle
    Dim pPoint1 As IPoint
    Dim pPoint2 As IPoint
    Dim pPoint3 As IPoint
    Dim pSide1 As ILine
    Dim pSide2 As ILine
    Dim pSide3 As ILine
    Dim pSidesColl As ISegmentCollection
    Dim pRing As IRing2
    Dim pGCollRings As IGeometryCollection
    Dim pPolygon As IPolygon
    Dim pZAwarePoly As IZAware
    Dim pPolyLayer As IFeatureLayer2
    Dim pPolyFC As IFeatureClass
    Dim pFeat As IFeature

    Dim i As Long
    For i = 1 To pTinAdv.TriangleCount
   
    Set pTinTriangle = pTinAdv.GetTriangle(i)
   
    Set pPoint1 = New Point
    Set pPoint2 = New Point
    Set pPoint3 = New Point
   
    pPoint1.x = pTinTriangle.Node(0).x
    pPoint1.y = pTinTriangle.Node(0).y
    pPoint1.Z = pTinTriangle.Node(0).Z
   
    pPoint2.x = pTinTriangle.Node(1).x
    pPoint2.y = pTinTriangle.Node(1).y
    pPoint2.Z = pTinTriangle.Node(1).Z
   
    pPoint3.x = pTinTriangle.Node(2).x
    pPoint3.y = pTinTriangle.Node(2).y
    pPoint3.Z = pTinTriangle.Node(2).Z
   
    Set pSide1 = New Line
    Set pSide2 = New Line
    Set pSide3 = New Line

    pSide1.PutCoords pPoint1, pPoint2
    pSide2.PutCoords pPoint2, pPoint3
    pSide3.PutCoords pPoint3, pPoint1

    Set pSidesColl = New Ring
    pSidesColl.AddSegment pSide1
    pSidesColl.AddSegment pSide2
    pSidesColl.AddSegment pSide3

    Set pRing = pSidesColl
    pRing.Close

    Set pGCollRings = New polygon
    pGCollRings.AddGeometry pRing

    Set pPolygon = pGCollRings

    Set pZAwarePoly = pPolygon
    pZAwarePoly.ZAware = True

    Set pPolyLayer = pScene.Layer(1)
    Set pPolyFC = pPolyLayer.FeatureClass
    Set pFeat = pPolyFC.CreateFeature
    Set pFeat.Shape = pPolygon
    pFeat.Store
   
    Next
   
pSxDoc.UpdateContents

pSxDoc.Scene.SceneGraph.Invalidate pPolyLayer, True, True
pSxDoc.Scene.SceneGraph.RefreshViewers

End Sub

[AlexanderGray]

Either the geometry doesn't have Z values, which it looks like it does or the target featureclass does not allow Z values.  Can you check if the polygon featureclass allows for Z values?

As far as the rest of your code, I think there are some inefficiencies.
In ITinNode.QueryAsPoint there are some remarks about how it is faster than creating a new point in each iteration (you need to create your point before the loop)
Secondly, creating, points, then lines, then rings, then polygons is probably not efficient.  You can declare a new polygon, cast it to an IPointCollection, add the points to it, and user simplify on the ipolygon (inherited from IGeometry.)

[MarAlcaraz1]

Alexander, I tried to follow your instructions, but I had some problems. I make some changes in order to simplify the code and this is the new one. This time the feature class contains polygons without shape, it constructs a row for each triangle, but I can't see them. Maybe I am not using properly the itinadvanced.extractpolygon method, or itinpolygon.aspolygon...

Some idea?

Dim pSxDoc As ISxDocument
Set pSxDoc = ThisDocument

Dim pScene As IScene
Set pScene = pSxDoc.Scene

Dim pTinLayer As ITinLayer
Set pTinLayer = pScene.Layer(0)

Dim pTin As ITin
Set pTin = pTinLayer.Dataset

Dim pTinAdv As ITinAdvanced2
Set pTinAdv = pTin

Dim pTinTriangle As ITinTriangle
Dim pTinPoly As ITinPolygon
Dim pPolygon As IPolygon
Dim pZAwarePoly As IZAware
Dim pPolyLayer As IFeatureLayer2
Dim pPolyFC As IFeatureClass
Dim pFeat As IFeature

Dim i As Integer
For i = 1 To pTinAdv.TriangleCount

Set pTinTriangle = pTinAdv.GetTriangle(i)

Set pTinPoly = pTinAdv.ExtractPolygon(pTinTriangle, Nothing, True)

Set pPolygon = pTinPoly.AsPolygon(Nothing, True)

Set pZAwarePoly = pPolygon
pZAwarePoly.ZAware = True

Set pPolyLayer = pScene.Layer(1)
Set pPolyFC = pPolyLayer.FeatureClass
Set pFeat = pPolyFC.CreateFeature
On Error Resume Next
Set pFeat.Shape = pPolygon
pFeat.Store
   
Next

[AlexanderGray]

I was thinking more along the lines (this is approximate code)

Dim i As Integer
For i = 0 To pTinAdv.TriangleCount -1

Set pTinTriangle = pTinAdv.GetTriangle(i)

dim poly as IPolygon
set poly = new polygon
'set polygon spatial reference
dim polyPtColl as IPointCollection
set polyPtColl = poly
dim pt as IPoint
set pt = new Point
'set point spatial reference (same as TIN)
dim j as integer
for j = 0 to 2
  pTinTriangle.Node(j).QueryAsPoint pt
  polyPtColl.AddPoint(pt)

next

poly.Simplify

Set pPolyLayer = pScene.Layer(1)
Set pPolyFC = pPolyLayer.FeatureClass
Set pFeat = pPolyFC.CreateFeature
On Error Resume Next
Set pFeat.Shape = poly
pFeat.Store

Next 

You may also write something like this:


Set pTinTriangle = pTinAdv.GetTriangle(i)
dim ring as Iring
pTinTriangle.QueryAsRing ring

dim poly as IPolygon
set poly = new polygon
'set poly spatial reference (same as TIN)
dim polyGeoColl as IgeometryCollection
set polyGeoColl = poly
polyGeoColl.AddGeometry(ring)
poly.simplify

'set shape on feature

[MarAlcaraz1]

Thanks very much for your advice Alexander!!!

This is the final code:

Dim pSxDoc As ISxDocument
Set pSxDoc = ThisDocument

Dim pScene As IScene
Set pScene = pSxDoc.Scene

Dim pTinLayer As ITinLayer
Set pTinLayer = pScene.Layer(0)

Dim pTin As ITin
Set pTin = pTinLayer.Dataset

Dim pTinAdv As ITinAdvanced2
Set pTinAdv = pTin

    Dim pTinTriangle As ITinTriangle
    Dim pZAwarePoly As IZAware
    Dim pPolyLayer As IFeatureLayer2
    Dim pPolyFC As IFeatureClass
    Dim pFeat As IFeature
    
    Dim i As Integer
    For i = 1 To pTinAdv.TriangleCount
    
    Set pTinTriangle = pTinAdv.GetTriangle(i)
       
    Dim pPolygon As IPolygon
    Set pPolygon = New polygon
    
    Set pZAwarePoly = pPolygon
    pZAwarePoly.ZAware = True
    
    Dim pPointColl As IPointCollection4
    Set pPointColl = pPolygon
    
    Dim pPoint As IPoint
    Set pPoint = New Point
    
        Dim j As Integer
        For j = 0 To 2
            pTinTriangle.Node(j).QueryAsPoint pPoint
            pPointColl.AddPoint pPoint
        Next
    
    pPolygon.SimplifyPreserveFromTo
    
    
    Set pPolyLayer = pScene.Layer(1)
    Set pPolyFC = pPolyLayer.FeatureClass
    Set pFeat = pPolyFC.CreateFeature
    On Error Resume Next
    Set pFeat.Shape = pPolygon
    pFeat.Store
    
    Next
    
pSxDoc.UpdateContents

pSxDoc.Scene.SceneGraph.Invalidate pPolyLayer, True, True
pSxDoc.Scene.SceneGraph.RefreshViewers