复制要素类
本文提供的两个函数功能是依据一个已经存在的要素类（普通几何要素类或标注要素类）和需要保存的个人geodatabase路径，在目标Workspace中产生一个和源要素类相同的新要素类。
'根据传入的PGB路径和文件名产生一个PGD的工作空间，用于存储裁减后的要素类
Function createWS(ByVal FilePath As String, ByVal File As String) As IFeatureWorkspace
Dim pAccessWorkspaceFactory As IWorkspaceFactory
Set pAccessWorkspaceFactory = New AccessWorkspaceFactory
Dim pWorkspaceName As IWorkspaceName
Set pWorkspaceName = pAccessWorkspaceFactory.Create(FilePath, File, Nothing, 0)
Dim pName As IName
Set pName = pWorkspaceName
Dim pWS As IWorkspace
Set pWS = pName.Open
Dim pFWS As IFeatureWorkspace
Set pFWS = pWS
Set createWS = pFWS
End Function
'在传入的工作空间中复制传入的要素类
Public Function CopyFeatureClass(ByVal pInFeatureClass As IFeatureClass, ByVal pSaveFeatWorkSpace As IFeatureWorkspace) As IFeatureClass
Dim pSaveFeatureClass As IFeatureClass
If pInFeatureClass.FeatureType = esriFTAnnotation Then
'如果要复制的是Annotation要素类
Dim pFWSAnno As IFeatureWorkspaceAnno
Set pFWSAnno = pSaveFeatWorkSpace
Dim pAnnoClass As IAnnoClass
Set pAnnoClass = pInFeatureClass.Extension
Dim pGLS As IGraphicsLayerScale
Set pGLS = New GraphicsLayerScale
pGLS.ReferenceScale = pAnnoClass.ReferenceScale
pGLS.Units = pAnnoClass.ReferenceScaleUnits
'复制一个相同的Annotation要素类
Set pSaveFeatureClass = pFWSAnno.CreateAnnotationClass("Clip_" + pInFeatureClass.AliasName, pInFeatureClass.Fields, pInFeatureClass.CLSID, pInFeatureClass.EXTCLSID, pInFeatureClass.ShapeFieldName, "", Nothing, Nothing, pAnnoClass.AnnoProperties, pGLS, pAnnoClass.SymbolCollection, True)
Else
'复制的是普通要素类
Set pSaveFeatureClass = pSaveFeatWorkSpace.CreateFeatureClass("Clip_" + pInFeatureClass.AliasName, pInFeatureClass.Fields, pInFeatureClass.CLSID, pInFeatureClass.EXTCLSID, pInFeatureClass.FeatureType, pInFeatureClass.ShapeFieldName, "")
End If
If Not pSaveFeatureClass Is Nothing Then
Set CopyFeatureClass = pSaveFeatureClass
End If
End Function
Related Items
Comments
Leave a comment
Or, take a look at Archives and Categories
