[求助]创建一个新的Tin图层

请问怎样创建一个新的tin图层，并且将tin加入到该图层中？

<P>在运行程序前，先选择你的点图层，用来表现你的tin的字段数值要是double类型的</P>
<P>在VBA 编辑器里：</P>
<P>add a user form (named UserForm1) <BR>Add the Microsoft Common Dialog Control from the Components Dialog Box <BR>Add a Common Dialog control to the form (named CommonDialog1) <BR>Add a Textbox to the form (named txtSaveAs) <BR>Add a Combobox to the form (named cboFields) <BR>Add a Command Button to the form (named cmdSaveAs) <BR>Add the following code behind the form <BR>Select Save As, and select the name and location of the TIN you will create <BR>Click Create TIN </P>
<P>Make sure you have added the required references (e.g. Geoprocessing etc) <BR>Make sure 3D Analyst is enabled </P>
<P>Hope that helps, </P>
<P>Rob <BR>  <BR>  Option Explicit</P>
<P>Dim pMXdoc As IMxDocument<BR>Dim pMap As IMap</P>
<P>Dim i As Integer 'Used as a Loop Counter etc</P>
<P><BR>Private Sub cmdSaveAs_Click()</P>
<P>'Used Common Dialog opposed to GXDialog as its faster ; works with Engine<BR>CommonDialog1.ShowSave<BR>txtSaveAs.Text = CommonDialog1.FileName</P>
<P>End Sub</P>
<P>Private Sub CommandButton1_Click()</P>
<P>Set pMXdoc = ThisDocument<BR>Set pMap = pMXdoc.FocusMap</P>
<P>Dim player As ILayer<BR>Set player = PointShapeFileToTINConversion(pMXdoc.SelectedLayer, txtSaveAs.Text)</P>
<P>pMap.AddLayer player</P>
<P>End Sub</P>
<P><BR>Public Function PointShapeFileToTINConversion(pFeatureLayer As IFeatureLayer, pTinFileName As String) As ITinLayer</P>
<P>  Dim pGeoDataSet As IGeoDataset<BR>  Set pGeoDataSet = pFeatureLayer</P>
<P>  Dim pExtent As IEnvelope<BR>  Set pExtent = pGeoDataSet.Extent</P>
<P>  Dim pTinEdit As ITinEdit<BR>  Set pTinEdit = New Tin<BR>  pTinEdit.InitNew pExtent</P>
<P>  ' Set the spatial extent<BR>  Dim pSpatial As ISpatialReference<BR>  Set pSpatial = pGeoDataSet.SpatialReference</P>
<P>  Set pExtent.SpatialReference = pSpatial</P>
<P>  'This could be used to filter the points selected<BR>  Dim pQueryFilter As IQueryFilter<BR>  Set pQueryFilter = New QueryFilter<BR>  <BR>  Dim pFields As IFields<BR>  Set pFields = pFeatureLayer.FeatureClass.Fields<BR>  <BR>  i = pFields.FindField(cboFields.Text)<BR>  <BR>  Dim pField As IField<BR>  Set pField = pFields.Field(i)</P>
<P>  pTinEdit.AddFromFeatureClass pFeatureLayer.FeatureClass, _<BR>  pQueryFilter, pField, Nothing, esriTinMassPoint, True<BR>    <BR>  pTinEdit.SaveAs pTinFileName, True<BR>  pTinEdit.StopEditing False</P>
<P>  Dim pTin As ITinAdvanced2<BR>  Set pTin = pTinEdit</P>
<P>  Dim pTinLayer As ITinLayer<BR>  Set pTinLayer = New TinLayer<BR>  Set pTinLayer.Dataset = pTinEdit<BR>  Set pTinLayer.Name = pTinFileName</P>
<P>  Set PointShapeFileToTINConversion = pTinLayer</P>
<P>End Function</P>
<P>Private Sub UserForm_Activate()</P>
<P>Set pMXdoc = ThisDocument<BR>Set pMap = pMXdoc.FocusMap</P>
<P>'Check Layers Exist<BR>If pMap.LayerCount = 0 Then<BR>Close_Form ("No Layers present in Map Document")<BR>Exit Sub<BR>End If</P>
<P>'Check Layer Is Selected<BR>If pMXdoc.SelectedLayer Is Nothing Then<BR>Close_Form ("You must Select a Feature Layer")<BR>Exit Sub<BR>End If</P>
<P>'Check Selected Layer is a FeatureLayer<BR>If Not TypeOf pMXdoc.SelectedLayer Is IFeatureLayer Then<BR>Close_Form ("The Selected Layer is not a Feature Layer E.g. Point, Line, Polygon")<BR>Exit Sub<BR>End If</P>
<P>'Get FeatureClass of First Layer<BR>Dim pFC As IFeatureClass<BR>Dim pFL As IFeatureLayer2<BR>Set pFL = pMXdoc.SelectedLayer<BR>Set pFC = pFL.FeatureClass</P>
<P>'Check Layer is Point Layer<BR>If (pFC.ShapeType <> esriGeometryPoint) Then<BR>Close_Form ("The Selected Layer is not a Point Feature Class")<BR>Exit Sub<BR>End If</P>
<P>'Add Fields to Combobox<BR>Dim pField As IField<BR>Dim pFields As IFields<BR>Set pFields = pFC.Fields<BR>For i = 0 To (pFields.FieldCount - 1)<BR>  Set pField = pFields.Field(i)<BR>  cboFields.AddItem pField.Name, i<BR>Next i</P>
<P>End Sub</P>
<P>Function Close_Form(Optional m As String) As Boolean<BR>Set pMXdoc = Nothing<BR>Set pMap = Nothing</P>
<P>MsgBox (m)<BR>Unload UserForm1<BR>End Function</P>
<P> <BR></P>