|
阅读：1731回复：5
关于activex dll编写(独立程序，脱离ArcMap.exe)
<P>我改写了一个例程(activex dll),用TToolBarControl调用,但调试是报“实时错误”，代码如下：</P>
<P>Option Explicit</P> <P>'Windows API functions to capture mouse and keyboard<BR>'input to a window when the mouse is outside the window<BR>Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long<BR>Private Declare Function GetCapture Lib "user32" () As Long<BR>Private Declare Function ReleaseCapture Lib "user32" () As Long</P> <P>Implements ICommand<BR>Implements ITool</P> <P>Private m_pHookHelper As IHookHelper<BR>'Private m_pApp As IApplication<BR>Private m_bInUse As Boolean<BR>Private m_pLineSymbol As ILineSymbol<BR>Private m_pLinePolyline As IPolyline<BR>Private m_pTextSymbol As ITextSymbol<BR>Private m_pStartPoint As IPoint<BR>Private m_pTextPoint As IPoint</P> <P>Private Sub Class_Initialize()<BR> Set m_pHookHelper = New HookHelper<BR>End Sub</P> <P>Private Property Get ICommand_Bitmap() As esriSystem.OLE_HANDLE<BR> ICommand_Bitmap = frmResources.imlBitmaps.ListImages(1).Picture<BR>End Property</P> <P>Private Property Get ICommand_Caption() As String<BR> ICommand_Caption = "Measure Tool"<BR>End Property</P> <P>Private Property Get ICommand_Category() As String<BR> ICommand_Category = "Developer Samples"<BR>End Property</P> <P>Private Property Get ICommand_Checked() As Boolean</P> <P>End Property</P> <P>Private Property Get ICommand_Enabled() As Boolean<BR> ICommand_Enabled = True<BR>End Property</P> <P>Private Property Get ICommand_HelpContextID() As Long</P> <P>End Property</P> <P>Private Property Get ICommand_HelpFile() As String</P> <P>End Property</P> <P>Private Property Get ICommand_Message() As String<BR> ICommand_Message = "Measure Distance Tool"<BR>End Property</P> <P>Private Property Get ICommand_Name() As String<BR> ICommand_Name = "Developer Samples_Measure Tool"<BR>End Property</P> <P>Private Sub ICommand_OnClick()</P> <P>End Sub</P> <P>Private Sub ICommand_OnCreate(ByVal hook As Object)<BR> 'Set m_pApp = hook<BR> Set m_pHookHelper.hook = hook<BR> 'Set m_pApp = m_pHookHelper.hook<BR>End Sub</P> <P>Private Property Get ICommand_Tooltip() As String<BR> ICommand_Tooltip = "Measure Tool"<BR>End Property</P> <P>Private Property Get ITool_Cursor() As esriSystem.OLE_HANDLE<BR> ITool_Cursor = frmResources.imlBitmaps.ListImages(2).Picture<BR>End Property</P> <P>Private Function ITool_Deactivate() As Boolean<BR> ' stop doing operation<BR> Set m_pTextSymbol = Nothing<BR> Set m_pTextPoint = Nothing<BR> Set m_pLinePolyline = Nothing<BR> Set m_pLineSymbol = Nothing<BR> m_bInUse = False</P> <P> ITool_Deactivate = True<BR>End Function</P> <P>Private Function ITool_OnContextMenu(ByVal X As Long, ByVal Y As Long) As Boolean</P> <P>End Function</P> <P>Private Sub ITool_OnDblClick()</P> <P>End Sub</P> <P>Private Sub ITool_OnKeyDown(ByVal keyCode As Long, ByVal Shift As Long)</P> <P>End Sub</P> <P>Private Sub ITool_OnKeyUp(ByVal keyCode As Long, ByVal Shift As Long)</P> <P>End Sub</P> <P>Private Sub ITool_OnMouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long)<BR> If (m_pHookHelper.ActiveView Is Nothing) Then Exit Sub</P> <P> m_bInUse = True<BR> 'Dim pMxDoc As IMxDocument<BR> Dim pActiveView As esriCarto.IActiveView<BR> 'Set pMxDoc = m_pApp.Document<BR> 'Set pActiveView = pMxDoc.FocusMap<BR> Set pActiveView = m_pHookHelper.FocusMap<BR> <BR> 'Get point to measure distance from<BR> Set m_pStartPoint = pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(X, Y)<BR> <BR> 'Start capturing mouse events<BR> SetCapture m_pHookHelper.ActiveView.ScreenDisplay.hWnd<BR>End Sub</P> <P>Private Sub ITool_OnMouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long)<BR> If (Not m_bInUse) Then Exit Sub<BR> <BR> 'Dim pMxDoc As IMxDocument<BR> Dim pActiveView As esriCarto.IActiveView<BR> 'Set pMxDoc = m_pApp.Document<BR> 'Set pActiveView = pMxDoc.FocusMap<BR> Set pActiveView = m_pHookHelper.FocusMap<BR> <BR> Dim bfirstTime As Boolean<BR> If (m_pLineSymbol Is Nothing) Then bfirstTime = True<BR> <BR> 'Get current point<BR> Dim pPoint As IPoint<BR> Set pPoint = pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(X, Y)<BR> <BR> pActiveView.ScreenDisplay.StartDrawing pActiveView.ScreenDisplay.hDC, -1<BR> <BR> If bfirstTime Then<BR> Dim pRGBColor As IRgbColor<BR> Dim pSymbol As ISymbol<BR> Dim pFont As IFontDisp<BR> <BR> 'Line Symbol<BR> Set m_pLineSymbol = New SimpleLineSymbol<BR> m_pLineSymbol.Width = 2<BR> Set pRGBColor = New RgbColor<BR> With pRGBColor<BR> .Red = 223<BR> .Green = 223<BR> .Blue = 223<BR> End With<BR> m_pLineSymbol.Color = pRGBColor<BR> Set pSymbol = m_pLineSymbol<BR> pSymbol.ROP2 = esriROPXOrPen<BR> <BR> 'Text Symbol<BR> Set m_pTextSymbol = New TextSymbol<BR> m_pTextSymbol.HorizontalAlignment = esriTHACenter<BR> m_pTextSymbol.VerticalAlignment = esriTVACenter<BR> m_pTextSymbol.Size = 16<BR> Set pSymbol = m_pTextSymbol<BR> Set pFont = m_pTextSymbol.Font<BR> pFont.Name = "Arial"<BR> pSymbol.ROP2 = esriROPXOrPen<BR> <BR> 'Create point to draw text in<BR> Set m_pTextPoint = New Point<BR> <BR> Else<BR> 'Use existing symbols and draw existing text and polyline<BR> pActiveView.ScreenDisplay.SetSymbol m_pTextSymbol<BR> pActiveView.ScreenDisplay.DrawText m_pTextPoint, m_pTextSymbol.Text<BR> pActiveView.ScreenDisplay.SetSymbol m_pLineSymbol<BR> If (m_pLinePolyline.Length > 0) Then _<BR> pActiveView.ScreenDisplay.DrawPolyline m_pLinePolyline<BR> End If</P> <P> 'Get line between from and to points, and angle for text<BR> Dim pLine As ILine<BR> Set pLine = New esriGeometry.Line<BR> pLine.PutCoords m_pStartPoint, pPoint<BR> Dim angle As Double<BR> angle = pLine.angle<BR> angle = angle * (180# / 3.14159)<BR> If ((angle > 90#) And (angle < 180#)) Then<BR> angle = angle + 180#<BR> ElseIf ((angle < 0#) And (angle < -90#)) Then<BR> angle = angle - 180#<BR> ElseIf ((angle < -90#) And (angle > -180)) Then<BR> angle = angle - 180#<BR> ElseIf (angle > 180) Then<BR> angle = angle - 180#<BR> End If</P> <P><BR> 'For drawing text, get text(distance), angle, and point<BR> Dim deltaX As Double<BR> Dim deltaY As Double<BR> Dim distance As Double<BR> deltaX = pPoint.X - m_pStartPoint.X<BR> deltaY = pPoint.Y - m_pStartPoint.Y<BR> m_pTextPoint.X = m_pStartPoint.X + deltaX / 2#<BR> m_pTextPoint.Y = m_pStartPoint.Y + deltaY / 2#<BR> m_pTextSymbol.angle = angle<BR> distance = Round(Sqr((deltaX * deltaX) + (deltaY * deltaY)), 3)<BR> m_pTextSymbol.Text = "[" ; distance ; "]"<BR> <BR> 'Draw text<BR> pActiveView.ScreenDisplay.SetSymbol m_pTextSymbol<BR> pActiveView.ScreenDisplay.DrawText m_pTextPoint, m_pTextSymbol.Text<BR> <BR> <BR> 'Get polyline with blank space for text<BR> Dim pPolyLine As IPolyline<BR> Set pPolyLine = New Polyline<BR> Dim pSegColl As ISegmentCollection<BR> Set pSegColl = pPolyLine<BR> pSegColl.AddSegment pLine<BR> Set m_pLinePolyline = GetSmashedLine(pActiveView.ScreenDisplay, m_pTextSymbol, m_pTextPoint, pPolyLine)<BR> <BR> 'Draw polyline<BR> pActiveView.ScreenDisplay.SetSymbol m_pLineSymbol<BR> If (m_pLinePolyline.Length > 0) Then _<BR> pActiveView.ScreenDisplay.DrawPolyline m_pLinePolyline<BR> <BR> pActiveView.ScreenDisplay.FinishDrawing</P> <P>End Sub</P> <P>Private Sub ITool_OnMouseUp(ByVal Button As Long, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long)<BR> If (Not m_bInUse) Then Exit Sub<BR> m_bInUse = False<BR> <BR> If (m_pLineSymbol Is Nothing) Then Exit Sub<BR> <BR> 'Stop capturing mouse events<BR> If GetCapture = m_pHookHelper.ActiveView.ScreenDisplay.hWnd Then<BR> ReleaseCapture<BR> End If</P> <P> <BR> 'Dim pMxDoc As IMxDocument<BR> Dim pActiveView As esriCarto.IActiveView<BR> 'Set pMxDoc = m_pApp.Document<BR> 'Set pActiveView = pMxDoc.FocusMap<BR> Set pActiveView = m_pHookHelper.FocusMap<BR> <BR> 'Draw measure line and text<BR> pActiveView.ScreenDisplay.StartDrawing pActiveView.ScreenDisplay.hDC, -1<BR> pActiveView.ScreenDisplay.SetSymbol m_pTextSymbol<BR> pActiveView.ScreenDisplay.DrawText m_pTextPoint, m_pTextSymbol.Text<BR> pActiveView.ScreenDisplay.SetSymbol m_pLineSymbol<BR> If (m_pLinePolyline.Length > 0) Then pActiveView.ScreenDisplay.DrawPolyline m_pLinePolyline<BR> pActiveView.ScreenDisplay.FinishDrawing<BR> <BR> Set m_pTextSymbol = Nothing<BR> Set m_pTextPoint = Nothing<BR> Set m_pLinePolyline = Nothing<BR> Set m_pLineSymbol = Nothing<BR>End Sub</P> <P>Private Sub ITool_Refresh(ByVal hDC As esriSystem.OLE_HANDLE)</P> <P>End Sub</P> <P>Private Function GetSmashedLine(pDisplay As IScreenDisplay, pTextSymbol As ISymbol, pPoint As IPoint, pPolyLine As IPolyline) As IPolyline<BR> 'Returns a Polyline with a blank space for the text to go in<BR> Dim pSmashed As IPolyline<BR> Dim pBoundary As IPolygon<BR> Set pBoundary = New Polygon<BR> pTextSymbol.QueryBoundary pDisplay.hDC, pDisplay.DisplayTransformation, pPoint, pBoundary<BR> Dim pTopo As ITopologicalOperator<BR> Set pTopo = pBoundary<BR> <BR> Dim pIntersect As IPolyline</P> <P> '下面这个函数报错<BR> Set pIntersect = pTopo.Intersect(pPolyLine, esriGeometry1Dimension) </P> <P><BR> Set pTopo = pPolyLine<BR> Set GetSmashedLine = pTopo.Difference(pIntersect)<BR>End Function</P> <P>请帮忙分析一下，谢谢</P> |
|
|
1楼#
发布于：2005-11-22 15:15
<P>怎么人这么少？</P>
|
|
|
2楼#
发布于：2005-11-23 10:27
<P>斑竹在不在？</P>
|
|
|
3楼#
发布于：2005-11-23 10:30
有没有人帮忙呀？
|
|
|
4楼#
发布于：2005-11-23 18:03
<P>我还以为你真的脱离arcmap些的 不过是用在arcmap中的dll而已</P>
|
|
|
5楼#
发布于：2005-11-25 14:24
<P>这个好像是量算距离的。记得好像看过这么个例子。现贴上我所使用的代码：</P>
<P>Option Explicit</P> <P>Implements ICommand<BR>Implements ITool</P> <P>Private m_pApp As New hook<BR>Private m_bInUse As Boolean<BR>Private m_pLineSymbol As ILineSymbol<BR>Private m_pLinePolyline As IPolyline<BR>Private m_pTextSymbol As ITextSymbol<BR>Private m_pStartPoint As IPoint<BR>Private m_pTextPoint As IPoint<BR>Private m_pCursor As IPictureDisp<BR>Private m_pBitmap As IPictureDisp<BR>Private m_LengthArea As String<BR></P> <P>Private Function GetMap() As esriCarto.IMap</P> <P> On Error GoTo ErrorHandler</P> <P> Set GetMap = m_pApp.FocusMap</P> <P> Exit Function<BR>ErrorHandler:<BR> ' ', "GetMap " ; c_ModuleFileName ; " " ; GetErrorLineNumberString(Erl), Err.Number, Err.Source, Err.Description, 1</P> <P>End Function</P> <P><BR>Private Sub Class_Initialize()</P> <P> Set m_pCursor = LoadResPicture("MEASURE", vbResCursor)<BR> ' Set m_pCursor = LoadResPicture("SELECT", vbResCursor)</P> <P>End Sub</P> <P><BR>Private Sub Class_Terminate()<BR> <BR> Set m_pApp = Nothing<BR> <BR>End Sub</P> <P><BR>Private Property Get ICommand_Bitmap() As esriSystem.OLE_HANDLE</P> <P> ' ICommand_Bitmap = frmResources.imlBitmaps.ListImages(1).Picture</P> <P>End Property</P> <P><BR>Private Property Get ICommand_Caption() As String</P> <P> ICommand_Caption = "测量工具"</P> <P>End Property</P> <P><BR>Private Property Get ICommand_Category() As String</P> <P> ICommand_Category = "Developer Samples"</P> <P>End Property</P> <P><BR>Private Property Get ICommand_Checked() As Boolean</P> <P>End Property</P> <P><BR>Private Property Get ICommand_Enabled() As Boolean</P> <P> ICommand_Enabled = True</P> <P>End Property</P> <P><BR>Private Property Get ICommand_HelpContextID() As Long</P> <P>End Property</P> <P><BR>Private Property Get ICommand_HelpFile() As String</P> <P>End Property</P> <P><BR>Private Property Get ICommand_Message() As String</P> <P> ICommand_Message = "测量距离工具"</P> <P>End Property</P> <P><BR>Private Property Get ICommand_Name() As String</P> <P> ICommand_Name = "Developer Samples_Measure Tool"</P> <P>End Property</P> <P><BR>Private Sub ICommand_OnClick()</P> <P>End Sub</P> <P><BR>Private Sub ICommand_OnCreate(ByVal hook As Object)</P> <P> m_pApp.hook = hook</P> <P>End Sub</P> <P><BR>Private Property Get ICommand_Tooltip() As String</P> <P> ICommand_Tooltip = "测量工具"</P> <P>End Property</P> <P><BR>Private Property Get ITool_Cursor() As esriSystem.OLE_HANDLE</P> <P> ITool_Cursor = m_pCursor 'frmResources.imlBitmaps.ListImages(2).Picture</P> <P>End Property</P> <P><BR>Private Function ITool_Deactivate() As Boolean</P> <P> ' stop doing operation<BR> Set m_pTextSymbol = Nothing<BR> Set m_pTextPoint = Nothing<BR> Set m_pLinePolyline = Nothing<BR> Set m_pLineSymbol = Nothing<BR> m_bInUse = False</P> <P> ITool_Deactivate = True</P> <P>End Function</P> <P><BR>Private Function ITool_OnContextMenu(ByVal x As Long, ByVal y As Long) As Boolean</P> <P>End Function</P> <P><BR>Private Sub ITool_OnDblClick()</P> <P>End Sub</P> <P><BR>Private Sub ITool_OnKeyDown(ByVal keyCode As Long, ByVal Shift As Long)</P> <P>End Sub</P> <P><BR>Private Sub ITool_OnKeyUp(ByVal keyCode As Long, ByVal Shift As Long)</P> <P>End Sub</P> <P><BR>Private Sub ITool_OnMouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)</P> <P> m_bInUse = True<BR> ' Dim pMXDoc As IMxDocument<BR> Dim pActiveView As IActiveView<BR> ' Set pMXDoc = m_pApp.Document<BR> Set pActiveView = GetMap() 'pMXDoc.FocusMap<BR> <BR> 'Get point to measure distance from<BR> Set m_pStartPoint = pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)</P> <P>End Sub</P> <P><BR>Private Sub ITool_OnMouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)</P> <P> If (Not m_bInUse) Then Exit Sub</P> <P> ' Dim pMXDoc As IMxDocument<BR> Dim pActiveView As IActiveView<BR> ' Set pMXDoc = m_pApp.Document<BR> Set pActiveView = GetMap() 'pMXDoc.FocusMap</P> <P> Dim bfirstTime As Boolean</P> <P> If (m_pLineSymbol Is Nothing) Then bfirstTime = True</P> <P> 'Get current point<BR> Dim pPoint As IPoint<BR> Set pPoint = pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)</P> <P> pActiveView.ScreenDisplay.StartDrawing pActiveView.ScreenDisplay.hDC, -1</P> <P> If bfirstTime Then</P> <P> Dim pRGBColor As IRgbColor<BR> Dim pSymbol As ISymbol<BR> Dim pFont As IFontDisp</P> <P> 'Line Symbol<BR> Set m_pLineSymbol = New SimpleLineSymbol<BR> m_pLineSymbol.Width = 2<BR> Set pRGBColor = New RgbColor</P> <P> With pRGBColor<BR> .Red = 223<BR> .Green = 223<BR> .blue = 223<BR> End With</P> <P> m_pLineSymbol.Color = pRGBColor<BR> Set pSymbol = m_pLineSymbol<BR> pSymbol.ROP2 = esriROPXOrPen</P> <P>' Dim myColor As IRgbColor<BR>' Set myColor = New RgbColor<BR>' myColor.Red = 255<BR>' myColor.blue = 0<BR>' myColor.Green = 0</P> <P> 'Text Symbol<BR> Set m_pTextSymbol = New TextSymbol<BR> m_pTextSymbol.HorizontalAlignment = esriTHACenter<BR> m_pTextSymbol.VerticalAlignment = esriTVACenter<BR> m_pTextSymbol.Size = 15<BR>' m_pTextSymbol.Color = GetRGBColor(255, 0, 0)<BR> Set pSymbol = m_pTextSymbol<BR> <BR> Set pFont = m_pTextSymbol.Font<BR> pFont.name = "宋体"<BR>' m_pTextSymbol.Color = myColor<BR> pSymbol.ROP2 = esriROPXOrPen</P> <P> 'Create point to draw text in<BR> Set m_pTextPoint = New Point</P> <P> Else</P> <P> 'Use existing symbols and draw existing text and polyline<BR> pActiveView.ScreenDisplay.SetSymbol m_pTextSymbol<BR> pActiveView.ScreenDisplay.DrawText m_pTextPoint, m_pTextSymbol.Text<BR> pActiveView.ScreenDisplay.SetSymbol m_pLineSymbol</P> <P> If (m_pLinePolyline.length > 0) Then _<BR> pActiveView.ScreenDisplay.DrawPolyline m_pLinePolyline</P> <P> End If</P> <P>' 'Get line between from and to points, and angle for text<BR> Dim pLine As ILine<BR> Set pLine = New esriGeometry.Line<BR> pLine.PutCoords m_pStartPoint, pPoint<BR> Dim angle As Double<BR> angle = pLine.angle<BR> angle = angle * (180# / 3.14159)</P> <P> If ((angle > 90#) And (angle < 180#)) Then</P> <P> angle = angle + 180#<BR> ElseIf ((angle < 0#) And (angle < -90#)) Then</P> <P> angle = angle - 180#<BR> ElseIf ((angle < -90#) And (angle > -180)) Then</P> <P> angle = angle - 180#<BR> ElseIf (angle > 180) Then</P> <P> angle = angle - 180#<BR> End If</P> <P><BR> 'For drawing text, get text(distance), angle, and point<BR> Dim deltaX As Double<BR> Dim deltaY As Double<BR> Dim distance As Double</P> <P> Dim pLenth As Double</P> <P> deltaX = pPoint.x - m_pStartPoint.x<BR> deltaY = pPoint.y - m_pStartPoint.y<BR> m_pTextPoint.x = m_pStartPoint.x + deltaX / 2#<BR> m_pTextPoint.y = m_pStartPoint.y + deltaY / 2#<BR> m_pTextSymbol.angle = angle<BR> distance = Round(Sqr((deltaX * deltaX) + (deltaY * deltaY)), 3)<BR> On Error GoTo hErr</P> <P><BR> deltaX = pPoint.x - m_pStartPoint.x<BR> deltaY = pPoint.y - m_pStartPoint.y<BR> m_pTextPoint.x = m_pStartPoint.x + deltaX / 2#<BR> m_pTextPoint.y = m_pStartPoint.y + deltaY / 2#<BR> m_pTextSymbol.angle = angle<BR> 'Draw text<BR> pActiveView.ScreenDisplay.SetSymbol m_pTextSymbol<BR> pActiveView.ScreenDisplay.DrawText m_pTextPoint, m_pTextSymbol.Text<BR>' m_pTextSymbol.Color = GetRGBColor(255, 0, 0)</P> <P> 'Get polyline with blank space for text<BR> Dim pPolyLine As IPolyline<BR> Set pPolyLine = New Polyline<BR> Dim pSegColl As ISegmentCollection<BR> Set pSegColl = pPolyLine<BR> pSegColl.AddSegment pLine<BR>' m_pLineSymbol.Color = GetRGBColor(255, 255, 255)<BR> Set m_pLinePolyline = GetSmashedLine(pActiveView.ScreenDisplay, m_pTextSymbol, m_pTextPoint, pPolyLine)</P> <P> 'Draw polyline<BR> pActiveView.ScreenDisplay.SetSymbol m_pLineSymbol</P> <P> If (m_pLinePolyline.length > 0) Then _<BR> pActiveView.ScreenDisplay.DrawPolyline m_pLinePolyline</P> <P> pActiveView.ScreenDisplay.FinishDrawing<BR> m_LengthArea = "两地距离为：" ; pLenth ; "千米"<BR> <BR>End Sub</P> <P><BR>Private Sub ITool_OnMouseUp(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)</P> <P> If (Not m_bInUse) Then Exit Sub</P> <P> m_bInUse = False<BR> <BR> If (m_pLineSymbol Is Nothing) Then Exit Sub<BR> <BR> ' Dim pMXDoc As IMxDocument<BR> Dim pActiveView As IActiveView<BR> ' Set pMXDoc = m_pApp.Document<BR> Set pActiveView = GetMap() 'pMXDoc.FocusMap<BR> <BR> 'Draw measure line and text<BR> pActiveView.ScreenDisplay.StartDrawing pActiveView.ScreenDisplay.hDC, -1<BR> pActiveView.ScreenDisplay.SetSymbol m_pTextSymbol<BR> pActiveView.ScreenDisplay.DrawText m_pTextPoint, m_pTextSymbol.Text<BR> pActiveView.ScreenDisplay.SetSymbol m_pLineSymbol</P> <P> If (m_pLinePolyline.length > 0) Then pActiveView.ScreenDisplay.DrawPolyline m_pLinePolyline</P> <P> pActiveView.ScreenDisplay.FinishDrawing<BR> <BR> Set m_pTextSymbol = Nothing<BR> Set m_pTextPoint = Nothing<BR> Set m_pLinePolyline = Nothing<BR> Set m_pLineSymbol = Nothing</P> <P>End Sub</P> <P><BR>Private Sub ITool_Refresh(ByVal hDC As esriSystem.OLE_HANDLE)</P> <P><BR>End Sub</P> <P><BR>Private Function GetSmashedLine(pDisplay As IScreenDisplay, pTextSymbol As ISymbol, pPoint As IPoint, pPolyLine As IPolyline) As IPolyline</P> <P> 'Returns a Polyline with a blank space for the text to go in<BR> Dim pSmashed As IPolyline<BR> Dim pBoundary As IPolygon<BR> Set pBoundary = New Polygon<BR> pTextSymbol.QueryBoundary pDisplay.hDC, pDisplay.DisplayTransformation, pPoint, pBoundary<BR> Dim pTopo As ITopologicalOperator<BR> Set pTopo = pBoundary<BR> <BR> Dim pIntersect As IPolyline<BR> Set pIntersect = pTopo.Intersect(pPolyLine, esriGeometry1Dimension)<BR> Set pTopo = pPolyLine<BR> Set GetSmashedLine = pTopo.Difference(pIntersect)</P> <P>End Function</P> <P><BR> </P> |
|
