最近碰到有一个数据处理的要求，需要针对线对象批量的内插生成点对象，本想自己写算法，后来发现AO中已提供接口实现，省事了
将点层放在第一层，在toc中选择要内插的线层，然后运行如下vba程序
该程序也适用于面对沿边线内插，关键接口IConstructMultipoint，方法ConstructDivideEqual 是指定个数，方法ConstructDivideEqual 是等距内插，自动计算内插个数。它支持等距内插和设定内插点个数两种方式，需要注意一点，起点和终点作为默认点，如果是设定内插点个数的，要在目标个数基础上减2，帮助中明确说是内部点个数作为输入参数
GetInterPointNum函数是自定义的，目的是获取需要内插点的个数
Public Sub CreatePointsAlongCurve()
Dim pMxDoc As IMxDocument
Set pMxDoc = ThisDocument
Dim pMap As IMap
Set pMap = pMxDoc.FocusMap
Dim pInGeometry As IGeometry
Dim pInLayer As ILayer
Dim pInFLayer As IFeatureLayer
Dim pOutFLayer As IFeatureLayer
Dim pInFCursor As IFeatureCursor
Dim pOutFCursor As IFeatureCursor
Dim pOutFBuffer As IFeatureBuffer
Dim pInFClass As IFeatureClass
Dim pOutFClass As IFeatureClass
Dim pSelSet As ISelectionSet
Dim pFSelection As IFeatureSelection
Dim pInFeature As IFeature
Dim pCurve As ICurve
Dim pPointCollection As IPointCollection
Dim pConstructMultipoint As IConstructMultipoint
Dim i As Long, lAID As Long
Dim pPointDist As Double
Dim pPolyline As IPolyline
Dim dLength As Double
Set pInLayer = pMxDoc.SelectedLayer
If pInLayer Is Nothing Then
MsgBox "请在TOC中选择要转换的图层", vbCritical, "错误提示"
Exit Sub
End If
If TypeOf pInLayer Is IFeatureLayer Then
Set pInFLayer = pMxDoc.SelectedLayer
Else
MsgBox "必须选择矢量要素类图层", vbCritical, "错误提示"
Exit Sub
End If
Set pOutFLayer = pMap.Layer(0)
Set pInFClass = pInFLayer.FeatureClass
Set pOutFClass = pOutFLayer.FeatureClass
If Not pOutFClass.ShapeType = esriGeometryPoint Then
MsgBox "目标图层非点图层", vbCritical, "错误提示"
Exit Sub
End If
Set pFSelection = pInFLayer
Set pSelSet = pFSelection.SelectionSet
Set pOutFBuffer = pOutFClass.CreateFeatureBuffer
Set pOutFCursor = pOutFClass.Insert(True)
Set pInFCursor = pInFLayer.Search(Nothing, False)
Set pInFeature = pInFCursor.NextFeature
Do While Not pInFeature Is Nothing
Set pInGeometry = pInFeature.Shape
lAID = pInFeature.Value(2)
Set pCurve = pInGeometry
dLength = pCurve.Length
Set pConstructMultipoint = New Multipoint
pConstructMultipoint.ConstructDivideEqual pCurve, GetInterPointNum(dLength, lAID) - 2
Set pPointCollection = pConstructMultipoint
For i = 0 To pPointCollection.PointCount - 1
Set pOutFBuffer.Shape = pPointCollection.Point(i)
pOutFCursor.InsertFeature pOutFBuffer
Next i
Set pInFeature = pInFCursor.NextFeature
Loop
pMxDoc.ActiveView.Refresh
MsgBox "over"
Exit Sub
End Sub