ArcGIS VBA 顺序点连接成线小程序.pdfVIP

ArcGIS VBA 顺序点连接成线小程序 去年编了一个点连线的，结果重装系统时全没了。现在编的这个超不智能，不过由于时 间关系只要实现了点连成线我也知足了。保存在这防止以后再丢了。说句实话现学现编真麻 烦，以后有时间真得系统学下。 说明：新建UIToolControl1．点按照顺序连接。 复制以下代码。 Private Sub UIToolControl1_Select() Dim pMxdoc As IMxDocument Dim pMap As IMap Dim pfLayer_pt As IFeatureLayer Dim pPoint As IPoint Dim pLine As IPolyline Dim pLayer_pl As IFeatureLayer Dim pfclass As IFeatureClass Dim pMultiPts As IPointCollection Dim pFeature As IFeature Dim ptFeature As IFeature Dim myCursor As IFeatureCursor Dim i As Long Dim pQFilter As IQueryFilter Set pQFilter = New QueryFilter 点图层在上，线图层在下 Set pMxdoc = ThisDocument Set pMap = pMxdoc.FocusMap Set pfLayer_pt = pMap.Layer(0) Set pMultiPts = New Multipoint Set pMultiPts = New Polyline pQFilter.WhereClause = FID = 0 Set myCursor = pfLayer_pt.FeatureClass.Search(pQFilter, True) Set ptFeature = myCursor.NextFeature Do While Not ptFeature Is Nothing Set pPoint = ptFeature.Shape pMultiPts.AddPoint pPoint Set ptFeature = myCursor.NextFeature Loop Set pLine = pMultiPts Set pLayer_pl = pMap.Layer(1) Set pfclass = pLayer_pl.FeatureClass Set pFeature = pfclass.CreateFeature 把画的polyline 加到新建的Feature 上 Set pFeature.Shape = pLine pFeature.Store pMxdoc.ActiveView.Refresh End Sub 加载要连接的点图层及空线图层（唉，太不智能了）。可能有多余的变量，懒得查了。 代码环境ＡrcGIS 9.2 下的VBA 。另外，据查XTools 功能强大，解决这个小功能不在 话下，不过好像需要破解。 感谢在编代码过程中提供帮助的同学们，特别是小印同学。 相关链接：/blog/static/44266152201021661547526/