如何将选中的点集转换成Polygon
1个回答
推荐于2016-07-28 · 知道合伙人数码行家
huanglenzhi
知道合伙人数码行家
向TA提问 私信TA
知道合伙人数码行家
采纳数:117538
获赞数:517184
长期从事计算机组装,维护,网络组建及管理。对计算机硬件、操作系统安装、典型网络设备具有详细认知。
向TA提问 私信TA
关注
展开全部
如何将选中的点集转换成Polygon
本例要实现的功能是根据一个FeatureLayer中被选择一个或多个MultiPoint,生成多个Point并把这些新生成的Point保存在一个Point类型的Feature Layer上。
l 要点
本例将选择的Multipoints上的每个点都生成一个对应得Point,并用一个接口IPointCollection的变量来接收。利用IPointCollection的方法point(index),取出新生成的每个点,用来创建Point类型的Feature。
l 程序说明
本例要求在ArcMap中添加两个层,最上面的是层Multipoint,下面是层wind。根据循环得到选择的每个Multipoint的每个点,为wind层生成新的Feature并保存
l 代码
Sub convertMultipointToPoints()
Dim pMxDocument As IMxDocument
Dim pMap As IMap
Dim pActiveView As IActiveView
Dim pEnumFeature As IEnumFeature
Dim pFeature0 As IFeature
Dim pFeatureLayer0 As IFeatureLayer
Dim pFeatureClass0 As IFeatureClass
Dim pFeature1 As IFeature
Dim pFeatureLayer1 As IFeatureLayer
Dim pFeatureClass1 As IFeatureClass
Dim pPointCollection As IPointCollection
Dim pDataSet As IDataset
Dim pWorkspaceFactory As IWorkspaceFactory
Dim pWorkspaceEdit As IWorkspaceEdit
Dim lPointIndex As Long
Dim lPointFieldIndex As Long
On Error GoTo ErrorHanlder
'得到当前层
Set pMxDocument = ThisDocument
Set pMap = pMxDocument.FocusMap
Set pActiveView = pMap
'得到0层和1层的FeatureClass
Set pFeatureLayer0 = pMxDocument.FocusMap.Layer(0)
Set pFeatureClass0 = pFeatureLayer0.FeatureClass
Set pFeatureLayer1 = pMxDocument.FocusMap.Layer(1)
Set pFeatureClass1 = pFeatureLayer1.FeatureClass
'建立编辑工作区
Set pDataSet = pFeatureClass1
Set pWorkspaceFactory = New ShapefileWorkspaceFactory
Set pWorkspaceEdit = pWorkspaceFactory.OpenFromFile(pDataSet.Workspace.PathName, 0)
pWorkspaceEdit.StartEditOperation
pWorkspaceEdit.StartEditing True
'得到Feature
Set pEnumFeature = pMxDocument.FocusMap.FeatureSelection
Set pFeature0 = pEnumFeature.Next
If pFeature0 Is Nothing Then
MsgBox "Must have Select in Position 0"
Exit Sub
End If
'循环,通过每个MultiPoint,在1图层上,生成以每个点为特征的Points
While Not pFeature0 Is Nothing
If pFeature0.ShapeCopy.GeometryType = esriGeometryMultipoint Then
Set pPointCollection = pFeature0.ShapeCopy
For nPointIndex = 0 To pPointCollection.PointCount - 1
Set pFeature1 = pFeatureClass1.CreateFeature
'在pFeature1上生成Point
Set pFeature1.Shape = pPointCollection.Point(nPointIndex)
'如果两Feature的FieldCount相同,赋每个Field的值,ID,
'TypeGeometry的Field除外
If pFeature1.Fields.FieldCount = pFeature0.Fields.FieldCount Then
For lPointFieldIndex = 0 To pFeature1.Fields.FieldCount - 1
If Not pFeature1.Fields.Field(lPointFieldIndex).Type = _ esriFieldTypeGeometry And Not pFeature1.Fields. _
Field(lPointFieldIndex).Type = esriFieldTypeOID Then
pFeature1.Value(lPointFieldIndex) = _
pFeature0.Value(lPointFieldIndex)
End If
Next
End If
'保存Feature
pFeature1.Store
Next
Else
MsgBox "Must have Multipoint in position 0"
Exit Sub
End If
Set pFeature0 = pEnumFeature.Next
Wend
'停止编辑
pWorkspaceEdit.StopEditOperation
pWorkspaceEdit.StopEditing True
Exit Sub
ErrorHanlder:
pWorkspaceEdit. AbortEditOperation
MsgBox Err.Description
End Sub
本例要实现的功能是根据一个FeatureLayer中被选择一个或多个MultiPoint,生成多个Point并把这些新生成的Point保存在一个Point类型的Feature Layer上。
l 要点
本例将选择的Multipoints上的每个点都生成一个对应得Point,并用一个接口IPointCollection的变量来接收。利用IPointCollection的方法point(index),取出新生成的每个点,用来创建Point类型的Feature。
l 程序说明
本例要求在ArcMap中添加两个层,最上面的是层Multipoint,下面是层wind。根据循环得到选择的每个Multipoint的每个点,为wind层生成新的Feature并保存
l 代码
Sub convertMultipointToPoints()
Dim pMxDocument As IMxDocument
Dim pMap As IMap
Dim pActiveView As IActiveView
Dim pEnumFeature As IEnumFeature
Dim pFeature0 As IFeature
Dim pFeatureLayer0 As IFeatureLayer
Dim pFeatureClass0 As IFeatureClass
Dim pFeature1 As IFeature
Dim pFeatureLayer1 As IFeatureLayer
Dim pFeatureClass1 As IFeatureClass
Dim pPointCollection As IPointCollection
Dim pDataSet As IDataset
Dim pWorkspaceFactory As IWorkspaceFactory
Dim pWorkspaceEdit As IWorkspaceEdit
Dim lPointIndex As Long
Dim lPointFieldIndex As Long
On Error GoTo ErrorHanlder
'得到当前层
Set pMxDocument = ThisDocument
Set pMap = pMxDocument.FocusMap
Set pActiveView = pMap
'得到0层和1层的FeatureClass
Set pFeatureLayer0 = pMxDocument.FocusMap.Layer(0)
Set pFeatureClass0 = pFeatureLayer0.FeatureClass
Set pFeatureLayer1 = pMxDocument.FocusMap.Layer(1)
Set pFeatureClass1 = pFeatureLayer1.FeatureClass
'建立编辑工作区
Set pDataSet = pFeatureClass1
Set pWorkspaceFactory = New ShapefileWorkspaceFactory
Set pWorkspaceEdit = pWorkspaceFactory.OpenFromFile(pDataSet.Workspace.PathName, 0)
pWorkspaceEdit.StartEditOperation
pWorkspaceEdit.StartEditing True
'得到Feature
Set pEnumFeature = pMxDocument.FocusMap.FeatureSelection
Set pFeature0 = pEnumFeature.Next
If pFeature0 Is Nothing Then
MsgBox "Must have Select in Position 0"
Exit Sub
End If
'循环,通过每个MultiPoint,在1图层上,生成以每个点为特征的Points
While Not pFeature0 Is Nothing
If pFeature0.ShapeCopy.GeometryType = esriGeometryMultipoint Then
Set pPointCollection = pFeature0.ShapeCopy
For nPointIndex = 0 To pPointCollection.PointCount - 1
Set pFeature1 = pFeatureClass1.CreateFeature
'在pFeature1上生成Point
Set pFeature1.Shape = pPointCollection.Point(nPointIndex)
'如果两Feature的FieldCount相同,赋每个Field的值,ID,
'TypeGeometry的Field除外
If pFeature1.Fields.FieldCount = pFeature0.Fields.FieldCount Then
For lPointFieldIndex = 0 To pFeature1.Fields.FieldCount - 1
If Not pFeature1.Fields.Field(lPointFieldIndex).Type = _ esriFieldTypeGeometry And Not pFeature1.Fields. _
Field(lPointFieldIndex).Type = esriFieldTypeOID Then
pFeature1.Value(lPointFieldIndex) = _
pFeature0.Value(lPointFieldIndex)
End If
Next
End If
'保存Feature
pFeature1.Store
Next
Else
MsgBox "Must have Multipoint in position 0"
Exit Sub
End If
Set pFeature0 = pEnumFeature.Next
Wend
'停止编辑
pWorkspaceEdit.StopEditOperation
pWorkspaceEdit.StopEditing True
Exit Sub
ErrorHanlder:
pWorkspaceEdit. AbortEditOperation
MsgBox Err.Description
End Sub
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询