tindataareadelineation.frm

arcgis 编程学习事例

VERSION 5.00
Begin VB.Form frmTinDataAreaDelineation 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "TIN Data Area Delineation"
   ClientHeight    =   2796
   ClientLeft      =   48
   ClientTop       =   336
   ClientWidth     =   3828
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2796
   ScaleWidth      =   3828
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   Begin VB.CheckBox chkEnforceEdges 
      Caption         =   "Enforce boundary edges as soft breaklines when saving (recommended)."
      Height          =   435
      Left            =   120
      TabIndex        =   6
      Top             =   1920
      Value           =   1  'Checked
      Width           =   3615
   End
   Begin VB.Frame Frame1 
      Caption         =   "Edge length"
      Height          =   1335
      Left            =   120
      TabIndex        =   2
      Top             =   480
      Width           =   3615
      Begin VB.TextBox txtEdgeLength 
         Height          =   315
         Left            =   2640
         TabIndex        =   3
         Top             =   960
         Width           =   855
      End
      Begin VB.Label Label4 
         Caption         =   "Maximum edge length:"
         Height          =   255
         Left            =   120
         TabIndex        =   5
         Top             =   960
         Width           =   1695
      End
      Begin VB.Label Label1 
         Caption         =   "Triangles comprised of any edge longer than the maximum edge length will be classified as outside."
         Height          =   615
         Left            =   120
         TabIndex        =   4
         Top             =   240
         Width           =   3375
      End
   End
   Begin VB.CommandButton cmdApply 
      Caption         =   "Apply"
      Height          =   315
      Left            =   2760
      TabIndex        =   0
      Top             =   2400
      Width           =   975
   End
   Begin VB.Label Label3 
      Caption         =   "Delineates a TIN's interpolation zone using maximum triangle edge length as the criteria."
      Height          =   495
      Left            =   120
      TabIndex        =   1
      Top             =   0
      Width           =   3735
   End
End
Attribute VB_Name = "frmTinDataAreaDelineation"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

' Copyright 1995-2004 ESRI

' All rights reserved under the copyright laws of the United States.

' You may freely redistribute and use this sample code, with or without modification.

' Disclaimer: THE SAMPLE CODE IS PROVIDED "AS IS" AND ANY EXPRESS OR IMPLIED 
' WARRANTIES, INCLUDING THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 
' FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL ESRI OR 
' CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, 
' OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 
' SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 
' INTERRUPTION) SUSTAINED BY YOU OR A THIRD PARTY, HOWEVER CAUSED AND ON ANY 
' THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT ARISING IN ANY 
' WAY OUT OF THE USE OF THIS SAMPLE CODE, EVEN IF ADVISED OF THE POSSIBILITY OF 
' SUCH DAMAGE.

' For additional information contact: Environmental Systems Research Institute, Inc.

' Attn: Contracts Dept.

' 380 New York Street

' Redlands, California, U.S.A. 92373 

' Email: [e-mail]

Option Explicit

Private m_pApp As IApplication

Public Sub Init(pApp As IApplication)
  Set m_pApp = pApp
End Sub

Private Sub cmdApply_Click()
  On Error GoTo EH
  
  Me.MousePointer = vbHourglass
  
  Dim dLength As Double
  dLength = CDbl(txtEdgeLength.Text)
  
  Dim pTinAdv As ITinAdvanced
  Set pTinAdv = miscUtil.GetCurrentSurface(m_pApp)
  
  Dim pTinEdit As ITinEdit
  Set pTinEdit = pTinAdv
  
  pTinEdit.StartEditing
  
  Dim pEdgeEnum As IEnumTinEdge
  Set pEdgeEnum = pTinAdv.MakeEdgeEnumerator(pTinAdv.FullExtent, esriTinSingleEdge + esriTinAll, Nothing)

  Dim pEdge As ITinEdge
  Set pEdge = New TinEdge
  
  pEdgeEnum.QueryNext pEdge
      
  Do While (Not pEdge.IsEmpty)
    If (pEdge.Length > dLength) Then
      Dim pTriangle As ITinTriangle
      Set pTriangle = pEdge.LeftTriangle
      If (Not pTriangle Is Nothing) Then ' will be nothing if edge on perimeter
        pTinEdit.SetTriangleOutsideDataArea pTriangle.index
      End If
      Set pTriangle = pEdge.RightTriangle
      If (Not pTriangle Is Nothing) Then
        pTinEdit.SetTriangleOutsideDataArea pTriangle.index
      End If
    End If
    pEdgeEnum.QueryNext pEdge
  Loop
  
  Me.MousePointer = vbDefault
  
  miscUtil.RedrawLayer m_pApp, miscUtil.GetCurrentSurfaceLayer(m_pApp)
      
  Exit Sub
EH:
  Me.MousePointer = vbDefault
  MsgBox Err.Description, vbCritical, Err.Source
End Sub

Private Sub Form_Load()
  On Error GoTo EH
  
  Me.Icon = Nothing
  txtEdgeLength.Text = ""
      
  win32Util.FloatWindow Me, True
  
  Exit Sub
EH:
  MsgBox Err.Description, Err.Source
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Set m_pApp = Nothing
End Sub