topic Re: ConstructCircle - Run-time error '424' Object required. How to fix it? in ArcObjects SDK Questions

ConstructCircle - Run-time error '424' Object required. How to fix it?

MarAlcaraz1 — Tue, 22 Nov 2011 08:02:41 GMT

Hi everybody!

Could someone help me with this error? Well, in general, with the whole code, because it returns me different errors. The firs one is about the line pConstCArc.ConstrutCircle. I'd like to convert points from a table to polygons in a feature class.

Thanks in advance for helping me to learn more about ArcObjects!

Private Sub InterpretationTubes_Click()

Dim pSxDoc As ISxDocument
Set pSxDoc = ThisDocument

Dim pScene As IScene
Set pScene = pSxDoc.Scene

Dim i As Integer
For i = 0 To pScene.LayerCount - 1
    If pScene.Layer(i).Name = "InterpretationTubes" Then
    Dim pOutLayer As IFeatureLayer
    Set pOutLayer = pScene.Layer(i)
    End If
Next

Dim pFeatClass As IFeatureClass
Set pFeatClass = pOutLayer.FeatureClass

Dim pStandaloneTC As IStandaloneTableCollection
Set pStandaloneTC = pSxDoc.Scene

Dim pStandaloneT As IStandaloneTable
Set pStandaloneT = pStandaloneTC.StandaloneTable(0)

Dim lng_X, lng_Y, lng_Elevation, lng_SubUnits, lng_Top_Depth, lng_Bottom_Depth As Long

      lng_X = pStandaloneT.Table.FindField("X")
      lng_Y = pStandaloneT.Table.FindField("Y")
      lng_Elevation = pStandaloneT.Table.FindField("Elevation")
      lng_SubUnits = pStandaloneT.Table.FindField("SubUnits")
      lng_Top_Depth = pStandaloneT.Table.FindField("Top_Depth")
      lng_Bottom_Depth = pStandaloneT.Table.FindField("Bottom_Depth")
      If (lng_X < 0) Or (lng_Y < 0) Or (lng_Elevation < 0) Or (lng_SubUnits < 0) Or (lng_Top_Depth < 0) Or (lng_Bottom_Depth < 0) Then
        MsgBox "Could not find specified Fields"
        Exit Sub
      End If

Dim pCur As ICursor
Set pCur = pStandaloneT.Table.Search(Nothing, True)

Dim pRow As IRow
Set pRow = pCur.NextRow

Do While Not pRow Is Nothing

    Dim pPointBot As IPoint
    Set pPointBot = New Point

    pPointBot.x = pRow.Value(lng_X)
    pPointBot.y = pRow.Value(lng_Y)
    pPointBot.Z = pRow.Value(lng_Elevation) - pRow.Value(lng_Bottom_Depth)

    Dim pFeature As IFeature
    Set pFeature = pFeatClass.CreateFeature

    Dim pConstCArc As IConstructCircularArc
    Set pConstCArc = New CircularArc

   pConstrCArc.ConstructCircle pPointBot, 5, True    Error run-time 424: Object required

    Dim pSegCol As ISegmentCollection
    Set pSegCol = New Ring
    pSegCol.AddSegment pConstCArc

    Dim pGeoCol As IGeometryCollection
    Set pGeoCol = New Polygon
    pGeoCol.AddGeometry pConstArc

    Set pFeature.Shape = pGeoCol

    Dim pZAware As IZAware
    Set pZAware = pFeature.Shape
    pZAware.ZAware = True

    pFeature.Value(3) = pRow.Value(lng_SubUnits)
    pFeature.Value(4) = pRow.Value(lng_Bottom_Depth) - pRow.Value(lng_Top_Depth)
    pFeature.Store

    Set pRow = pCur.NextRow

    Loop

    pSxDoc.UpdateContents

    pSxDoc.Scene.SceneGraph.Invalidate pOutLayer, True, True
    pSxDoc.Scene.SceneGraph.RefreshViewers

End Sub

Re: ConstructCircle - Run-time error '424' Object required. How to fix it?

NeilClemmons — Tue, 22 Nov 2011 12:07:06 GMT

Dim pConstCArc As IConstructCircularArc
Set pConstCArc = New CircularArc

pConstrCArc.ConstructCircle pPointBot, 5, True Error run-time 424: Object required

You are declaring the variable as pConstCArc but trying to call it as pConstrCArc. Notice the "r"? I would recommend that you go into your VBA settings and check the option to require variable declaration.

Re: ConstructCircle - Run-time error '424' Object required. How to fix it?

MarAlcaraz1 — Tue, 22 Nov 2011 12:48:39 GMT

Thanks for the observation Neil, too many hours looking at the computer... But now the problem is with "pGeoCol.AddGeometry pConstrCArc":

The parameter is (or has an element that is) the wrong kind of geometry.

Private Sub InterpretationTubes0_Click()

Dim pSxDoc As ISxDocument
Set pSxDoc = ThisDocument

Dim pScene As IScene
Set pScene = pSxDoc.Scene

Dim i As Integer
For i = 0 To pScene.LayerCount - 1
If pScene.Layer(i).Name = "InterpretationTubes" Then
Dim pOutLayer As IFeatureLayer
Set pOutLayer = pScene.Layer(i)
End If
Next

Dim pFeatClass As IFeatureClass
Set pFeatClass = pOutLayer.FeatureClass

Dim pStandaloneTC As IStandaloneTableCollection
Set pStandaloneTC = pSxDoc.Scene

Dim pStandaloneT As IStandaloneTable
Set pStandaloneT = pStandaloneTC.StandaloneTable(0)

Dim lng_X, lng_Y, lng_Elevation, lng_SubUnits, lng_Top_Depth, lng_Bottom_Depth As Long

lng_X = pStandaloneT.Table.FindField("X")
lng_Y = pStandaloneT.Table.FindField("Y")
lng_Elevation = pStandaloneT.Table.FindField("Elevation")
lng_SubUnits = pStandaloneT.Table.FindField("SubUnits")
lng_Top_Depth = pStandaloneT.Table.FindField("Top_Depth")
lng_Bottom_Depth = pStandaloneT.Table.FindField("Bottom_Depth")
If (lng_X < 0) Or (lng_Y < 0) Or (lng_Elevation < 0) Or (lng_SubUnits < 0) Or (lng_Top_Depth < 0) Or (lng_Bottom_Depth < 0) Then
MsgBox "Could not find specified Fields"
Exit Sub
End If

Dim pCur As ICursor
Set pCur = pStandaloneT.Table.Search(Nothing, True)

Dim pRow As IRow
Set pRow = pCur.NextRow

Do While Not pRow Is Nothing

Dim pPointBot As IPoint
Set pPointBot = New Point

pPointBot.x = pRow.Value(lng_X)
pPointBot.y = pRow.Value(lng_Y)
pPointBot.Z = pRow.Value(lng_Elevation) - pRow.Value(lng_Bottom_Depth)

Dim pFeature As IFeature
Set pFeature = pFeatClass.CreateFeature

Dim pConstrCArc As IConstructCircularArc
Set pConstrCArc = New CircularArc

pConstrCArc.ConstructCircle pPointBot, 5, True

Dim pSegCol As ISegmentCollection
Set pSegCol = New Ring
pSegCol.AddSegment pConstrCArc

Dim pGeoCol As IGeometryCollection
Set pGeoCol = New Polygon
pGeoCol.AddGeometry pConstrCArc

Set pFeature.Shape = pGeoCol

Dim pZAware As IZAware
Set pZAware = pFeature.Shape
pZAware.ZAware = True

pFeature.Value(3) = pRow.Value(lng_SubUnits)
pFeature.Value(4) = pRow.Value(lng_Bottom_Depth) - pRow.Value(lng_Top_Depth)
pFeature.Store

Set pRow = pCur.NextRow

Loop

pSxDoc.UpdateContents

pSxDoc.Scene.SceneGraph.Invalidate pOutLayer, True, True
pSxDoc.Scene.SceneGraph.RefreshViewers

End Sub

Re: ConstructCircle - Run-time error '424' Object required. How to fix it?

NeilClemmons — Tue, 22 Nov 2011 13:00:14 GMT

Dim pSegCol As ISegmentCollection
Set pSegCol = New Ring
pSegCol.AddSegment pConstrCArc

Dim pGeoCol As IGeometryCollection
Set pGeoCol = New Polygon
pGeoCol.AddGeometry pConstrCArc

As stated in the developer help, the geometry collection for a polygon is a collection of rings. You're trying to add a circular arc to the geometry collection, which is not a ring. If you want to create a polygon from the circular arc then all you need to do is create a new polygon object, QI to ISegmentCollection and add the circular arc.

Dim polygon As IPolygon
Set polygon = new Polygon
Dim segmentCollection As ISegmentCollection
Set segmentCollection = polygon
segmentCollection.AddSegment circularArc

Of course, your original code will work if you add the segment collection to the geometry collection instead of the circular arc.

Re: ConstructCircle - Run-time error '424' Object required. How to fix it?

MarAlcaraz1 — Wed, 23 Nov 2011 07:25:31 GMT

I made some modifications over my code, and it works until the line:

Set pFeature.Shape = pPolygon, where an error is returned: "The geometry has no Z values"

pConstrCArc.ConstructCircle pPointBot, 5, True

Dim pSegCol As ISegmentCollection
Set pSegCol = New Ring
pSegCol.AddSegment pConstrCArc

Dim pGeoCol As IGeometryCollection
Set pGeoCol = New Polygon
pGeoCol.AddGeometry pSegCol

Dim pFeature As IFeature
Set pFeature=PFeatClass.CreateFeature

Dim pPolygon As IPolygon
Set pPolygon = pGeoCol

Dim pZAware As IZAware
Set pZAware = pPolygon
pZAware.ZAware = True

Set pFeature.Shape = pPolygon "The geometry has no Z values"

What am I doing wrong?

Re: ConstructCircle - Run-time error '424' Object required. How to fix it?

NeilClemmons — Wed, 23 Nov 2011 12:20:17 GMT

As the error says, you haven't assigned z values to the geometry. In order to save a feature into a z-aware feature class you must give each point in the geometry a z value.

Re: ConstructCircle - Run-time error '424' Object required. How to fix it?

MarAlcaraz1 — Wed, 23 Nov 2011 13:14:30 GMT

It is a bit annoying because I have written a similar code with lines, and it does work!!!

I also checked the "shape" field in the feature class, and it can store three-dimensional features.

Is it not enough to asign Z values with the following code in bold?

In fact, with this code the error says "the geometry has null Z values", instead of "no Z values"...

Dim pPointBot As IPoint
Set pPointBot = New Point

Dim pZAwarePoint As IZAware
Set pZAwarePoint = pPointBot
pZAwarePoint.ZAware = True

pPointBot.x = pRow.Value(lng_X)
pPointBot.y = pRow.Value(lng_Y)
pPointBot.Z = pRow.Value(lng_Elevation) - pRow.Value(lng_Bottom_Depth)

Dim pConstrCArc As IConstructCircularArc
Set pConstrCArc = New CircularArc

pConstrCArc.ConstructCircle pPointBot, 5, True

Dim pSegCol As ISegmentCollection
Set pSegCol = New Ring
pSegCol.AddSegment pConstrCArc

Dim pGeoCol As IGeometryCollection
Set pGeoCol = New polygon
pGeoCol.AddGeometry pSegCol

'Dim polygon As IPolygon
'Set polygon = New polygon
'Dim segmentCollection As ISegmentCollection
'Set segmentCollection = polygon
'segmentCollection.AddSegment pConstrCArc

Dim pFeature As IFeature
Set pFeature = pFeatClass.CreateFeature

Dim pPolygon As IPolygon
Set pPolygon = pGeoCol

Dim pZAwarePoly As IZAware
Set pZAwarePoly = pPolygon
pZAwarePoly.ZAware = True

Set pFeature.Shape = pPolygon

pFeature.Value(3) = pRow.Value(lng_SubUnits)
pFeature.Value(4) = pRow.Value(lng_Bottom_Depth) - pRow.Value(lng_Top_Depth)
pFeature.Store

Re: ConstructCircle - Run-time error '424' Object required. How to fix it?

NeilClemmons — Wed, 23 Nov 2011 13:25:44 GMT

You're assigning a z value to a point, not the circle. The circle is never given z values in your code. Making the circle geometry z-aware doesn't give it z values, it simply makes it so you CAN give it z values. You still have to assign an appropriate z value to each point in the geometry. There are several ways to do this so you'll have to choose the way that best suits what you're wanting to do.

Re: ConstructCircle - Run-time error '424' Object required. How to fix it?

MarAlcaraz1 — Wed, 23 Nov 2011 13:58:07 GMT

Ok, I understand I didn't say that my circle is on the xy plane, but ConstructCircle should have some parameter to indicate that, shouldn't it?

In any case, i don't know how to get at least two points from pFeature... could you help me, please?

Maybe creating a CircularArc with the same from-to points???

Re: ConstructCircle - Run-time error '424' Object required. How to fix it?

NeilClemmons — Wed, 23 Nov 2011 14:25:22 GMT

Z values can be assigned in various ways. One way is to get each point and assign it a value. All polygons are a collection of points which can be accessed via IPointCollection. You loop through each point in the collection and assign the value. You can also assign z values using the methods on the IZ interface. If you want all points in the geometry to have the same z value then call SetConstantZ. If you have a functional surface (i.e. from an elevation model) you can call InterpolateFromSurface. The other methods such as MultiplyZs and OffsetZs require that z values already be present.

One other thing I noticed in your code - you're specifying the circle to be counter-clockwise in your call to CreateCircle. A circle that is created CCW is considered a "hole" and will have a negative area. I don't know if this is what you want or not but thought I'd call it to your attention.

Re: ConstructCircle - Run-time error '424' Object required. How to fix it?

MarAlcaraz1 — Wed, 23 Nov 2011 14:49:06 GMT

And why is this not valid? It returns the same error on this third line...

Dim pIZ As IZ
Set pIZ = pPolygon
pIZ.SetConstantZ pRow.Value(lng_Elevation) - pRow.Value(lng_Bottom_Depth)

Re: ConstructCircle - Run-time error '424' Object required. How to fix it?

NeilClemmons — Wed, 23 Nov 2011 14:54:30 GMT

Where is this at in your code?

Re: ConstructCircle - Run-time error '424' Object required. How to fix it?

MarAlcaraz1 — Wed, 23 Nov 2011 15:08:11 GMT

Thanks Neil, I wrote it just above the declaration of pZAware, and it didn't work. I changed it just after pZAware and... IT WORKS!!!! Thank you Neil, I'm so grateful than I even considered send you an iberic ham.

I would like to share the right code with everybody:

Private Sub InterpretationTubes_Click()

Dim pSxDoc As ISxDocument
Set pSxDoc = ThisDocument

Dim pScene As IScene
Set pScene = pSxDoc.Scene

Dim i As Integer
For i = 0 To pScene.LayerCount - 1
If pScene.Layer(i).Name = "InterpretationTubes" Then
Dim pOutLayer As IFeatureLayer
Set pOutLayer = pScene.Layer(i)
End If
Next

Dim pFeatClass As IFeatureClass
Set pFeatClass = pOutLayer.FeatureClass

Dim pStandaloneTC As IStandaloneTableCollection
Set pStandaloneTC = pSxDoc.Scene

Dim pStandaloneT As IStandaloneTable
Set pStandaloneT = pStandaloneTC.StandaloneTable(0)

Dim lng_X, lng_Y, lng_Elevation, lng_SubUnits, lng_Top_Depth, lng_Bottom_Depth As Long

lng_X = pStandaloneT.Table.FindField("X")
lng_Y = pStandaloneT.Table.FindField("Y")
lng_Elevation = pStandaloneT.Table.FindField("Elevation")
lng_SubUnits = pStandaloneT.Table.FindField("SubUnits")
lng_Top_Depth = pStandaloneT.Table.FindField("Top_Depth")
lng_Bottom_Depth = pStandaloneT.Table.FindField("Bottom_Depth")
If (lng_X < 0) Or (lng_Y < 0) Or (lng_Elevation < 0) Or (lng_SubUnits < 0) Or (lng_Top_Depth < 0) Or (lng_Bottom_Depth < 0) Then
MsgBox "Could not find specified Fields"
Exit Sub
End If

Dim pCur As ICursor
Set pCur = pStandaloneT.Table.Search(Nothing, True)

Dim pRow As IRow
Set pRow = pCur.NextRow

Do While Not pRow Is Nothing

Dim pPointBot As IPoint
Set pPointBot = New Point

pPointBot.x = pRow.Value(lng_X)
pPointBot.y = pRow.Value(lng_Y)
pPointBot.Z = pRow.Value(lng_Elevation) - pRow.Value(lng_Bottom_Depth)

Dim pConstrCArc As IConstructCircularArc
Set pConstrCArc = New CircularArc

pConstrCArc.ConstructCircle pPointBot, 10, True

Dim pSegCol As ISegmentCollection
Set pSegCol = New Ring
pSegCol.AddSegment pConstrCArc

Dim pGeoCol As IGeometryCollection
Set pGeoCol = New polygon
pGeoCol.AddGeometry pSegCol

Dim pFeature As IFeature
Set pFeature = pFeatClass.CreateFeature

Dim pPolygon As IPolygon
Set pPolygon = pGeoCol

Dim pZAwarePoly As IZAware
Set pZAwarePoly = pPolygon
pZAwarePoly.ZAware = True

Dim pIZ As IZ
Set pIZ = pPolygon
pIZ.SetConstantZ (pRow.Value(lng_Elevation) - pRow.Value(lng_Bottom_Depth))

Set pFeature.Shape = pPolygon

pFeature.Value(3) = pRow.Value(lng_SubUnits)
pFeature.Value(4) = pRow.Value(lng_Bottom_Depth) - pRow.Value(lng_Top_Depth)
pFeature.Store

Set pRow = pCur.NextRow

Loop

pSxDoc.UpdateContents

pSxDoc.Scene.SceneGraph.Invalidate pOutLayer, True, True
pSxDoc.Scene.SceneGraph.RefreshViewers

End Sub