当前位置:甜馍馍地理信息网 >> 地理信息系统GIS >> 产品教程 >> 正文 >>  [阅读资讯:ArcMap中如何加载Shape文件[附代码]]

ArcMap中如何加载Shape文件[附代码]

[ 来源:互联网 | 时间:2007年09月15日 | 收藏本文 ] 【

如何加载Shape文件[附代码]:

本例实现的是在ArcMap中连接指定的Shape文件,并将其加载到当前激活的Map中。

l   要点

通过FeatureLayer类实现IFeatureLayer接口对象,设置IFeatureLayer.FeatureClass属性和Name属性,使用IMap.AddLayer方法将新层添加到当前地图。利用IWorkspaceFacktory接口、IFeatureWorkspace接口和IFeatureLayer接口实现连接Shape文件

l   程序说明

函数OpenShapeFile根据输入的Shape文件路径sFilePath,将文件名为sFileName的Shape文件连接到当前激活的Map中去。

l   代码 Private Sub OpenShapeFile(ByVal sFilePath As String, ByVal sFileName As String)

    Dim pWorkspaceFactory       As IWorkspaceFactory
    Dim pFeatureWorkspace       As IFeatureWorkspace
    Dim pFeatureLayer           As IFeatureLayer
    Dim pMxDocument             As IMxDocument
    Dim pMap                    As IMap
    Dim sDir                    As String    

On Error GoTo ErrorHandler:

    sDir = Dir(sFilePath & "\" & sFileName & ".shp")
    If (sDir = "") Then
        sDir = Dir(sFilePath & "\" & sFileName)
        If (sDir = "") Then
            MsgBox ("文件不存在")
            Exit Sub
        End If
    End If

    'Create a new ShapefileWorkspaceFactory object and open a shapefile folder
    Set pWorkspaceFactory = New ShapefileWorkspaceFactory
    Set pFeatureWorkspace = pWorkspaceFactory.OpenFromFile(sFilePath, 0)

    'Create a new FeatureLayer and assign a shapefile to it
    Set pFeatureLayer = New FeatureLayer
    Set pFeatureLayer.FeatureClass = pFeatureWorkspace.OpenFeatureClass(sFileName)
    pFeatureLayer.Name = pFeatureLayer.FeatureClass.AliasName

    'Add the FeatureLayer to the focus map
    Set pMxDocument = Application.Document
    Set pMap = pMxDocument.FocusMap
    pMap.AddLayer pFeatureLayer

    Exit Sub

ErrorHandler:
    MsgBox Err.Description

End Sub

Private Sub UIButtonControl1_Click()

    Dim pVBProject              As VBProject

On Error GoTo ErrorHandler:

    Set pVBProject = ThisDocument.VBProject
    OpenShapeFile pVBProject.FileName & "\..\..\..\.." & "\data\", "Continents"

    Exit Sub

ErrorHandler:
    MsgBox Err.Description

End Sub

【推荐本文】 【打印本页】 【返回顶部
最新文章
推荐文章