How does IZ.InterpolateFromSurface work?

Question

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

MarAlcaraz1 · Answer

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

AlexanderGray · Answer

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)

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

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 · Answer

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