📄 frmtinbuildingburner.frm
字号:
VERSION 5.00
Begin VB.Form frmTinBuildingBurner
BorderStyle = 3 'Fixed Dialog
Caption = "Add Buildings to TIN"
ClientHeight = 7110
ClientLeft = 45
ClientTop = 330
ClientWidth = 4680
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 7110
ScaleWidth = 4680
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows Default
Begin VB.CheckBox chkDeleteNodes
Caption = "Delete internal nodes"
Height = 195
Left = 360
TabIndex = 31
Top = 6720
Visible = 0 'False
Width = 1935
End
Begin VB.Frame Frame5
Caption = "Footprints and topprints"
Height = 1092
Left = 120
TabIndex = 25
Top = 2280
Width = 4452
Begin VB.ComboBox cboBldgID
Height = 288
Left = 2160
TabIndex = 28
Text = "cboBldgID"
Top = 720
Width = 2172
End
Begin VB.CheckBox chkTopprints
Caption = "Input feature class contains multiple polygons per building (includes footprints and topprints)"
Height = 372
Left = 120
TabIndex = 26
Top = 240
Width = 4212
End
Begin VB.Label Label7
Caption = "Building ID field:"
Height = 252
Left = 360
TabIndex = 27
Top = 760
Width = 1332
End
End
Begin VB.TextBox txtOutName
Height = 315
Left = 360
TabIndex = 22
Top = 6360
Width = 4215
End
Begin VB.OptionButton radSaveNew
Caption = "Save changes into a new output TIN:"
Height = 195
Left = 120
TabIndex = 21
Top = 6120
Value = -1 'True
Width = 3855
End
Begin VB.OptionButton radSaveOld
Caption = "Save changes into the input TIN specified above"
Height = 255
Left = 120
TabIndex = 20
Top = 5880
Width = 4095
End
Begin VB.Frame Frame4
Caption = "Rooftop buffer"
Height = 735
Left = 120
TabIndex = 17
Top = 4200
Width = 4455
Begin VB.TextBox txtBuffer
Height = 315
Left = 2760
TabIndex = 19
Text = "0.5"
Top = 240
Width = 615
End
Begin VB.Label Label4
Caption = "Buffer distance to calculate rooftop:"
Height = 255
Left = 120
TabIndex = 18
Top = 280
Width = 2655
End
End
Begin VB.Frame Frame2
Caption = "Apply height"
Height = 855
Left = 120
TabIndex = 11
Top = 3360
Width = 4455
Begin VB.TextBox txtConstOffset
Height = 285
Left = 3000
TabIndex = 12
Text = "ihoihoihoihoihoih"
Top = 960
Width = 1335
End
Begin VB.OptionButton radHeightAbs
Caption = "as absolute elevation above sea level"
Height = 195
Left = 120
TabIndex = 14
Top = 240
Value = -1 'True
Width = 3135
End
Begin VB.OptionButton radHeightRel
Caption = "by adding it to footprint height"
Height = 195
Left = 120
TabIndex = 13
Top = 480
Width = 3015
End
End
Begin VB.Frame Frame1
Caption = "Height information"
Height = 1455
Left = 120
TabIndex = 6
Top = 840
Width = 4455
Begin VB.ComboBox cboZFactor
Height = 315
Left = 2160
TabIndex = 24
Text = "cboZFactor"
Top = 960
Width = 2175
End
Begin VB.ComboBox cboElevFields
Height = 315
Left = 2160
Style = 2 'Dropdown List
TabIndex = 10
Top = 600
Width = 2175
End
Begin VB.TextBox txtHeight
Height = 315
Left = 2160
TabIndex = 9
Text = "10.0"
Top = 240
Width = 1095
End
Begin VB.OptionButton radAttribHeight
Caption = "Height from attribute:"
Height = 255
Left = 120
TabIndex = 8
Top = 640
Width = 1935
End
Begin VB.OptionButton radConstHeight
Caption = "Constant height:"
Height = 255
Left = 120
TabIndex = 7
Top = 280
Value = -1 'True
Width = 1455
End
Begin VB.Label Label6
Caption = "Z unit conversion factor:"
Height = 255
Left = 140
TabIndex = 23
Top = 1020
Width = 1815
End
End
Begin VB.CommandButton cmdCancel
Caption = "Cancel"
Height = 315
Left = 3600
TabIndex = 5
Top = 6720
Width = 975
End
Begin VB.CommandButton cmdOK
Caption = "OK"
Height = 315
Left = 2640
TabIndex = 4
Top = 6720
Width = 855
End
Begin VB.ComboBox cboInputPoly
Height = 315
Left = 1320
Style = 2 'Dropdown List
TabIndex = 3
Top = 480
Width = 3255
End
Begin VB.ComboBox cboInputTin
Height = 315
Left = 1320
Style = 2 'Dropdown List
TabIndex = 2
Top = 120
Width = 3255
End
Begin VB.Frame Frame3
Caption = "Tag values"
Height = 852
Left = 120
TabIndex = 15
Top = 4920
Width = 4455
Begin VB.ComboBox cboTagFields
Height = 288
Left = 2160
TabIndex = 30
Text = "cboTagFields"
Top = 480
Width = 2172
End
Begin VB.CheckBox chkTags
Caption = "Assign tag values to TIN triangles for walls and roofs"
Height = 195
Left = 120
TabIndex = 16
Top = 240
Width = 4095
End
Begin VB.Label Label3
Caption = "Tag ID field:"
Height = 252
Left = 360
TabIndex = 29
Top = 480
Width = 972
End
End
Begin VB.Label Label2
Caption = "Input polygons:"
Height = 255
Left = 120
TabIndex = 1
Top = 500
Width = 1215
End
Begin VB.Label Label1
Caption = "Input TIN:"
Height = 255
Left = 120
TabIndex = 0
Top = 180
Width = 735
End
End
Attribute VB_Name = "frmTinBuildingBurner"
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
Private m_pMap As IBasicMap
Private m_pInputTin As ITinAdvanced
Private m_pInFClass As IFeatureClass
Public Sub Init(pApp As IApplication)
Set m_pApp = pApp
If (TypeOf pApp Is IMxApplication) Then
Dim pMxDoc As IMxDocument
Set pMxDoc = pApp.Document
Set m_pMap = pMxDoc.FocusMap
ElseIf (TypeOf pApp Is ISxApplication) Then
Dim pSxDoc As ISxDocument
Set pSxDoc = pApp.Document
Set m_pMap = pSxDoc.Scene
End If
End Sub
Private Sub cboBldgID_GotFocus()
chkTopprints.Value = vbChecked
End Sub
Private Sub cboElevFields_GotFocus()
radAttribHeight.Value = True
End Sub
Private Sub cboInputPoly_Click()
SetInputPoly
End Sub
Private Sub cboInputTin_Click()
SetInputTin
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdOK_Click()
On Error GoTo EH
If (Not ValidateInputs) Then
Exit Sub
End If
Me.MousePointer = vbHourglass
Dim pFlayer As IFeatureLayer
Set pFlayer = m_pMap.Layer(cboInputPoly.ItemData(cboInputPoly.ListIndex))
Dim pInFClass As IFeatureClass
Set pInFClass = pFlayer.FeatureClass
Dim pTinLayer As ITinLayer
Set pTinLayer = m_pMap.Layer(cboInputTin.ItemData(cboInputTin.ListIndex))
Dim pDS As IDataset
Set pDS = pTinLayer.Dataset
Dim sName As String
sName = dbUtil.GetUniqueFileName(pDS.Workspace.PathName, , "_tin")
Dim pTinEdit As ITinEdit
Set pTinEdit = pDS.Copy(sName, pDS.Workspace)
Dim pSurf As ITinSurface
Set pSurf = pTinEdit
' Height unit conversion support
Dim dZFact As Double
dZFact = 1
If (cboZFactor.ListIndex = 1) Then
dZFact = 0.3048
ElseIf (cboZFactor.ListIndex = 2) Then
dZFact = 3.281
ElseIf (cboZFactor.ListIndex = -1) Then
dZFact = CDbl(cboZFactor)
End If
Dim pGDS As IGeoDataset
Set pGDS = pTinEdit
Dim pTinSR As ISpatialReference2
Set pTinSR = pGDS.SpatialReference
If (pTinEdit.StartEditing) Then
Dim pInCursor As IFeatureCursor
Dim lFeatureCount As Long
' TODO - when using topprints all input features are processed whereas with no
' topprints feature selection can restrict what gets used. It should work the
' same for both.
If (chkTopprints.Value = 1) Then
' sort with building id field as primary and elevation field as secondary
Dim pTableSort As ITableSort
Set pTableSort = New TableSort
Set pTableSort.Table = pInFClass
Dim sFields As String
sFields = cboBldgID.Text & ", " & cboElevFields.Text
pTableSort.Fields = sFields
pTableSort.Sort Nothing
Dim pQF As IQueryFilter2
Set pQF = New QueryFilter
'pQF.SubFields = "Shape, " & cboElevFields & ", " & cboTagFields
pQF.SubFields = "*"
Set pTableSort.QueryFilter = pQF
Set pInCursor = pTableSort.Rows
lFeatureCount = pInFClass.FeatureCount(Nothing)
Else
Set pInCursor = MiscUtil.GetFeatureLayerSelection(pFlayer, True, lFeatureCount)
If (pInCursor Is Nothing) Then ' no selection
Set pQF = New QueryFilter
'pQF.SubFields = "Shape, " & cboElevFields & ", " & cboTagFields
pQF.SubFields = "*"
Set pInCursor = pInFClass.Search(pQF, True)
lFeatureCount = pInFClass.FeatureCount(Nothing)
End If
End If
Dim pInFeature As IFeature
Set pInFeature = pInCursor.NextFeature
Dim lInxHeightField As Long
lInxHeightField = cboElevFields.ItemData(cboElevFields.ListIndex)
Dim lInxTagField As Long
lInxTagField = cboTagFields.ItemData(cboTagFields.ListIndex)
Dim lInxOIDField As Long
lInxOIDField = pInFClass.FindField(pInFClass.OIDFieldName)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -