wavvylia
路人甲
路人甲
  • 注册日期2003-07-28
  • 发帖数384
  • QQ
  • 铜币555枚
  • 威望0点
  • 贡献值0点
  • 银元0个
阅读:3076回复:7

如何将所画多边形保存为Shape文件

楼主#
更多 发布于:2004-10-11 14:36
<P>我用鼠标画出一些多边形,想将之存为Shape文件,但不知怎么去做,那个兄弟给个思路?多谢了!</P>
<P>所画多边形如图所示:</P>

喜欢0 评分0
gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15945
  • QQ554730525
  • 铜币25337枚
  • 威望15352点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
1楼#
发布于:2004-10-12 15:48
<P>SaveToFile Method (esriCatalog)</P><P>    </P><P>Saves the graph to a file. </P><P>Syntax</P><P>object.SaveToFile (FileName )</P><P>The SaveToFile method syntax has the following object qualifier and arguments:</P><P>Part Description
object An object expression that evaluates to an object in the Applies To list.
FileName Required. A string expression that represents the FileName. </P><P>Product Availability</P><P>Available with ArcGIS Desktop.</P>
举报 回复(0) 喜欢(0)     评分
zhousky
论坛版主
论坛版主
  • 注册日期2003-08-01
  • 发帖数281
  • QQ
  • 铜币1027枚
  • 威望3点
  • 贡献值0点
  • 银元0个
2楼#
发布于:2004-10-13 09:57
哈哈,我是APRIL,在ARCENGINE中也可以用这个方法的.
不要看我噢
举报 回复(0) 喜欢(0)     评分
gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15945
  • QQ554730525
  • 铜币25337枚
  • 威望15352点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
3楼#
发布于:2004-10-13 10:20
那多多来支持了
举报 回复(0) 喜欢(0)     评分
wavvylia
路人甲
路人甲
  • 注册日期2003-07-28
  • 发帖数384
  • QQ
  • 铜币555枚
  • 威望0点
  • 贡献值0点
  • 银元0个
4楼#
发布于:2004-10-14 14:11
<P>我的本意是生成Polygon Shape后,用它进行裁切的。现在做出来了,我将代码贴上,希望对大家能所帮助:</P><P>1、创建Shape文件</P><P>Public Function CreateShapefile(sPath As String, sName As String, sSpatial As ISpatialReference) As IFeatureClass  ' Dont include .shp extension
  
   ' Open the folder to contain the shapefile as a workspace
   Dim pFWS As IFeatureWorkspace
   Dim pWorkspaceFactory As IWorkspaceFactory
   Set pWorkspaceFactory = New ShapefileWorkspaceFactory
   Set pFWS = pWorkspaceFactory.OpenFromFile(sPath, 0)
  
   ' Set up a simple fields collection
   Dim pFields As IFields
   Dim pFieldsEdit As IFieldsEdit
   Set pFields = New Fields
   Set pFieldsEdit = pFields
  
   Dim pField As IField
   Dim pFieldEdit As IFieldEdit
  
   ' Make the shape field
   ' it will need a geometry definition, with a spatial reference
   Set pField = New Field
   Set pFieldEdit = pField
   pFieldEdit.Name = "Shape"
   pFieldEdit.Type = esriFieldTypeGeometry
  
   Dim pGeomDef As IGeometryDef
   Dim pGeomDefEdit As IGeometryDefEdit
   Set pGeomDef = New GeometryDef
   Set pGeomDefEdit = pGeomDef
   With pGeomDefEdit
     .GeometryType = esriGeometryPolygon
     Set .SpatialReference = sSpatial ' New UnknownCoordinateSystem
   End With
   Set pFieldEdit.GeometryDef = pGeomDef
   pFieldsEdit.AddField pField
  
   ' Add another miscellaneous text field
   Set pField = New Field
   Set pFieldEdit = pField
   With pFieldEdit
       .length = 30
       .Name = "MiscText"
       .Type = esriFieldTypeString
   End With
   pFieldsEdit.AddField pField
  
   ' Create the shapefile
   ' (some parameters apply to geodatabase options and can be defaulted as Nothing)
   Dim pFeatClass As IFeatureClass
   Set pFeatClass = pFWS.CreateFeatureClass(sName, pFields, Nothing, _
                                            Nothing, esriFTSimple, "Shape", "")
                                            
   Set CreateShapefile = pFeatClass
End Function
2、然后用得到的IpointCollection写入到Shape文件中</P><P>Public Sub InsertPolygonFeatures(pFeatureClass As IFeatureClass, sPointColl As IPointCollection) ', numberToCreate As Long)
  
   Dim pFeatureBuffer As IFeatureBuffer
   Dim pPoint As IPoint
   Dim pPointCollection As IPointCollection
   Dim pTopo As IPolygon 'ITopologicalOperator
   Dim pFeatureCursor As IFeatureCursor
   Set pFeatureCursor = pFeatureClass.Insert(True)
  
   Set pFeatureBuffer = pFeatureClass.CreateFeatureBuffer
   Set pTopo = sPointColl
   pTopo.Close
  
   Set pFeatureBuffer.Shape = pTopo
   pFeatureCursor.InsertFeature pFeatureBuffer</P><P>   pFeatureCursor.Flush
End Sub
</P>
举报 回复(0) 喜欢(0)     评分
cl991036
管理员
管理员
  • 注册日期2003-07-25
  • 发帖数5913
  • QQ14265545
  • 铜币29654枚
  • 威望213点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • GIS帝国铁杆
5楼#
发布于:2005-05-08 15:02
创建shapefile文件,字段不是自定义而是取已存在图层的。

Public Function CreateShapefile(pOriginalFeatCls As IFeatureClass, sPath As String, sName As String) As IFeatureClass
Dim pFWS As IFeatureWorkspace
Dim pWorkspaceFactory As IWorkspaceFactory
Set pWorkspaceFactory = New ShapefileWorkspaceFactory
Set pFWS = pWorkspaceFactory.OpenFromFile(sPath, 0)
Dim pFields As IFields
Set pFields = pOriginalFeatCls.Fields



'根据已有图层的fields创建,相对简单
'如果要自己设置field的各个属性,得使用IFieldEdit、IFieldsEdit、IGeometryDef、IGeometryDefEdit接口

Dim pFeatClass As IFeatureClass
Set pFeatClass = pFWS.CreateFeatureClass(sName, pFields, Nothing, _
Nothing, esriFTSimple, "Shape", "")

Set CreateShapefile = pFeatClass
End Function


将feature添加到创建的shp文件中。
Public Sub AddFeatureToCreatedLayer(pOriginalFeatCursor As IFeatureCursor, pTargetFeatCls As IFeatureClass)
Dim pFeature As IFeature
Dim pFeatureBuffer As IFeatureBuffer
Dim pTargFeatCursor As IFeatureCursor
Dim pFields As IFields
Dim pTargFields As IFields
Dim i As Integer

' On Error GoTo Err

Set pTargFeatCursor = pTargetFeatCls.Insert(True)
Set pFields = m_pExportLayer.FeatureClass.Fields
Set pTargFields = pTargetFeatCls.Fields
Set pFeature = pOriginalFeatCursor.NextFeature

Do Until pFeature Is Nothing
Set pFeatureBuffer = pTargetFeatCls.CreateFeatureBuffer
For i = 0 To pFields.FieldCount - 1
If Not pFields.Field(i).Type = esriFieldTypeOID And Not pFields.Field(i).Type = esriFieldTypeBlob Then
If pTargFields.FindField(pFields.Field(i).Name) <> -1 Then '确保目标图层中有这个字段
pFeatureBuffer.Value(pTargFields.FindField(pFields.Field(i).Name)) = pFeature.Value(i)
End If
End If
Next
pTargFeatCursor.InsertFeature pFeatureBuffer
Set pFeature = pOriginalFeatCursor.NextFeature
Loop

pTargFeatCursor.Flush
End Sub
没钱又丑,农村户口。头可断,发型一定不能乱。 邮箱:gisempire@qq.com
举报 回复(0) 喜欢(0)     评分
gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15945
  • QQ554730525
  • 铜币25337枚
  • 威望15352点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
6楼#
发布于:2005-05-08 18:18
<img src="images/post/smile/dvbbs/em01.gif" />
举报 回复(0) 喜欢(0)     评分
lanqiuping
路人甲
路人甲
  • 注册日期2004-12-22
  • 发帖数21
  • QQ
  • 铜币5枚
  • 威望0点
  • 贡献值0点
  • 银元0个
7楼#
发布于:2005-06-16 09:46
<img src="images/post/smile/dvbbs/em02.gif" />
我很笨,但我很勤快!!!! QQ:35152929
举报 回复(0) 喜欢(0)     评分
游客

返回顶部