Elevation processing (Improvement)

Sub elevation processing ()

Dim app as iapplication
Set APP = Application

Dim pmxdocument as imxdocument
Set pmxdocument = application. Document

Dim pmap as IMAP
Set pmap = pmxdocument. focusmap

Dim pfeaturelayer as ifeaturelayer
Set pfeaturelayer = pmap. layer (0)

Dim ptinlayer as itinlayer
Set ptinlayer = pmap. layer (1)

Dim pfuncsurf as ifunctionalsurface
Set pfuncsurf = ptinlayer. Dataset

Dim pfeaturecursor as ifeaturecursor
Set pfeaturecursor = pfeaturelayer. featureclass. Update (nothing, false)'Cursor for Modification

Dim pfeature as ifeature
Set pfeature = pfeaturecursor. nextfeature

Dim Ppoint as ipoint
Dim X as double
Dim y as double
Dim Z as double

Dim index as integer
Dim pfields as ifields

 

While not pfeature is nothing

Set Ppoint = pfeature. shapecopy
X = Ppoint. x
Y = Ppoint. Y
Z = pfuncsurf. Z (x, y)

Set pfields = pfeature. Fields
Index = pfields. findfield ("elevation ")

Pfeature. Value (INDEX) = z
Pfeaturecursor. updatefeature pfeature'Improved the efficiency of the modified cursor

Set pfeature = pfeaturecursor. nextfeature
Wend

Msgbox "converted"
End sub