dialog.frm

有关ＶＢ在GIS空间分析方面的应用 深入详解代码大家在这方面多交流啊

VERSION 5.00
Begin VB.Form Dialog 
   Caption         =   "输入缓冲区半径"
   ClientHeight    =   915
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   4680
   LinkTopic       =   "Form2"
   ScaleHeight     =   915
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton OKButton 
      Caption         =   "确定"
      Height          =   495
      Left            =   3120
      TabIndex        =   1
      Top             =   240
      Width           =   1455
   End
   Begin VB.TextBox Text1 
      Height          =   735
      Left            =   240
      TabIndex        =   0
      Top             =   120
      Width           =   2655
   End
End
Attribute VB_Name = "Dialog"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub OKButton_Click()
  Dim dis As Double
 dis = Text1.Text
Dim str As String
Dim featurelayer As IFeatureLayer
Dim i As Integer
For i = 0 To Form1.MapControl1.LayerCount - 1
    If Form1.MapControl1.Layer(i).Name = "channel" Then
        Set featurelayer = Form1.MapControl1.Layer(i)
    End If
Next i
If featurelayer Is Nothing Then
    MsgBox "没有channel图层。"
    Exit Sub
    Unload Me
End If
str = "c:\temp"  'book_fuzhongl
If Not Dir$("c:\temp\Buffer.shp") = "" Then
   Kill "C:\temp\Buffer.*"
End If
CreateShapefile str, "Buffer", featureclass
Dim p_Map As IMap
Dim length As Double
Set p_Map = Form1.MapControl1.Map
length = ConvertPixelsToMapUnits(p_Map, 8)
 Dim pFilter As IQueryFilter
  Dim pCursor As IFeatureCursor
  Set pCursor = featurelayer.Search(pFilter, True)
  Dim pGeo As IGeometry
  Dim pTopoOp As ITopologicalOperator
  Dim pfeature As IFeature
  Set pfeature = pCursor.NextFeature
  While Not pfeature Is Nothing
   Set pTopoOp = pfeature.Shape
   Set pGeo = pTopoOp.Buffer(length)
   CreateFeature featureclass, pGeo
  Set pfeature = pCursor.NextFeature
  Wend
Dim pClipFeatureLayer As IFeatureLayer
    Set pClipFeatureLayer = New featurelayer
    Set pClipFeatureLayer.featureclass = featureclass
    pClipFeatureLayer.Name = featureclass.AliasName
    Form1.MapControl1.AddLayer pClipFeatureLayer, i
   Form1.MapControl1.Refresh
   Unload Me

End Sub