gis二次开发编程语言

变量与常量的应用

实验一：VBA中变量及Inputbox的应用 实验目的：熟悉掌握Inputbox的实例编程 Option Explicit Sub test()

Dim M As String Dim N As String

M = InputBox(\请输入用户名:\ N = InputBox(\请输入密码:\

MsgBox \您输入的用户名是:\ \您输入的密码是: \ End Sub

实验二：VBA中数组的定义和使用

实验目的：掌握VBA中的数组如何定义和使用以及单引号( ') ,rem的作用等 例如： 求1——100所有整数的和

Sub arr()

Dim i As Integer '定义一个整形变量i Dim sum As Integer

Rem 定义一个整形变量sum Dim arr1(1 To 100) As Integer For i = 1 To 100 arr1(i) = i

sum = sum + arr1(i) Next

MsgBox \您输入的用户名是：\End Sub

实验三：VBA 中的判断语句

实验目的：熟悉掌握If…Then…Else语句和循环语句的使用 （1）Sub pandduan() Dim cj As Integer 'cj表示成绩的变量

cj = InputBox(\请输入一个学生的成绩：\ If cj >= 60 Then MsgBox \您的成绩及格\ Else

MsgBox \您输入的成绩不及格\ End If End Sub

(2) Sub chj()

Dim cj As Integer

cj = InputBox(\请输入一个学生的成绩:\ If cj > 90 Then MsgBox \

ElseIf cj > 80 And cj < 90 Then MsgBox \

ElseIf cj > 70 And cj < 80 Then MsgBox \

ElseIf cj > 60 And cj < 70 Then MsgBox \ Else

MsgBox \ End If End Sub

(3) Sub selec()

Dim cj As Integer

cj = InputBox(\请输入一个学生的成绩:\ Select Case cj \\ 10 Case 9

MsgBox \ Case 8

MsgBox \ Case 7

MsgBox \ Case 6

MsgBox \ Case Else

MsgBox \ End Select End Sub

实验四：VBA中循环语句的应用

实验目的：学会应用For Next 或For Each…Next语句 来编写循 环语句 例如：（1）For Next 语句的应用 求1——100所有整数的和

Sub forne()

Dim i As Integer Dim sum As Integer sum = 0

For i = 1 To 100 sum = sum + i Next i

MsgBox sum End Sub

（2）For Each…Next语句的应用

Sub foreach()

Dim arr(5) As Integer Dim i As Integer Dim arr01

For i = 0 To 5 arr(i) = i Next i

For Each arr01 In arr MsgBox arr01

Next End Sub

（3）Do…loop语句的应用 Sub doloop()

Dim arr(5) As Integer Dim i As Integer Dim n As Integer n = 0 i = 0

Do While i < 5 arr(i) = i i = i + 1 n = n + 1 Loop

MsgBox \程序执行的次数是：\ End Sub

（4）while…wend语句应用 Sub whilewd()

Dim arr(5) As Integer Dim i As Integer Dim n As Integer n = 0 i = 0 While i <= 5 arr(i) = i i = i + 1 n = n + 1 Wend

MsgBox \程序执行的次数是：\ End Sub

（4）根据用户选择的工具，显示不同的上下文菜单。先定义一个模块级变量，在工具选择事件中，对变量进行赋值。 Dim ContextMenu As String Private Sub myTool_Select() ContextMenu = \ End Sub

Private Sub myTool2_Select() ContextMenu = \ End Sub

Private Function MxDocument_OnContextMenu (ByVal x As Long, ByVal y As Long) As Boolean Dim pMenu As ICommandBar Select Case ContextMenu Case \

Set pMenu = ThisDocument.CommandBars.Create (\ pMenu.Add arcid.File_AddData pMenu.Add arcid.File_Export pMenu.Add arcid.File_Print pMenu.Popup

MxDocument_OnContextMenu = True

Case \

Set pMenu = ThisDocument.CommandBars.Create (\ pMenu.Add arcid.File_Exit pMenu.Add arcid.File_New

pMenu.Add arcid.File_LabelCache pMenu.Popup

MxDocument_OnContextMenu = True Case Else

MxDocument_OnContextMenu = False End Select End Function

数据集和图层管理 实验一：将数据集添加为图层

实验目的：知道地理数据集包括shapefile、coverage、geodatabase要素类及栅格数据而非地理数据集包括图层文件和dBase表；并且能够熟悉掌握AddFeatureClass的应用及其功能： （1）以下是AddFeatureClass在当前地图上添加一个shapefile要素类：

Sub AddFeatureClass()

Dim pMxDoc As IMxDocument Dim pMap As IMap

Dim pWorkspaceFactory As IWorkspaceFactory Dim pFeatureWorkspace As IFeatureWorkspace Dim pFeatureLayer As IFeatureLayer Dim pFeatureClass As IFeatureClass

' Specify the workspace and the feature class.

Set pWorkspaceFactory = New ShapefileWorkspaceFactory

Set pFeatureWorkspace = pWorkspaceFactory.OpenFromFile (\

Set pFeatureClass = pFeatureWorkspace.OpenFeatureClass (\

' Prepare a feature layer.

Set pFeatureLayer = New FeatureLayer

Set pFeatureLayer.FeatureClass = pFeatureClass

pFeatureLayer.Name = pFeatureLayer.FeatureClass.AliasName ' Add the feature layer to the active map. Set pMxDoc = ThisDocument Set pMap = pMxDoc.FocusMap pMap.AddLayer pFeatureLayer ' Refresh the active view. pMxDoc.ActiveView.Refresh End Sub

以下是用按钮直接调用以上命令的语句： Private Sub UIButtonControl1_Click()

Project.AddFeatureClass.AddFeatureClass End Sub

（2）用AddFeatureClass添加shapefile数据集: Public Sub AddFeatureClasses01() ' Part 1: Prepare an Add Data dialog. Dim pGxDialog As IGxDialog Dim pGxFilter As IGxObjectFilter Set pGxDialog = New GxDialog

Set pGxFilter = New GxFilterShapefiles ' Define the dialog's properties. With pGxDialog

.AllowMultiSelect = True .ButtonCaption = \添加数据\ Set .ObjectFilter = pGxFilter .StartingLocation = \ .Title = \添加矢量格式的数据\ End With

' Part 2: Get the datasets from the dialog and add them to the active map.

Dim pGxObjects As IEnumGxObject Dim pMxDoc As IMxDocument Dim pMap As IMap

Dim pGxDataset As IGxDataset Dim pLayer As IFeatureLayer Set pMxDoc = ThisDocument Set pMap = pMxDoc.FocusMap ' Open the dialog.

pGxDialog.DoModalOpen 0, pGxObjects Set pGxDataset = pGxObjects.Next ' Exit sub if no dataset has been added. If pGxDataset Is Nothing Then Exit Sub End If

' Step through the datasets and add them as layers to the active map.

Do Until pGxDataset Is Nothing

Set pLayer = New FeatureLayer

Set pLayer.FeatureClass = pGxDataset.Dataset pLayer.Name = pLayer.FeatureClass.AliasName pMap.AddLayer pLayer

Set pGxDataset = pGxObjects.Next Loop

' Refresh the map and update the table of contents. pMxDoc.ActivatedView.Refresh

pMxDoc.UpdateContents End Sub

(3) AddFeatureClass在当前地图上添加一个coverage数据集: Sub AddCoverage()

Dim pMxDoc As IMxDocument Dim pMap As IMap

Dim pWorkspaceFactory As IWorkspaceFactory Dim pFeatureWorkspace As IFeatureWorkspace Dim pFeatureLayer As IFeatureLayer Dim pFeatureClass As IFeatureClass

' Specify the workspace and the feature class.

Set pWorkspaceFactory = New ArcInfoWorkspaceFactory

Set pFeatureWorkspace = pWorkspaceFactory.OpenFromFile (\

Set pFeatureClass = pFeatureWorkspace.OpenFeatureClass (\

' Prepare a feature layer.

Set pFeatureLayer = New FeatureLayer

Set pFeatureLayer.FeatureClass = pFeatureClass

pFeatureLayer.Name = pFeatureLayer.FeatureClass.AliasName ' Add the feature layer to the active map. Set pMxDoc = ThisDocument Set pMap = pMxDoc.FocusMap pMap.AddLayer pFeatureLayer ' Refresh the active view.

pMxDoc.ActiveView.Refresh End Sub

(4) AddFeatureClass在当前地图上添加一个Raster: Public Sub AddRaster01()

Dim pMxDoc As IMxDocument Dim pMap As IMap

Dim pWorkspaceFactory As IWorkspaceFactory Dim pRasterWorkspace As IRasterWorkspace Dim pRasterDS As IRasterDataset Dim pRasterLayer As IRasterLayer

' Specify the workspace and teh raster dataset.

Set pWorkspaceFactory = New RasterWorkspaceFactory

Set pRasterWorkspace = pWorkspaceFactory.OpenFromFile (\

Set pRasterDS = pRasterWorkspace.OpenRasterDataset (\

' Prepare a raster layer.

Set pRasterLayer = New RasterLayer

pRasterLayer.CreateFromDataset pRasterDS ' Add the raster layer to the active map. Set pMxDoc = ThisDocument Set pMap = pMxDoc.FocusMap pMap.AddLayer pRasterLayer pMxDoc.ActiveView.Refresh End Sub

(5) AddFeatureClass在当前地图上添加一个table:

Public Sub AddTable()

' Part 1: Define the input table.

Dim pWSName As IWorkspaceName Dim pDatasetName As IDatasetName Dim pName As IName

本文来源：https://www.bwwdw.com/article/pypf.html