📄 缓冲区分析.frm
字号:
VERSION 5.00
Object = "{9BD6A640-CE75-11D1-AF04-204C4F4F5020}#2.0#0"; "mo20.ocx"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form 缓冲区分析
Caption = "Form1"
ClientHeight = 5535
ClientLeft = 1365
ClientTop = 2550
ClientWidth = 9645
LinkTopic = "Form1"
ScaleHeight = 5535
ScaleWidth = 9645
WindowState = 2 'Maximized
Begin VB.Frame Frame1
Caption = "缓冲区查询设置"
Height = 3975
Left = 5760
TabIndex = 2
Top = 840
Width = 2175
Begin VB.TextBox Text1
Height = 285
Left = 240
TabIndex = 7
Top = 3480
Width = 1695
End
Begin VB.ComboBox Combo1
Height = 315
Left = 240
TabIndex = 6
Text = "请选择图层"
Top = 2640
Width = 1695
End
Begin VB.OptionButton Option3
Caption = "面缓冲"
Height = 375
Left = 480
TabIndex = 5
Top = 1320
Width = 1215
End
Begin VB.OptionButton Option2
Caption = "线缓冲"
Height = 375
Left = 480
TabIndex = 4
Top = 840
Width = 1215
End
Begin VB.OptionButton Option1
Caption = "点缓冲"
Height = 255
Left = 480
TabIndex = 3
Top = 360
Width = 1335
End
Begin VB.Label Label2
Caption = "做缓冲区的图层："
Height = 255
Left = 240
TabIndex = 9
Top = 2280
Width = 1695
End
Begin VB.Label Label1
Caption = "缓冲区距离："
Height = 255
Left = 240
TabIndex = 8
Top = 3120
Width = 1695
End
End
Begin MSComctlLib.ImageList ImageList1
Left = 600
Top = 4920
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 5
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "缓冲区分析.frx":0000
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "缓冲区分析.frx":0112
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "缓冲区分析.frx":0224
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "缓冲区分析.frx":0336
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "缓冲区分析.frx":0448
Key = ""
EndProperty
EndProperty
End
Begin MSComctlLib.Toolbar Toolbar1
Align = 1 'Align Top
Height = 615
Left = 0
TabIndex = 1
Top = 0
Width = 9645
_ExtentX = 17013
_ExtentY = 1085
ButtonWidth = 820
ButtonHeight = 926
Appearance = 1
ImageList = "ImageList1"
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 5
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "放大"
Key = "zoomin"
ImageIndex = 1
EndProperty
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "缩小"
Key = "zoomout"
ImageIndex = 2
EndProperty
BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "漫游"
Key = "pan"
ImageIndex = 3
EndProperty
BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "全图"
Key = "globe"
ImageIndex = 4
EndProperty
BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "恢复"
Key = "arrwo"
ImageIndex = 5
EndProperty
EndProperty
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 120
Top = 4920
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin MapObjects2.Map Map1
Height = 4095
Left = 120
TabIndex = 0
Top = 720
Width = 4815
_Version = 131072
_ExtentX = 8493
_ExtentY = 7223
_StockProps = 225
BackColor = 16777215
BorderStyle = 1
Contents = "缓冲区分析.frx":055A
End
Begin VB.Menu mnuopenshp
Caption = "添加shp文件"
WindowList = -1 'True
End
Begin VB.Menu mnuopencov
Caption = "添加cov文件"
End
Begin VB.Menu mnuopencad
Caption = "添加cad文件"
End
End
Attribute VB_Name = "缓冲区分析"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim buffer As New MapObjects2.polygon
Dim recset As MapObjects2.Recordset
Dim pp As New MapObjects2.Point
Dim polygon1 As MapObjects2.polygon
Dim line1 As MapObjects2.Line
Dim pot As MapObjects2.Point
Dim lyr As New MapLayer
Dim i As Integer
Dim n As Integer
Private Sub Form_Resize()
Map1.Move 100, 700, 缓冲区分析.ScaleWidth - 2500, 缓冲区分析.ScaleHeight - 800
frame1.Move Map1.Width + 200
End Sub
Private Sub mnuopencad_Click()
Dim basepath As String
Dim filename As String
Dim dCon As New DataConnection
Dim gSet As GeoDataset
Dim str As String
Dim textPos As Long, periodPos As Long
Dim Test As Boolean
Dim tempChar As String
Dim fullFile As String, workspace As String, featAttTable As String
CommonDialog1.Filter = "Drawing (*.dwg)|*.dwg*|DXF (*.dxf)|*.dxf"
CommonDialog1.ShowOpen
basepath = CurDir
filename = CommonDialog1.FileTitle
If filename = "" Then
MsgBox ("You haven't select layer!")
Exit Sub
End If
fullFile = Trim$(CommonDialog1.filename)
textPos = Len(basepath)
Test = False
'This loop goes backwards through the string, searching for the
'last back slash. This marks the base path from the returned string.
Do While Test = False
textPos = textPos - 1
tempChar = Mid$(basepath, textPos, 1)
If tempChar = "." Then
periodPos = textPos
ElseIf tempChar = "\" Or textPos = 0 Then
Test = True
End If
Loop
featAttTable = Left$(filename, Len(filename))
workspace = basepath
'Also, feature attribute tables are specified by the coverage name followed
'by the feature attribute table, minus its .adf extension...
dCon.Database = "[CAD]" & workspace 'Set Database property of DataConnection
If dCon.Connect Then
Set gSet = dCon.FindGeoDataset(featAttTable) 'Find shapefile as GeoDataset in DataConnection
If gSet Is Nothing Then
MsgBox "Error opening Auto CAD files " & featAttTable
Exit Sub
Else
Dim newLayer As New MapLayer
newLayer.GeoDataset = gSet 'Set GeoDataset property of new MapLayer
newLayer.Name = featAttTable 'Set Name property of new MapLayer
' newLayer.Symbol.Color = moGreen
Map1.Layers.Add newLayer
Map1.Refresh
'Add MapLayer to Layers collection
End If
Else
'MsgBox ConnectErrorMsg(dCon.ConnectError), vbCritical, "Connection error"
End If
End Sub
Private Sub mnuopencov_Click()
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -