arcmap自动生成矢量图层的方法
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
*****大学学生实验报告
学院地环学院专业地理信息系统年级、班 08地信学号 **** 姓名 *** 同组者
课程名称 GIS设计与实现实验题目生成矢量数据成绩
一、实验目的：
熟练掌握Shapefile格式数据的创建。
二、实验准备：
了解Shapefile文件类型及属性表格式；熟悉VBA编程环境；掌握创建Shapefile文件所用到的类：WorkSpaceFactory、WorkSpace、Fields、Field、GeometryDef。
三、实验内容：
（1）利用ArcMap提供的Customize功能创建三个按钮，名称分别为CreatePoint、CreateLine和CreatePolygon；（2）在VBA环境下编写宏，实现创建点图层、线图层和多边形图层，要求①每个图层属性表均包含FID、Shape、Name（String, 10）和Code（String, 10）四个字段；②图层名和路径均由用户输入；③单击按钮后，自动将创建好的图层添加到ArcMap 当前窗口；（3）在高级编程语言环境下（如.net, VB6.0），实现上述功能，并编译成DLL文件发布。
四、实验过程及步骤：
（包括程序界面设计、控件属性说明、程序代码和程序运行四部分）
UIControl 空间分四类，如上图所示，此时我们新建UIButtonControl命令，点击创建后会在命令列表中自动新建命令按钮，此刻我们将命令按钮更改名称，如下图所示：
通过工具Æ订制Æ然后将新建的命令添加到自己订制的工具条中，如下图所示：
代码的编写，在订制才当中双击新建命令按钮编写如下代码
Private Sub createline_Click()
Dim wsf As IWorkspaceFactory
Set wsf = New ShapefileWorkspaceFactory
Dim wsn As IWorkspaceName
Dim ro As String
ro = InputBox("请输入路径", "", "D:\AO")
Set wsn = wsf.Create(ro, "POINT", Nothing, 0)
Dim pN As IName
Set pN = wsn
Dim ws As IFeatureWorkspace
Set ws = pN.Open
Dim fs As IFields
Set fs = New Fields
Dim fse As IFieldsEdit
Set fse = fs
Dim f1 As IField
Set f1 = New Field
Dim fe1 As IFieldEdit
Set fe1 = f1
With fe1
.Name = "FID"
.Type = esriFieldTypeOID
.Length = 4
End With
fse.AddField f1
Dim f2 As IField
Set f2 = New Field
Dim fe2 As IFieldEdit
Set fe2 = f2
With fe2
.Name = "shape"
.Type = esriFieldTypeGeometry
End With
Dim geod As IGeometryDef
Set geod = New GeometryDef
Dim geode As IGeometryDefEdit
Set geode = geod
geode.GeometryType = esriGeometryLine
Set geode.SpatialReference = New UnknownCoordinateSystem Set fe2.GeometryDef = geod
fse.AddField f2
Dim f3 As IField
Set f3 = New Field
Dim fe3 As IFieldEdit
Set fe3 = f3
With fe3
.Name = "name"
.Type = esriFieldTypeString
.Length = 10
End With
fse.AddField f3
Dim f4 As IField
Set f4 = New Field
Dim fe4 As IFieldEdit
Set fe4 = f4
With fe4
.Name = "code"
.Type = esriFieldTypeString
.Length = 10
End With
fse.AddField f4
Dim t As ITable
Dim na As String
na = InputBox("请输入名称", "", "Line")
Set t = ws.CreateTable(na, fs, Nothing, Nothing, "") ‘一下是自动弹添加到arcmap中的程序
Dim wf As IWorkspaceFactory
Set wf = New ShapefileWorkspaceFactory
Dim wso As IFeatureWorkspace
Set wso = wf.OpenFromFile(ro, 0)
Dim sp As IFeatureClass
Set sp = ws.OpenFeatureClass(na)