-2147220936 Coordinates Or Measures Are Out of Bounds --- IFeature.Shape

645
0
06-20-2012 08:31 AM
LoganLehman
New Contributor
Hey guys,

I current have two tools that draw polygons using the same method. I dissolve the zones, delete the undissolved zones, and then add the dissolved polygon to the map.

I keep getting "Coordinates or measure are out of bounds" on add the GeometryCollection to the IFeature.Shape property. This worked in VB6 back in 9.1, but I know things have changed. The error only happens after the first dissolve. I am assuming when it dissolves the polygons, it isn't carrying over its XY Domain/Envelope. I was wondering if anyone has some insight on what to do to fix this problem?

Here is the code that is bombs out on, if you need any other of the subroutine's code let me know (please know this is a huge system):

Public Sub UpdateLayer_AddPolygon(ByVal str_LayerName As String, ByVal pPolygon_New As IPolygon)

        Dim pMxDoc_This As IMxDocument

        Dim pFeatLayer_Out As IFeatureLayer
        Dim pFeatClass_Out As IFeatureClass

        Dim pFeat_New As IFeature

        Dim pPolygon_Out As IPolygon
        Dim pGeomColl_In As IGeometryCollection
        Dim pGeomColl_Out As IGeometryCollection
        Dim pSegmentColl_Ring As ISegmentCollection
        Dim pMap As IMap


        Dim pClone_1 As esriSystem.IClone

        Dim i_SegNum As Long

        On Error GoTo ErrorHandler


        pMxDoc_This = My.ArcMap.Application.Document
        pMap = My.ArcMap.Document.FocusMap

        pFeatLayer_Out = FindLayer_ByLayerName(str_LayerName)
        pFeatClass_Out = pFeatLayer_Out.FeatureClass

        '¶¶ Verify that the specified layer is of type polygon:
        If Not pFeatClass_Out.ShapeType = esriGeometryType.esriGeometryPolygon Then
            MsgBox("The output layer, ''" + str_LayerName + "'' must be of type polygon.", vbExclamation, "CW Inspection Operations")
            Exit Sub
        End If


        'Create new polygon in collection:
        pGeomColl_Out = New Polygon

        'Clone the incoming polygon, so we can use the references to the new segments:
        pClone_1 = pPolygon_New
        pGeomColl_In = pClone_1.Clone


        'Transfer the segments from the polygon paths to new rings and add the rings to the new polygon:
        For i_SegNum = 0 To pGeomColl_In.GeometryCount - 1
            pSegmentColl_Ring = New Ring
            pSegmentColl_Ring.AddSegmentCollection(pGeomColl_In.Geometry(i_SegNum))
            pGeomColl_Out.AddGeometry(pSegmentColl_Ring)
        Next i_SegNum



        'Store the polygon in the specified layer:
        pFeat_New = pFeatClass_Out.CreateFeature
        pFeat_New.Shape = pGeomColl_Out 'Crashes Here
        pFeat_New.Store()

        'Refresh the display.
        pMxDoc_This.ActiveView.PartialRefresh(esriViewDrawPhase.esriViewGeography, Nothing, Nothing)

        Exit Sub

        '-----------------------------------------------------------------------------------------------------

ErrorHandler:

        Select Case Err.Number
            Case -2147220936  'coordinates or measures out of bounds (80040238)
                MsgBox("The Coordinates or Measures are Out of Bounds.", _
                        vbInformation, "Out of Bounds")
                Exit Sub
            Case Else
                MsgBox(Err.Number & ": " & "Could not draw polygon in this area. The Coordinates or Measures are Out of Bounds.")
        End Select

        Exit Sub


    End Sub 'UpdateLayer_AddPolygon



And here is the dissolve code:

