xuyunhe
路人甲
路人甲
  • 注册日期2003-08-25
  • 发帖数59
  • QQ
  • 铜币374枚
  • 威望0点
  • 贡献值0点
  • 银元0个
阅读:1474回复:1

如何合并含有Z值的要素?

楼主#
更多 发布于:2004-08-31 16:13
<P>Private Sub ConstructUnion()
  On Error GoTo ErrorHandler</P>
<P>  Dim pMxDoc As IMxDocument
  Dim pMap As IMap
  Set pMxDoc = Application.Document
  Set pMap = pMxDoc.FocusMap
 
  Dim pFeatureLayer As IFeatureLayer
  Dim pFeatureSelection As IFeatureSelection
  Dim pSelectionSet As ISelectionSet
  Dim pFeature As IFeature
  Dim pEnumFeature As IEnumFeature
  Dim pGeoDataset As IGeoDataset
  Dim pSpatialRef As ISpatialReference
  Dim pGeoBag As IGeometryCollection
  Dim pGeometry As IGeometry
  Dim pTopoOp As ITopologicalOperator2
  Dim pGeometryTemp As IGeometry
  Dim lGeometryType As Long
  Dim pTopoOpSimplify As ITopologicalOperator2
  Dim pWKS As IWorkspace
  Dim pWKSE As IWorkspaceEdit
  Dim bInOperation As Boolean
  Dim DeletedFeatureCount As Integer
  Dim pDataset As IDataset
  Dim pFeatureCursor As IFeatureCursor
  
  Dim iCount As Integer
  For iCount = 1 To pMap.LayerCount
    Set pFeatureLayer = pMap.Layer(iCount - 1)
    Set pDataset = pFeatureLayer
    Set pWKS = pDataset.Workspace
    Set pWKSE = pWKS
    'Check if feature layer is editable
    If pFeatureLayer.Visible And pWKSE.IsBeingEdited Then
      pWKSE.StartEditOperation
      bInOperation = True
      Set pFeatureSelection = pFeatureLayer
      Set pSelectionSet = pFeatureSelection.SelectionSet
      'Check if there is a selection
      If Not pSelectionSet.Count = 0 Then
        pSelectionSet.Search Nothing, False, pFeatureCursor
        Set pFeature = pFeatureCursor.NextFeature
        If pFeature Is Nothing Then
           MsgBox "必须选择至少一个要素!"
           Exit Sub
        End If
        '设置保存合并的要素
        Dim pFeatureBuffer As IFeatureBuffer
        Dim pInFCur As IFeatureCursor, q As Long
        Dim pInFeat As IFeature
        Dim pFC As IFeatureClass
        Set pFC = pFeatureLayer.FeatureClass
        Set pFeatureBuffer = pFC.CreateFeatureBuffer
        Set pInFCur = pFC.Insert(True)
        Set pInFeat = pFeatureBuffer
        Set pInFeat = pFeature
        
        Set pGeoDataset = pFeature.Class
        'Get the spatial reference of the first feature in the enumerator
        Set pSpatialRef = pGeoDataset.SpatialReference
        Set pGeoBag = New GeometryBag
        'Set the spatial reference of the geometryBag via IGeometry
        Set pGeometry = pGeoBag 'QI
        Set pGeometry.SpatialReference = pSpatialRef
        Set pGeometryTemp = pFeature.ShapeCopy
        'Set the value of the Union GeometryType
        lGeometryType = pGeometryTemp.GeometryType
        Do While Not pFeature Is Nothing
        'Add only the geometry with the same geometrytype than the one determined earlier
          If pFeature.ShapeCopy.GeometryType = lGeometryType Then
             pGeoBag.AddGeometry pFeature.ShapeCopy
          End If
          Set pFeature = pFeatureCursor.NextFeature
        Loop
        '创建一个新的geometry
        Select Case lGeometryType
           Case esriGeometryPoint
              Set pTopoOp = New Multipoint
           Case esriGeometryMultipoint
              Set pTopoOp = New Multipoint
           Case esriGeometryPolyline
              Set pTopoOp = New Polyline
           Case esriGeometryPolygon
              Set pTopoOp = New Polygon
           Case Else
           Exit Sub
        End Select
        pTopoOp.ConstructUnion pGeoBag
        
        '插入要素的shape到pInFCur
        Set pInFeat.Shape = pTopoOp  /出错提示:这个几何没有Z值
        q = pInFCur.InsertFeature(pInFeat)
        pInFCur.Flush
        
        '删除原来的要素
        pSelectionSet.Search Nothing, False, pFeatureCursor
        Set pFeature = pFeatureCursor.NextFeature
        Do While Not pFeature Is Nothing
          pFeature.Delete
          DeletedFeatureCount = DeletedFeatureCount + 1
          Set pFeature = pFeatureCursor.NextFeature
        Loop
        If DeletedFeatureCount = 0 Then
          pWKSE.AbortEditOperation
        Else
          pWKSE.StopEditOperation
          bInOperation = False
        End If
      End If
    End If
  Next
  
   pMxDoc.ActiveView.Refresh
  Exit Sub
  
ErrorHandler:
  MsgBox Err.Description
  
  If bInOperation Then
    pWKSE.AbortEditOperation
  End If
End Sub</P>
喜欢0 评分0
destnity
路人甲
路人甲
  • 注册日期2004-03-25
  • 发帖数341
  • QQ
  • 铜币272枚
  • 威望0点
  • 贡献值0点
  • 银元0个
1楼#
发布于:2004-08-31 16:43
有空看看,帮顶下。哈。。
签 名: 不能超过 250 个字符 文字将出现在您发表的文章的结尾处。
举报 回复(0) 喜欢(0)     评分
游客

返回顶部