Hi everyone,I used a piece of code when I was using ArcGIS 9.2 to split lines into segments of no less than a given length.I am now using 9.3.1 and there is one line in the code that is giving me trouble. This line:For lInFld = 0 To pInRow.Fields.FieldCount â?? 1from the code below shows up in red, and when I run the code it causes a syntax error.Any help would be appreciatedPrivate Sub Proportion_Click()
'Divides a line feature class into segments no less than a specified amount
'Source: â??http://forums.esri.com/Thread.asp?c=93&f=986&t=264945&mc=1#msgid815131
' Make sure that the layer is an editable, projected, polyline, with features selected
Dim pEditor As IEditor
Set pEditor = Application.FindExtensionByName("ESRI Object Editor")
If pEditor.EditState <> esriStateEditing Then
MsgBox "start editing first"
Exit Sub
End If
Dim pEL As IEditLayers
Set pEL = pEditor
If pEL.CurrentLayer.FeatureClass.ShapeType <> esriGeometryPolyline Then
MsgBox "target layer must be polylines"
Exit Sub
End If
Dim pFSel As IFeatureSelection
Set pFSel = pEL.CurrentLayer
If pFSel.SelectionSet.Count = 0 Then
MsgBox "select some " & pEL.CurrentLayer.Name & " features first"
Exit Sub
End If
If Not TypeOf pEditor.Map.SpatialReference Is IProjectedCoordinateSystem Then
MsgBox ("set a projection first")
Exit Sub
End If
'get the user-defined minimum segment length
Dim dInterval As Double
dInterval = InputBox("Enter minimum segment length in meters", "Segment Length", 250)
' Set up a query to select features greater than the minimum segment length
Dim pQueryF As IQueryFilter
Set pQueryF = New QueryFilter
pQueryF.SubFields = "Length"
pQueryF.WhereClause = "Length > " & dInterval
'pEditor.StartOperation
Dim pFCur As IFeatureCursor
pFSel.SelectionSet.Search pQueryF, False, pFCur
Dim pFeat As IFeature
Set pFeat = pFCur.NextFeature
Do Until pFeat Is Nothing
Dim pPolyline As IPolyline
Set pPolyline = pFeat.ShapeCopy
pPolyline.Project pEditor.Map.SpatialReference
Dim l As Long
Dim Max As Integer
Max = Int(pPolyline.Length / dInterval)
For l = 0 To Max
Dim pOutCurve As ICurve
pPolyline.GetSubcurve (l - 1) / Max, l / Max, True, pOutCurve
Debug.Print pOutCurve.Length
pOutCurve.Project GetSR(pEL.CurrentLayer.FeatureClass)
If l = 0 Then
Set pFeat.Shape = pOutCurve
pFeat.Store
Else
Dim pNewFeat As IFeature
Set pNewFeat = pEL.CurrentLayer.FeatureClass.CreateFeature
CopyFields pFeat, pNewFeat
Set pNewFeat.Shape = pOutCurve
pNewFeat.Store
pFSel.Add pNewFeat
End If
Next l
Set pFeat = pFCur.NextFeature
'Show something in status bar
Dim pStatus As IStatusBar
Set pStatus = Application.StatusBar
pStatus.Message(0) = "Processing " & pOutCurve.Length
Loop
pEditor.StopOperation "split at " & dInterval
MsgBox ("Finished! Don't forget to save your edits!")
End Sub
Sub CopyFields(pInRow As IRow, pOutRow As IRow)
Dim lInFld As Long
For lInFld = 0 To pInRow.Fields.FieldCount â?? 1 <--- This line causes trouble!
Dim lOutFld As Long
lOutFld = pOutRow.Fields.FindField(pInRow.Fields.Field(lInFld).Name)
If lOutFld > -1 Then
If pInRow.Fields.Field(lInFld).Editable Then
If pInRow.Fields.Field(lInFld).Type <> esriFieldTypeGeometry Then
pOutRow.Value(lOutFld) = pInRow.Value(lInFld)
End If
End If
End If
Next lInFld
End Sub
Function GetSR(pGDS As IGeoDataset) As ISpatialReference
Set GetSR = pGDS.SpatialReference
End Function