gisempire100
捉鬼专家
捉鬼专家
  • 注册日期2004-08-13
  • 发帖数552
  • QQ
  • 铜币2462枚
  • 威望0点
  • 贡献值0点
  • 银元0个
阅读:856回复:0

线注记

楼主#
更多 发布于:2008-01-13 14:25
<DIV>            Imports ESRI.ArcGIS.Geometry<BR>            Imports ESRI.ArcGIS.Carto<BR>            Imports ESRI.ArcGIS.MapControl<BR>            Imports ESRI.ArcGIS.Display</DIV><BR>
<DIV>            OnAfterDraw:</DIV>
<DIV>            Dim pTextSymbol As ITextSymbol = New TextSymbol<BR>            Dim pFont As stdole.StdFont<BR>            pFont = New stdole.StdFont<BR>            pFont.Name = "Arial"<BR>            pFont.Bold = True<BR>            pFont.Size = 16<BR>            pTextSymbol.Font = pFont<BR>            pTextSymbol.HorizontalAlignment = <BR>            esriTextHorizontalAlignment.esriTHAFull</DIV>
<P>            Dim rgbcolor As IRgbColor = New RgbColor<BR>            rgbcolor.RGB = RGB(0, 0, 255)<BR>            pTextSymbol.Color = rgbcolor</P>
<DIV>            Dim pTextPath As ITextPath<BR>            Dim pSimpleTextSymbol As ISimpleTextSymbol<BR>            'Create a text path and grab hold of the ITextPath interface<BR>            pTextPath = New BezierTextPath 'to spline the text<BR>            pSimpleTextSymbol = pTextSymbol 'Grab hold of the ISimpleTextSymbol <BR>            interface through the ITextSymbol interface<BR>            pSimpleTextSymbol.TextPath = pTextPath 'Set the text path of the <BR>            simple text symbol<BR>            'Draw the line object and spline the user text around the line</DIV>
<DIV>             '文字位置的自适应调整<BR>            m_Line = rotatezj(m_Line)</DIV>
<DIV>            AxMapControl1.DrawText(m_Line, "ssfsfsfsfsfsf", pTextSymbol)</DIV>
<P>            '当线的起点位于终点的右侧时,线将以相反方向重新绘制,确保文字自动显示在线的上方<BR>            Private Function rotatezj(ByVal line As Polyline) As Polyline<BR>            Try<BR>            Dim ilinetmp As IPolyline<BR>            Dim linetmp As Polyline = New Polyline<BR>            Dim pt0x, pt0y, pt1x, pt1y As Double<BR>            Dim pt0, pt1 As IPoint</P>
<P>            If line Is Nothing Then Return line : Exit Try<BR>            If line.PointCount < 2 Then Return line : Exit Try</P>
<P>            pt0 = line.Point(0)<BR>            pt1 = line.Point(line.PointCount - 1)<BR>            AxMapControl1.FromMapPoint(pt0, pt0x, pt0y)<BR>            AxMapControl1.FromMapPoint(pt1, pt1x, pt1y)</P>
<DIV>            If pt0x < pt1x Then Return line : Exit Function<BR>            ilinetmp = linetmp</DIV>
<DIV>            '需要转换<BR>            If pt0x > pt1x Then</DIV>
<DIV>            linetmp = New Polyline<BR>            Dim length As Integer = line.PointCount<BR>            For i As Integer = length - 1 To 0 Step -1<BR>            linetmp.AddPoint(line.Point(i))<BR>            Next<BR>            End If<BR>            Return linetmp<BR>            Catch ex As Exception<BR>            MsgBox(ex.Message)<BR>            End Try<BR>            End Function</DIV>
喜欢0 评分0
A friend is never known till a man has need. ...CL
游客

返回顶部