?? tindataareadelineation.frm
字號:
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: contracts@esri.com
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
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -