阅读:2290回复:2
有关裁切后的图层保存问题!
<P>兄弟我在做裁切的时候,想将裁切后的得到的图层保存到MDB中去(也就是Personal Geodatabase),但怎么试也不成功,如果是保存成SHAPE格式就没有什么问题。现将我的部分代码贴到下面,希望兄弟们能给指点一下!这个例子帮助中是有的,我只是略微改动了一下。</P>
<P>代码如下:</P> <P>Public Function CutVecByShp(Player As IFeatureLayer, ByVal sPath As String, _ ByVal sShapeName As String) As IFeatureLayer</P> <P> Dim pInputFeatLayer As IFeatureLayer Set pInputFeatLayer = Player Dim pInputTable As ITable Set pInputTable = Player Dim pInputFeatClass As IFeatureClass Set pInputFeatClass = pInputFeatLayer.FeatureClass ' Get the input feature class. ' Use the Itable interface from the Layer (not from the FeatureClass) ' The Input feature class properties, such as shape type, ' will be needed for the output. ' Get the clip/overlay layer ' Use the Itable interface from the Layer (not from the FeatureClass) Dim sFeatureLayer As IFeatureLayer Set sFeatureLayer = New FeatureLayer Set sFeatureLayer.FeatureClass = OpenShapeFile(sPath, sShapeName) Dim pClipTable As ITable Set pClipTable = sFeatureLayer ' Error checking If pInputTable Is Nothing Then MsgBox "Table QI failed" Exit Function End If If pClipTable Is Nothing Then MsgBox "Table QI failed" Exit Function End If '***************保存为SHAPE时执行Clip方法时不出现问题********************* ' Define the output feature class name and shape type (taken from the ' properties of the input feature class) Dim pFeatClassName As IFeatureClassName Set pFeatClassName = New FeatureClassName With pFeatClassName .FeatureType = esriFTSimple .ShapeFieldName = "Shape" .ShapeType = pInputFeatClass.ShapeType End With ' Set output location and feature class name Dim pNewWSName As IWorkspaceName Set pNewWSName = New WorkspaceName pNewWSName.WorkspaceFactoryProgID = "esriDataSourcesFile.ShapeFileWorkspaceFactory.1" pNewWSName.PathName = App.path ; "\temp" Dim pDatasetName As IDatasetName Set pDatasetName = pFeatClassName pDatasetName.Name = "Clip_result" Set pDatasetName.WorkspaceName = pNewWSName '**************************保存为Shape**************************</P> <P>'******************************保存为Geodatabase时执行到Clip则出错****************</P> <P>' ' 设置输出的路径和图层名 ' Dim pNewWSName As IWorkspaceName ' Set pNewWSName = New WorkspaceName ' pNewWSName.WorkspaceFactoryProgID = "esriDataSourcesGDB.SdeWorkspaceFactory.1" ' pNewWSName.ConnectionProperties = pPropset ' '放入Dataset ' Dim pFDatasetName As IDatasetName ' Set pFDatasetName = New FeatureDatasetName ' Set pFDatasetName.WorkspaceName = pNewWSName ' pFDatasetName.Name = "DLG_Test" ' ' ' 定义输出要素类名 ' Dim pFeatClassName As IFeatureClassName ' Set pFeatClassName = New FeatureClassName ' Set pFeatClassName.FeatureDatasetName = pFDatasetName ' ' Dim pDatasetName As IDatasetName ' Set pDatasetName = pFeatClassName ' pDatasetName.Name = pUnLyrName '*************************************************保存为Personal Geodatabase**********</P> <P> ' Set the tolerance. Passing 0.0 causes the default tolerance to be used. ' The default tolerance is 1/10,000 of the extent of the data frame's spatial domain Dim tol As Double tol = 0# ' Perform the clip Dim pBGP As IBasicGeoprocessor Set pBGP = New BasicGeoprocessor Dim pOutputFeatClass As IFeatureClass Set pOutputFeatClass = pBGP.Clip(pInputTable, False, pClipTable, False, _ tol, pFeatClassName) ' Add the output layer (clipped features) to the map Dim pOutputFeatLayer As IFeatureLayer Set pOutputFeatLayer = New FeatureLayer Set pOutputFeatLayer.FeatureClass = pOutputFeatClass pOutputFeatLayer.Name = pOutputFeatClass.AliasName Set CutVecByShp = pOutputFeatLayer</P> <P>End Function </P><img src="images/post/smile/dvbbs/em12.gif" /><img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em08.gif" /> |
|
1楼#
发布于:2008-11-30 00:45
?
|
|
2楼#
发布于:2009-08-11 10:42
<P>是不是数据库版本问题,mdb不支持多版本操作</P>
|
|