怎怎么用mapobjects的函数来画弧

怎怎么用mapobjects的函数来画弧

对阿，我也正想知道

<P>这在mo中好象没有提供直接的方法，圆和椭圆都比较容易</P><P>我想可以利用polyline来实现，但需要对poly的坐标进行转换，可以参看一些底层的算法，例如绘制besizer曲线的算法</P>

<P>恩，应该要用图形算法来实现.</P>

<P>那在VB中如何声明polyline呢？</P><P>Dim line1 As New MapObjects2.polyline? 好像是不行的</P><img src="images/post/smile/dvbbs/em28.gif" />

<P>form1代码</P><P>Option Explicit</P><P>Dim mCurPoint As Integer
Dim mPoints(1 To 3) As MapObjects2.Point
Dim mArc As MapObjects2.Line</P><P>Dim mPointSym As MapObjects2.Symbol
Dim mLineSym As MapObjects2.Symbol</P><P>Private Sub Form_Load()</P><P>Dim e As New MapObjects2.Rectangle</P><P>mCurPoint = 1</P><P>Set mPointSym = New MapObjects2.Symbol
mPointSym.SymbolType = moPointSymbol
mPointSym.Style = moCircleMarker
mPointSym.Color = moBlack
mPointSym.Size = 4</P><P>Set mLineSym = New MapObjects2.Symbol
mLineSym.SymbolType = moLineSymbol
mLineSym.Color = moGreen
mLineSym.Size = 2</P><P>e.Left = 0
e.Bottom = 0
e.Right = 1000
e.Top = 1000</P><P>Map1.FullExtent = e
Map1.Extent = Map1.FullExtent</P><P>End Sub</P><P>Private Sub Map1_BeforeTrackingLayerDraw(ByVal hDC As Stdole.OLE_HANDLE)</P><P>Dim i As Integer</P><P>If mPoints(mCurPoint) Is Nothing Then Exit Sub</P><P>If mCurPoint > 1 Then
  Map1.DrawShape mArc, mLineSym
End If</P><P>For i = 1 To mCurPoint
  Map1.DrawShape mPoints(i), mPointSym
Next i</P><P>End Sub</P><P>Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)</P><P>Set mPoints(mCurPoint) = Map1.ToMapPoint(x, y)
Map1.TrackingLayer.Refresh True</P><P>mCurPoint = (mCurPoint Mod 3) + 1
Set mPoints(mCurPoint) = Nothing</P><P>End Sub</P><P>Private Sub Map1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)</P><P>Dim pnts As MapObjects2.Points</P><P>Set mPoints(mCurPoint) = Map1.ToMapPoint(x, y)</P><P>If mCurPoint > 1 Then
  If mCurPoint = 2 Then
    Set pnts = New MapObjects2.Points
    pnts.Add mPoints(1)
    pnts.Add mPoints(2)
    Set mArc = New MapObjects2.Line
    mArc.Parts.Add pnts
  Else
    Set mArc = MakeArc(mPoints(1), mPoints(2), mPoints(3))
  End If
End If</P><P>Map1.TrackingLayer.Refresh True</P><P>End Sub</P><P>模块代码</P><P>'
'  Module Name:  modArc
'
'  Description:  Arc Generation Routines
'
'     Requires:  (nothing)
'
'     Routines:  MakeArc - given three MapObjects Points, returns a Line
'                    the approximates the circular arc which passes through
'                    them; the optional sweep angle, in degrees, determines
'                    the spacing of the vertices
'                GetCenter - given three MapObjects Points, returns the
'                    Point at the center of the circle that passes through
'                    them; returns Nothing if no center point can be found
'
'      History:  Peter Girard, ESRI - 5/00 - original coding
'
'=============================================================================</P><P>Public Function MakeArc(a As MapObjects2.Point, b As MapObjects2.Point, _
    c As MapObjects2.Point, Optional sweep As Integer = 3) As MapObjects2.Line</P><P>Dim cen As MapObjects2.Point, p As MapObjects2.Point
Dim l As MapObjects2.Line, pts As MapObjects2.Points</P><P>Dim cosSweep As Double, sinSweep As Double
Dim rad As Double, dChord As Double
Dim dab As Double, dac As Double, sideb As Integer, sidec As Integer
Dim dir As Integer, done As Boolean, bInserted As Boolean
Dim dx As Double, dy As Double</P><P>' -- degrees to radians conversion</P><P>Const PI = 3.14159265359
Const ToRadians = PI / 180</P><P>' -- create the line and add the first point</P><P>Set l = New MapObjects2.Line
Set pts = New MapObjects2.Points
pts.Add a</P><P>' -- find the center of the circle passing through the three points; if there
' -- is no center (coincident points or a straight line), simply connect the
' -- points</P><P>Set cen = GetCenter(a, b, c)
If cen Is Nothing Then
  pts.Add b
  pts.Add c
  l.Parts.Add pts
  Set MakeArc = l
  Exit Function
End If</P><P>' -- get the cosine and sine of the sweep angle, the radius of the arc, and
' -- the chord distance relative to the sweep angle and radius</P><P>cosSweep = Cos(sweep * ToRadians)
sinSweep = Sin(sweep * ToRadians)
rad = cen.DistanceTo(a)
dChord = Sqr(((rad - (cosSweep * rad)) ^ 2) + ((sinSweep * rad) ^ 2))</P><P>' -- get the distances from point A to B and C; determine to which side of
' -- the A radius vector lie points B and C using vector cross products</P><P>dab = a.DistanceTo(b)
sideb = Sgn(((b.x - a.x) * (cen.y - a.y)) - ((b.y - a.y) * (cen.x - a.x)))
dac = a.DistanceTo(c)
sidec = Sgn(((c.x - a.x) * (cen.y - a.y)) - ((c.y - a.y) * (cen.x - a.x)))</P><P>' -- if points B and C are on the same side of the A radius vector, point B
' -- is closer to A than is C, and both B and C are closer to A than the chord
' -- distance, simply connect the points</P><P>If sideb = sidec And dab <= dac And dac <= dChord Then
  pts.Add b</P><P>Else</P><P>  ' -- if points B and C are on the same side of the A radius vector and
  ' -- C is closer to A than is B, then take the long way around the circle
  ' -- from A to B
  
  If sideb = sidec And dab > dac Then
    dir = -sideb
    
  ' -- otherwise, take the short way around the circle from A to B; add
  ' -- point B as a vertex if it's within the chord distance
  
  Else
    dir = sideb
    If dab < dChord Then
      pts.Add b
      bInserted = True
    End If
  End If
  
  ' -- loop to generate the vertices
  
  Set p = New MapObjects2.Point
  p.x = a.x
  p.y = a.y
  While Not done
    dx = p.x - cen.x
    dy = p.y - cen.y
    p.x = cen.x + (dx * cosSweep) - (dir * dy * sinSweep)
    p.y = cen.y + (dy * cosSweep) + (dir * dx * sinSweep)
    pts.Add p
    If Not bInserted And p.DistanceTo(b) < dChord Then
      pts.Add b
      bInserted = True
    End If
    done = (p.DistanceTo(c) <= dChord)
  Wend
End If</P><P>' -- add point C to the vertices and create the Line</P><P>pts.Add c
l.Parts.Add pts</P><P>Set MakeArc = l</P><P>End Function</P><P>Public Function GetCenter(a As MapObjects2.Point, b As MapObjects2.Point, _
   c As MapObjects2.Point) As MapObjects2.Point</P><P>Dim ax As Double, ay As Double, bx As Double, by As Double, cx As Double, cy As Double
Dim dx1 As Double, dy1 As Double, dx2 As Double, dy2 As Double
Dim m1 As Double, m2 As Double, b1 As Double, b2 As Double
Dim center As MapObjects2.Point</P><P>' -- exit if any two points are coincident</P><P>If (a.x = b.x And a.y = b.y) Or (b.x = c.x And b.y = c.y) Or _
    (c.x = a.x And c.y = a.y) Then
  Exit Function
End If</P><P>' -- exit if any error is encountered; this would probably be a division by zero
' -- error that occurs all three points lie on the same line</P><P>On Error GoTo Exit_GetCenter</P><P>Set center = New MapObjects2.Point</P><P>' -- calculate the center points of the lines AB and BC</P><P>ax = (a.x + b.x) / 2
ay = (a.y + b.y) / 2
bx = b.x
by = b.y
cx = (c.x + b.x) / 2
cy = (c.y + b.y) / 2</P><P>' -- calculate the XY deltas for the perpendicular bisectors of lines AB and BC</P><P>dx1 = by - ay
dy1 = -(bx - ax)
dx2 = by - cy
dy2 = -(bx - cx)</P><P>' -- if either perpendicular bisector is a vertical line, find the center point
' -- where the other perpendicular bisector intersects that vertical line</P><P>If dx1 = 0 Then
  center.x = ax
  m2 = dy2 / dx2
  b2 = cy - (m2 * cx)
  center.y = (m2 * center.x) + b2
  
Else
  If dx2 = 0 Then
    center.x = cx
    m1 = dy1 / dx1
    b1 = ay - (m1 * ax)
    center.y = (m1 * center.x) + b1
  
  ' -- otherwise, find the center point by solving the simultaneous equations
  ' -- of both perpendicular bisectors
  
  Else
    m1 = dy1 / dx1
    b1 = ay - (m1 * ax)
    m2 = dy2 / dx2
    b2 = cy - (m2 * cx)
    center.x = (b2 - b1) / (m1 - m2)
    center.y = (m1 * center.x) + b1
  End If
End If</P><P>Set GetCenter = center</P><P>Exit_GetCenter:</P><P>End Function</P><P>

 </P>

楼上好人，已给你加分<img src="images/post/smile/dvbbs/em01.gif" />

关注

<P>to cnlyh:好哥们</P>

好人啊！<img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em01.gif" /><img src="images/post/smile/dvbbs/em05.gif" /><img src="images/post/smile/dvbbs/em05.gif" /><img src="images/post/smile/dvbbs/em06.gif" /><img src="images/post/smile/dvbbs/em08.gif" />