沿线形特征推进程序的延伸

已经掌握了沿线形特征延伸的方法，在线形特征上已经画了一条线，可是现在想要把线形图层中的所有线都画出来，则不行，不能跳转到下一个线特征上，只能画第一条。如何处理呢？

  Dim p1 As MapObjects2.Point

  Dim line

  Set recs_3 = Map1.Layers("yh_run_sd").Records

  If Map1.Layers("yh_run_sd").Visible = True Then

    Set line = recs_3.Fields("shape").Value  

    Set shape_points_1 = New MapObjects2.Points

    For Each shape_point_1 In line.Parts(0)

      shape_points_1.Add shape_point_1

    Next shape_point_1

    m_nNum = 0

    Timer1.Interval = 500

  End If

<img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em02.gif" />

<P>records.recordset.movenext</P><P>上面代码可能有错，电脑上没mo，不过把记录移到下一个应该就可以了</P>

十分之感谢！我试试！<img src="images/post/smile/dvbbs/em01.gif" />

放在哪里呢？还是困惑中*********<img src="images/post/smile/dvbbs/em01.gif" /><img src="images/post/smile/dvbbs/em01.gif" /><img src="images/post/smile/dvbbs/em01.gif" />

<P>应该是循环你上面的那段程序吧？</P><P>你首先获得记录的数目，然后在记录数中循环</P><P>当你做完你要做的事情，就移动到下一个记录</P>

  Dim p1 As MapObjects2.Point
  Dim line
  Set shape_points_1 = New MapObjects2.Points
  Set recs_3 = Map1.Layers("yh_run_sd").SearchExpression("id<3")
Do While Not recs_3.EOF
  If Map1.Layers("yh_run_sd").Visible = True Then
  
    Set line = recs_3.Fields("shape").Value  'value＝1定义其为线形特征
    For Each shape_point_1 In line.Parts(0)
      shape_points_1.Add shape_point_1
    Next shape_point_1
  
    m_nNum = 0
    Timer2.Interval = 500
   End If
  recs_3.MoveNext
 Loop

这样子搞定了！！