clsdistrictsum.cls

FloodEvaluation-程序是gis方面的程序

        Else
             MsgBox "输入图层有误"
             plusAnother = False
             Exit Function
        End If
    End If
    
    If bRet = False Then
        MsgBox "统计出错"
        plusAnother = False
        Exit Function
    End If
  
    
    plusAnother = True
                               
    Exit Function 'exit sub to avoid error handler

ERH:
    MsgBox "洪损统计失败2" & Chr(13) & ERR.Description, vbInformation + vbOKOnly, "提示信息"
    plusAnother = False
 
End Function


'************************************************************************************************''''''
'''''' copy行政区域图层构造输出的polygon图层
'************************************************************************************************''''''
Public Function createResultLyr(districtLyr As IFeatureLayer, strResultPath As String, _
                                strResultFile As String) As Boolean
    On Error GoTo ERH
    
    Dim pWorkspaceFactory As IWorkspaceFactory
    Set pWorkspaceFactory = New ShapefileWorkspaceFactory
    Dim pFeatureWorkspace As IFeatureWorkspace
    Set pFeatureWorkspace = pWorkspaceFactory.OpenFromFile(strResultPath, 0)
    Dim pSpaRef As ISpatialReference
    Set pSpaRef = GetLayerSourceSpatialRef(districtLyr)      'New UnknownCoordinateSystem
    
    Dim pFlds As IFields
    Set pFlds = CreateFeatureFields(esriGeometryPolygon, True, False, pSpaRef, "洪灾损失")
    
    Call AppendField(pFlds, "地区", esriFieldTypeString, False)
    Call AppendField(pFlds, "受灾损失", esriFieldTypeDouble, False)
    
    Dim pCLSID As UID
    Set pCLSID = New UID
    pCLSID.Value = "esricore.Feature"
    Dim pFClass As IFeatureClass
    Set pFClass = pFeatureWorkspace.CreateFeatureClass(Left(strResultFile, Len(strResultFile) - 4), _
    pFlds, pCLSID, Nothing, esriFTSimple, "Shape", "")
    
    '设置有关字段的索引号
    Dim indexName As Integer
    Dim pFields As IFields
    Set pFields = districtLyr.FeatureClass.Fields
    indexName = pFields.FindField("地区")          '政区名称
    indexName1 = pFlds.FindField("地区")           '政区名称
    indexLoss1 = pFlds.FindField("受灾损失")       '受灾损失
    
    Dim pOutCursor As IFeatureCursor
    Set pOutCursor = pFClass.Insert(True)
  
    Dim pOutBuffer As IFeatureBuffer
    Set pOutBuffer = pFClass.CreateFeatureBuffer

    Dim pFilter As IQueryFilter
    Set pFilter = New QueryFilter
    pFilter.WhereClause = ""

    Dim pFeatCursor As IFeatureCursor
    Set pFeatCursor = districtLyr.Search(pFilter, False)

    Dim polyFeat As IFeature, pPolygon As IPolygon
    Set polyFeat = pFeatCursor.NextFeature
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Do While Not polyFeat Is Nothing
        Set pPolygon = polyFeat.Shape
        Set pOutBuffer.Shape = pPolygon
        pOutBuffer.Value(indexLoss1) = 0 'polySummary
        pOutBuffer.Value(indexName1) = polyFeat.Value(indexName)              '适当调整，用于存放区域的名称或ID
        pOutCursor.InsertFeature pOutBuffer
        Set polyFeat = pFeatCursor.NextFeature
        
    Loop '''''''''''''''''''''''''''''''''''''''''''''''''''''''Do While Not polyFeat Is Nothing
                           
    Set pResultShpLyr = New FeatureLayer
    Set pResultShpLyr.FeatureClass = pFClass
                           
    Set pWorkspaceFactory = Nothing
    Set pFeatureWorkspace = Nothing
    Set pFeatCursor = Nothing
    Set pOutBuffer = Nothing
    Set pOutCursor = Nothing
    Set pFilter = Nothing
    Set pCLSID = Nothing
    
    createResultLyr = True
    
    Exit Function 'exit sub to avoid error handler

ERH:
    MsgBox "创建统计结果失败" & Chr(13) & ERR.Description, vbInformation + vbOKOnly, "提示信息"
    createResultLyr = False
    
End Function


'************************************************************************************************''''''
'''''' 加上基于行政区域的洪损评估
'************************************************************************************************''''''
Public Function plusLossFeatLyr(inputFeatLyr As IFeatureLayer) As Boolean
    On Error GoTo ERH
    
    If inputFeatLyr.FeatureClass.shapeType <> esriGeometryPolygon Then
        MsgBox "输入图层非多边形图层，请查实"
        plusLossFeatLyr = False
        Exit Function
    End If
    
    Dim pFlds As IFields
    Set pFlds = inputFeatLyr.FeatureClass.Fields
    
    '设置有关字段的索引号
    Dim indexName2 As Integer, indexLoss2 As Integer, distrName As String, preValue As Double
    Dim pFields As IFields
    Set pFields = inputFeatLyr.FeatureClass.Fields
    indexName2 = pFlds.FindField("地区")            '政区名称
    indexLoss2 = pFlds.FindField("受灾损失")        '受灾损失
    
    Dim pFilter As IQueryFilter, pSelFilter As IQueryFilter
    Set pFilter = New QueryFilter
    Set pSelFilter = New QueryFilter
    pFilter.WhereClause = ""

    Dim pOutCursor As IFeatureCursor, pInputCursor As IFeatureCursor
    Set pOutCursor = pResultShpLyr.Search(pFilter, False)

    Dim outputFeat As IFeature, inputFeat As IFeature
    Set outputFeat = pOutCursor.NextFeature
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Do While Not outputFeat Is Nothing
        distrName = outputFeat.Value(indexName1)
        pSelFilter.WhereClause = "地区 = '" & distrName & "'"
        Set pInputCursor = inputFeatLyr.Search(pSelFilter, False)
        Set inputFeat = pInputCursor.NextFeature
        
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Do While Not inputFeat Is Nothing
            preValue = outputFeat.Value(indexLoss1)
            MsgBox inputFeat.Value(indexLoss2)
            outputFeat.Value(indexLoss1) = preValue + inputFeat.Value(indexLoss2)
            outputFeat.Store
            Set inputFeat = pInputCursor.NextFeature
            
        Loop '''''''''''''''''''''''''''''''''''''''''''''''''''''''Do While Not inputFeat  Is Nothing
        Set outputFeat = pOutCursor.NextFeature
            
    Loop '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Do While Not outputFeat Is Nothing
                           
    Set pFilter = Nothing
    Set pSelFilter = Nothing
   
    plusLossFeatLyr = True
    
    Exit Function 'exit sub to avoid error handler

ERH:
    MsgBox "统计项目失败" & Chr(13) & ERR.Description, vbInformation + vbOKOnly, "提示信息"
    plusLossFeatLyr = False
    
End Function


'************************************************************************************************''''''
'''''' 加上栅格形式的评估结果
'************************************************************************************************''''''
Public Function plusLossRasterLyr(inputRasterLyr As IRasterLayer) As Boolean
    
    On Error GoTo ERH
       
    Dim inputRaster As IRaster
    Set inputRaster = inputRasterLyr.Raster  '    OpenRasterDataset(strGRIDPath, strGRIDFile).CreateDefaultRaster

    Dim pExtractionOp As IExtractionOp
    Set pExtractionOp = New RasterExtractionOp
    Dim strName As String, polySummary As Double, preValue As Double
    Dim pPolygon As IPolygon
    Dim pExtractRaster As IRaster, pZeroRaster As IRaster
    
      
'    '设置有关字段的索引号
'    Dim indexName As Integer, indexName1 As Integer, indexFloodLoss1 As Double
'    Dim pFields As IFields
'    Set pFields = pResultShpLyr.FeatureClass.Fields
'    indexFloodLoss1 = pFields.FindField("受灾损失")  '受灾损失

    Dim pFilter As IQueryFilter
    Set pFilter = New QueryFilter
    pFilter.WhereClause = ""

    Dim pOutCursor As IFeatureCursor
    Set pOutCursor = pResultShpLyr.Search(pFilter, False)

    Dim polyFeat As IFeature
    Set polyFeat = pOutCursor.NextFeature
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Do While Not polyFeat Is Nothing
        Set pPolygon = polyFeat.Shape
        Set pExtractRaster = pExtractionOp.Polygon(inputRaster, pPolygon, True)
        Call rasterSum(pExtractRaster, polySummary)
        preValue = polyFeat.Value(indexLoss1)
        polyFeat.Value(indexLoss1) = preValue + polySummary
        polyFeat.Store
        Set polyFeat = pOutCursor.NextFeature
        
    Loop '''''''''''''''''''''''''''''''''''''''''''''''''''''''Do While Not polyFeat Is Nothing
                           
'    Set pResultShpLyr = resultLyr
    Set pFilter = Nothing
    Set pOutCursor = Nothing
    Set pExtractionOp = Nothing
    
    plusLossRasterLyr = True
    
    Exit Function 'exit sub to avoid error handler

ERH:
    MsgBox "统计项目失败" & Chr(13) & ERR.Description, vbInformation + vbOKOnly, "提示信息"
    plusLossRasterLyr = False
End Function