阅读:1579回复:1
如何实现在已加载的图层上实现捕捉算法?
<P>请教各位高手,我刚开始接触mo,现在用vb在编捕捉算法。</P>
<P>我现在能够把.shp文件,加载道map控件中,但是我要是现在已加载.shp图像中捕捉直线或曲线交点,不知怎样才能才能控制图像中的point,line,或polygon,请高手指点,最好能有个例子,谢谢!</P> |
|
1楼#
发布于:2005-06-23 10:42
'*******************************************************************************<br>'【名 称】:CatchPoint()<br>'【功 能】:节点捕捉<br>'【参 数】:myMap : MapObjects地图对象<br>' myPt : 鼠标落下的位置点<br>'【返回值】:若捕捉到了节点则返回True;否则返回False<br>'******************************************************************************<br>Public Function CatchPoint(myMap As MapObjects2.Map, myPt As MapObjects2.point) As Boolean<br> CatchPoint = False<br> <br> Dim myRecs As MapObjects2.Recordset<br> Dim Pt As MapObjects2.point: Dim cPt As MapObjects2.point<br> Dim lyr As Object<br> <br> '//搜索距离<br> Dim sDis As Double: sDis = myMap.ToMapDistance(100)<br> <br> '//比较距离<br> Dim mDis As Double: mDis = sDis<br> <br> Dim dis As Double<br> For Each lyr In myMap.Layers<br> If lyr.LayerType = moMapLayer And lyr.Visible Then<br> '//取得与直线相交的管线数据<br> Set myRecs = lyr.SearchByDistance(myPt, sDis, "")<br> <br> If Not myRecs Is Nothing Then<br> <br> If Not myRecs.EOF Then<br> <br> Select Case lyr.ShapeType<br> Case moShapeTypePoint '//点图元<br> Do While Not myRecs.EOF<br> Set Pt = myRecs.Fields("shape").value<br> dis = Pt.DistanceTo(myPt)<br> If dis < mDis Then mDis = dis: Set cPt = Pt<br> myRecs.MoveNext<br> Loop<br> Case moShapeTypeLine '//线图元<br> Do While Not myRecs.EOF<br> For Each Pt In myRecs.Fields("shape").value.Parts(0)<br> dis = Pt.DistanceTo(myPt)<br> If dis < mDis Then mDis = dis: Set cPt = Pt<br> Next<br> myRecs.MoveNext<br> Loop<br> Case moShapeTypePolygon '//面图元<br> Do While Not myRecs.EOF<br> For Each Pt In myRecs.Fields("shape").value.Parts(0)<br> dis = Pt.DistanceTo(myPt)<br> If dis < mDis Then mDis = dis: Set cPt = Pt<br> Next<br> myRecs.MoveNext<br> Loop<br> End Select<br> <br> End If<br> <br> End If<br> <br> End If<br> <br> Next<br> <br> If cPt Is Nothing Then<br> If myMap.TrackingLayer.EventCount > 0 Then myMap.TrackingLayer.RemoveEvent 0<br> Set CatchPt = Nothing<br> Exit Function<br> Else<br> CatchPoint = True<br> Set CatchPt = cPt<br> End If<br> <br>' If Not CatchPt Is Nothing Then<br>' CatchPoint = True<br>' Else<br>' If myMap.TrackingLayer.EventCount > 0 Then myMap.TrackingLayer.RemoveEvent 0<br>' Exit Function<br>' End If<br> <br> With myMap.TrackingLayer.Symbol(0)<br> .SymbolType = moPointSymbol<br> .style = moCrossMarker<br> .Size = 25<br> .Color = ;H404040<br> End With<br> If myMap.TrackingLayer.EventCount > 0 Then myMap.TrackingLayer.RemoveEvent 0<br> myMap.TrackingLayer.AddEvent CatchPt, 0<br>End Function
[此贴子已经被作者于2005-6-23 10:44:29编辑过]
|
|