使用API在Scene或Globe中画橡皮条线

<P><FONT style="BACKGROUND-COLOR: rgb(204,232,207)" face=Verdana>在Scene或Globe中绘制橡皮条线的工具，其中wsUtilityBaseTool是我自己封装的基类，<BR>大家只需要把它替换成AE的<FONT style="BACKGROUND-COLOR: rgb(204,232,207)" face=Verdana>BaseTool，把其中相应的代码放在相应的函数中,然后再进行一些简单的修改就好了<BR>附上VB.Net源码<BR></FONT><BR>Imports ESRI.ArcGIS.Analyst3D<BR>Imports ESRI.ArcGIS.Carto<BR>Imports ESRI.ArcGIS.Controls<BR>Imports ESRI.ArcGIS.Display<BR>Imports ESRI.ArcGIS.Geometry<BR>Imports ESRI.ArcGIS.GlobeCore<BR>Imports ESRI.ArcGIS.SystemUI<BR></FONT></P>
<P><FONT style="BACKGROUND-COLOR: rgb(204,232,207)" face=Verdana>Public Class wsSceneDrawLine<BR>  Inherits wsUtilityBaseTool</FONT></P>
<P>  Private Declare Function Polygon Lib "gdi32" (ByVal hDC As Integer, ByVal lpPoint As Integer, ByVal nCount As Integer) As Integer<BR>  Private Declare Function SetCapture Lib "USER32" (ByVal hWnd As Integer) As Integer<BR>  Private Declare Function GetCapture Lib "USER32" () As Integer<BR>  Private Declare Function ReleaseCapture Lib "USER32" () As Integer<BR>  Private Declare Function GetCursorPos Lib "USER32" (ByVal lpPoint As PointAPI) As Integer<BR>  Private Declare Function SetCursor Lib "USER32" (ByVal hCursor As Integer) As Integer<BR>  Private Declare Function GetClientRect Lib "USER32" (ByVal hWnd As Integer, ByVal lpRect As rect) As Integer<BR>  Private Declare Function GetWindowRect Lib "USER32" (ByVal hWnd As Integer, ByVal lpRect As rect) As Integer<BR>  Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Integer, ByVal nWidth As Integer, ByVal crColor As Integer) As Integer<BR>  Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Integer) As Integer<BR>  Private Declare Function GetROP2 Lib "gdi32" (ByVal hDC As Integer) As Integer<BR>  Private Declare Function SetROP2 Lib "gdi32" (ByVal hDC As Integer, ByVal nDrawMode As Integer) As Integer<BR>  Private Declare Function Rectangle Lib "gdi32" (ByVal hDC As Integer, ByVal X1 As Integer, ByVal Y1 As Integer, ByVal X2 As Integer, ByVal Y2 As Integer) As Integer<BR>  Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Integer, ByVal hObject As Integer) As Integer<BR>  Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Integer) As Integer<BR>  Private Declare Function Polyline Lib "gdi32" (ByVal hDC As Integer, ByVal lpPoint() As PointAPI, ByVal nCount As Integer) As Integer<BR>  Private Declare Function CreatePolygonRgn Lib "gdi32" (ByVal lpPoint As Integer, ByVal nCount As Integer, ByVal nPolyFillMode As Integer) As Integer<BR>  Private Structure rect<BR>    Dim Left As Integer<BR>    Dim Top As Integer<BR>    Dim Right As Integer<BR>    Dim Bottom As Integer<BR>  End Structure<BR>  Private Structure PointAPI<BR>    Dim x As Integer<BR>    Dim y As Integer<BR>  End Structure</P>
<P><FONT style="BACKGROUND-COLOR: rgb(204,232,207)" face=Verdana>  Private m_pSceneHookhelper As ISceneHookHelper<BR>  Private m_pGlobeHookhelper As IGlobeHookHelper<BR>  Private m_bInUse As Boolean<BR>  Private m_Pen As Long, m_Brush As Long<BR>  Private m_lDrawMode As Long<BR>  Private m_pUserLine As IPointCollection<BR>  Private m_pGeoLine As IPointCollection<BR>  Private m_MovePoint_Old As IPoint '当前点<BR>  Private m_pScene As IScene<BR>  Private m_pSceneViewer As ISceneViewer<BR>  <BR>  Public Sub New()<BR>    MyBase.New()<BR>    MyBase.Tool = New ControlsScenePanTool<BR>    MyBase.m_Caption = "画线"<BR>    MyBase.m_ToolTip = "画线"<BR>    MyBase.m_Name = "画线"<BR>    MyBase.m_Message = "画线"<BR>    m_pSceneHookHelper = New SceneHookHelper<BR>  End Sub</FONT></P>
<P><FONT style="BACKGROUND-COLOR: rgb(204,232,207)" face=Verdana><FONT style="BACKGROUND-COLOR: rgb(204,232,207)" face=Verdana>  Public Overrides Sub OnCreate(ByVal hook As Object)<BR>    m_pSceneHookhelper = New SceneHookHelper<BR>    m_pSceneHookhelper.Hook = hook<BR>    m_pSceneViewer = m_pSceneHookhelper.ActiveViewer<BR>    m_pScene = m_pSceneHookhelper.Scene<BR>    If m_pScene Is Nothing Then<BR>      m_pGlobeHookhelper = New GlobeHookHelper<BR>      m_pGlobeHookhelper.Hook = hook<BR>      m_pSceneViewer = m_pGlobeHookhelper.ActiveViewer<BR>      m_pScene = m_pGlobeHookhelper.Globe<BR>    End If<BR>  End Sub</FONT><BR>  Public Overrides ReadOnly Property Enabled() As Boolean<BR>    Get<BR>      If (m_pSceneHookhelper.Scene Is Nothing) Then<BR>        Return False<BR>      Else<BR>        Return True<BR>      End If<BR>    End Get<BR>  End Property</FONT></P><FONT style="BACKGROUND-COLOR: rgb(204,232,207)" face=Verdana>
<P><BR>  Public Overrides Sub OnMouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Integer, ByVal Y As Integer)<BR>    Dim pGeoPoint As IPoint<BR>    pGeoPoint = GetGeoPointByScene(m_pScene, X, Y, m_pUserLine)<BR>    If pGeoPoint Is Nothing Then Exit Sub<BR>    m_bInUse = True</P>
<P>    Dim pStartPoint As IPoint<BR>    pStartPoint = New Point<BR>    pStartPoint.PutCoords(X, Y)</P>
<P>    m_pUserLine.AddPoint(pStartPoint)<BR>    m_pGeoLine.AddPoint(pGeoPoint)</P>
<P>    m_Pen = CreatePen(0, 2, 0)   'A solid, width of 2 black pen<BR>    m_Brush = GetStockObject(5)  'A hollow brush</P>
<P>    m_lDrawMode = GetROP2(m_pSceneViewer.hDC)<BR>    SelectObject(m_pSceneViewer.hDC, m_Pen)<BR>    SelectObject(m_pSceneViewer.hDC, m_Brush)<BR>    SetROP2(m_pSceneViewer.hDC, 14)<BR>    SetCapture(m_pSceneViewer.hWnd)<BR>  End Sub</P>
<P>  Public Overrides Sub OnMouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Integer, ByVal Y As Integer)<BR>    If Not m_bInUse Then Exit Sub<BR>    DrawLine(X, Y)<BR>  End Sub</P>
<P>  Public Overrides Sub OnMouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Integer, ByVal Y As Integer)</P>
<P>  End Sub<BR>  Public Overrides Sub OnClick()<BR>    MyBase.OnClick()<BR>    'Not implemented<BR>    m_pUserLine = New Polyline<BR>    m_pGeoLine = New Polyline<BR>  End Sub<BR>  Public Overrides Sub OnDblClick()<BR>    MyBase.OnDblClick()<BR>    If Not m_bInUse Then Exit Sub<BR>    If GetCapture = m_pSceneViewer.hWnd Then<BR>      ReleaseCapture()<BR>    End If<BR>    m_MovePoint_Old = Nothing<BR>    m_pUserLine = New Polyline<BR>    m_pGeoLine = New Polyline<BR>    m_pSceneViewer.Redraw(True)</P>
<P>    DeleteObject(m_Pen)<BR>    DeleteObject(m_Brush)<BR>    SetROP2(m_pSceneViewer.hDC, m_lDrawMode)<BR>    m_bInUse = False<BR>  End Sub<BR>  Public Overrides Sub OnKeyDown(ByVal keyCode As Integer, ByVal shift As Integer)<BR>    MyBase.OnKeyDown(keyCode, shift)<BR>    If m_bInUse = True Then<BR>      If keyCode = 0 Then<BR>        m_pSceneViewer.Redraw(True)<BR>        m_MovePoint_Old = Nothing<BR>        m_pUserLine = New Polyline<BR>        m_pGeoLine = New Polyline<BR>        'GDI calls to delete pen and brush objects<BR>        DeleteObject(m_Pen)<BR>        DeleteObject(m_Brush)<BR>        'GDI call to set device to the original draw mode<BR>        SetROP2(m_pSceneViewer.hDC, m_lDrawMode)<BR>        ReleaseCapture()<BR>        m_bInUse = False<BR>      End If<BR>    End If<BR>  End Sub<BR>  Public Sub DrawLine(ByVal x As Long, ByVal y As Long)<BR>    Dim pPtNums As Long<BR>    pPtNums = m_pUserLine.PointCount<BR>    Dim Pts() As PointAPI<BR>    ReDim Pts(pPtNums) 'As PointAPI<BR>    Dim i As Long<BR>    Dim pPoint As IPoint<BR>    For i = 0 To pPtNums - 1<BR>      pPoint = m_pUserLine.Point(i)<BR>      Pts(i).x = pPoint.X : Pts(i).y = pPoint.Y<BR>    Next<BR>    If Not m_MovePoint_Old Is Nothing Then<BR>      Pts(pPtNums).x = m_MovePoint_Old.X : Pts(pPtNums).y = m_MovePoint_Old.Y<BR>      Polyline(m_pSceneViewer.hDC, Pts, pPtNums + 1)<BR>    End If<BR>    Pts(pPtNums).x = x : Pts(pPtNums).y = y<BR>    Polyline(m_pSceneViewer.hDC, Pts, pPtNums + 1)<BR>    m_MovePoint_Old = New Point<BR>    m_MovePoint_Old.PutCoords(x, y)<BR>  End Sub  <BR>Private Function GetGeoPointByScene(ByVal pScene As IScene, ByVal x As Long, ByVal y As Long, Optional ByVal CheckPointDou As IPointCollection = Nothing) As IPoint</P>
<P>    Dim i As Long<BR>    Dim pPoint As IPoint<BR>    If Not CheckPointDou Is Nothing Then<BR>      For i = 0 To CheckPointDou.PointCount - 1<BR>        pPoint = CheckPointDou.Point(i)<BR>        If pPoint.X = x And pPoint.Y = y Then<BR>          Return Nothing<BR>          Exit Function<BR>        End If<BR>      Next<BR>    End If<BR>    Return LocatePoint(pScene, x, y)<BR>  End Function<BR>  Private Function LocatePoint(ByVal pScene As IScene, ByVal x As Long, ByVal y As Long) As IPoint<BR>    If TypeOf pScene Is IGlobe Then<BR>      Dim pGlobe As IGlobe<BR>      pGlobe = pScene<BR>      Return GlobeToPoint(pGlobe.GlobeDisplay, x, y, True)<BR>    ElseIf TypeOf pScene Is IScene Then<BR>      Return XYToPoint(pScene.SceneGraph, x, y)<BR>    Else<BR>      Return Nothing<BR>    End If<BR>  End Function</P>
<P>  Private Function GlobeToPoint(ByVal pGlobeDisplay As IGlobeDisplay, ByVal dx As Long, ByVal dy As Long, ByVal bMaxResolution As Boolean, Optional ByVal pOffset As Double = 0) As IPoint<BR>    On Error GoTo errhandler<BR>    Dim pPoint As IPoint = Nothing<BR>    Dim objectOwner As stdole.IUnknown = Nothing<BR>    Dim objectObject As stdole.IUnknown = Nothing<BR>    pGlobeDisplay.Locate(pGlobeDisplay.ActiveViewer, dx, dy, False, True, pPoint, objectOwner, objectObject)<BR>    If pPoint Is Nothing Then<BR>      Return Nothing<BR>      Exit Function<BR>    Else<BR>      If pPoint.IsEmpty Then<BR>        Return Nothing<BR>        Exit Function<BR>      End If<BR>    End If<BR>    pPoint.Z = pPoint.Z * 1000<BR>    Return pPoint<BR>    Exit Function</P>
<P>errhandler:<BR>  End Function<BR>  Private Function XYToPoint(ByVal pSceneGraph As SceneGraph, ByVal x As Long, ByVal y As Long) As IPoint</P>
<P>    Dim pSG As ISceneGraph<BR>    pSG = pSceneGraph<BR>    Dim pViewer As ISceneViewer<BR>    pViewer = pSG.ActiveViewer<BR>    Dim pOwner As stdole.IUnknown = Nothing<BR>    Dim pObject As stdole.IUnknown = Nothing<BR>    Dim pPoint As IPoint = Nothing<BR>    pSG.Locate(pViewer, x, y, esriScenePickMode.esriScenePickGeography, True, pPoint, pOwner, pObject)<BR>    pOwner = Nothing<BR>    pObject = Nothing<BR>    Return pPoint<BR>  End Function</P></FONT>
<P><FONT style="BACKGROUND-COLOR: rgb(204,232,207)" face=Verdana>End Class</FONT></P>

谢谢你的共享，我现在在MapControl里做了一个橡皮线，用的是inewlinefeedback,我想同时能用右键做Pan功能，但是一旦视图刷新，前面绘制的线段就在视图上消失了，有什么好的解决办法吗， 谢谢啦。

lz转载请注明出处，<a href="http://www.cnblogs.com/wall/archive/2008/05/28/1209391.html" target="_blank" >http://www.cnblogs.com/wall/archive/2008/05/28/1209391.html</A>

<P>看不太明白  所有函数都被封装成lib了   代码没什么意思  希望博主能讲一下思路</P>

<P>所有代码都被封装成lib是什么意思?</P>
<P>那些是引用的windows的api，不是我自己封装的</P>
<P>你用过api吗????????</P>
<P>这个思路已经很清楚了，就是用windows的api来绘制线</P>