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