Public Sub DissolvePerim(ByVal str_FeatClassName_Perim As String)

        Dim pFeatLayer_Output As IFeatureLayer
        Dim pFeatClass_Output As IFeatureClass
        Dim pBasicGeoProc_1 As IBasicGeoprocessor
        Dim pFeatClass_Input As IFeatureClass
        Dim pWorkspaceName_New As IWorkspaceName
        Dim pFeatClassName_1 As IFeatureClassName
        Dim pTable_Input As ITable
        Dim pTable_Output As ITable

        'dataset objects:
        Dim pDatasetName_1 As IDatasetName

        'layer objects:
        Dim pFeatLayer_Input As IFeatureLayer

        Dim pFeatLayer_Perim As IFeatureLayer
        Dim pFeatLayer_Perim_Dissolved As IFeatureLayer

        Dim pFeatClassName_Perim As IFeatureClassName
        Dim pFeatClassName_Perim_Dissolved As IFeatureClassName

        Dim str_PathedFileName_DB As String

        Dim str_SummaryFields As String

        Dim pField_1 As IField
        Dim pFieldEdit_1 As IFieldEdit

        Dim pDataset_Temp As IDataset


        'Locate the database file:
        str_PathedFileName_DB = GetNPath_DB() + "CWInspect_Perims.mdb"

        If g_b_DebugMode Then
            MsgBox("Database file: ''" + str_PathedFileName_DB + "''", vbInformation, "CW Inspection Operations")
        End If

        'Find the perimeter layer:
        pFeatLayer_Input = FindLayer_ByFeatClassName(str_FeatClassName_Perim)

        '¶¶
        If pFeatLayer_Input Is Nothing Then
            MsgBox("The ''" + str_FeatClassName_Perim + "'' layer was not found")
            Exit Sub
        End If

        'Find the dissolved perimeter layer:
        pFeatLayer_Output = FindLayer_ByFeatClassName(str_FeatClassName_Perim + "_dissolved")

        '¶¶
        If pFeatLayer_Output Is Nothing Then
            MsgBox("The ''" + str_FeatClassName_Perim + "_dissolved'' layer was not found", vbApplicationModal Or vbCritical Or vbOKOnly, "CW Inspection Operations")
            Exit Sub
        End If

        'Get the input table:
        pTable_Input = pFeatLayer_Input
        ' ( Use the ITable interface from the FeatureLayer, not from the FeatureClass )

        '¶¶
        If pTable_Input Is Nothing Then
            MsgBox("Table QI failed.", vbApplicationModal Or vbCritical Or vbOKOnly, "CW Inspection Operations")
            Exit Sub
        End If

        'Make sure there is a field named "SUB" in the input layer:
        If pTable_Input.FindField("SUB") = -1 Then
            'Create the "SUB" field:
            pField_1 = New Field
            pFieldEdit_1 = pField_1
            pFieldEdit_1.Name_2 = "SUB"
            pFieldEdit_1.AliasName_2 = "SUB"
            pFieldEdit_1.Type_2 = esriFieldType.esriFieldTypeString
            pFieldEdit_1.Length_2 = 5
            pTable_Input.AddField(pField_1)
        End If

        'Get the feature class properties needed for the output:
        pFeatClass_Input = pFeatLayer_Input.FeatureClass
        pFeatClassName_1 = New FeatureClassName
        With pFeatClassName_1
            .FeatureType = esriFeatureType.esriFTSimple
            .ShapeFieldName = "Shape"
            .ShapeType = pFeatClass_Input.ShapeType
        End With

        Call DeleteFeatureClass(str_PathedFileName_DB, "dissolve_work")

        'Set the output location and output feature class name:
        pWorkspaceName_New = New WorkspaceName
        pWorkspaceName_New.WorkspaceFactoryProgID = "esriDataSourcesGDB.AccessWorkspaceFactory.1"
        pWorkspaceName_New.PathName = str_PathedFileName_DB

        pDatasetName_1 = pFeatClassName_1
        pDatasetName_1.Name = "dissolve_work"
        pDatasetName_1.WorkspaceName = pWorkspaceName_New

        'Perform the dissolve:
        pBasicGeoProc_1 = New BasicGeoprocessor
        str_SummaryFields = "Dissolve.Shape, Sum.SUB"
        pTable_Output = pBasicGeoProc_1.Dissolve(pTable_Input, False, "SUB", str_SummaryFields, pDatasetName_1)
        ' ( Since we are performing a spatial dissolve, we must use the operation code
        '   "Dissolve" on the Shape field. )
        ' ( The "dissolveField" parameter MUST point to a text field in order to work properly. )

        pFeatClass_Output = pTable_Output

        '¶¶
        If pFeatClass_Output Is Nothing Then
            MsgBox("FeatureClass QI failed.")
            Exit Sub
        End If

        pFeatLayer_Perim = FindLayer_ByFeatClassName(str_FeatClassName_Perim)
        pFeatLayer_Perim_Dissolved = FindLayer_ByFeatClassName(str_FeatClassName_Perim + "_dissolved")

        pFeatLayer_Output.FeatureClass = pFeatClass_Output


        'Remove all shapes from the perimeter (un-dissolved) layer:
        Call EmptyLayer(FindLayer_ByFeatClassName(str_FeatClassName_Perim), False)

        'Get the perimeter workspace and feature class name object:
        pDataset_Temp = pFeatLayer_Perim.FeatureClass
        pFeatClassName_Perim = pDataset_Temp.FullName

        'Get the dissolved perimeter workspace and feature class name object:
        pDataset_Temp = pFeatLayer_Perim_Dissolved.FeatureClass
        pFeatClassName_Perim_Dissolved = pDataset_Temp.FullName

        'Copy the dissolved perimeter shapes to the perimeter layer.
        Call CopyLayerShapes(pFeatClassName_Perim_Dissolved, pFeatClassName_Perim, Nothing)


    End Sub 'DissolvePerim
0 Kudos
0 Replies