MapObjects如何画箭头cad线段加箭头

第五讲 MO图形的绘制_百度文库
两大类热门资源免费畅读
续费一年阅读会员,立省24元!
第五讲 MO图形的绘制
阅读已结束,下载文档到电脑
想免费下载更多文档?
定制HR最喜欢的简历
下载文档到电脑,方便使用
还剩14页未读,继续阅读
定制HR最喜欢的简历
你可能喜欢随笔 - 169, 文章 - 0, 评论 - 1356, 引用 - 12
MOMAPPointPointsLineRectanglePolygonEllipse
SymbolDrawshape
SymbolDrawshapeAddEventGeoEventDrawText
1DrawShape
object.DrawShape shape, symbol
shapePoint, Points, Line, Rectangle, Polygon or EllipseRecordset
symbolSymbol
DrawShapeLAYERTrackingLayerdrawingAfterTrackingLayerDrawBeforeLayerDrawBeforeTrackingLayerDrawAfterLayerDraw
RecordsetDrawShapeGeoDatasetTableMOshape
1PointPoints
Dim sym As New MapObjects2.Symbol
Dim p As Point
Dim pts As Points
Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)
&Set pts = New Points
&Set p = Map1.ToMapPoint()
&pts.Add p'PointsPointPoints
&Set p = Map1.ToMapPoint()
&pts.Add p
&sym.Color = moRed
&sym.SymbolType = moPointSymbol
&sym.Size = 3
&Map1.DrawShape pts, sym
Dim sym As New MapObjects2.Symbol
Dim p As Point
Dim pts As New Points
Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)
& If Not pts Is Nothing Then
&sym.Color = moRed
&sym.SymbolType = moPointSymbol
&sym.Size = 3
&Map1.DrawShape pts, sym
&&& Map1.DrawShape pts, sym
Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
&& Set p = Map1.ToMapPoint(X, Y)
& pts.Add p
& Map1.TrackingLayer.Refresh True’ TrackingLayerMAPRefreshTrackingLayerTrackingLayer
MOPointsPointsLineDrawShapePointsNN-1
Dim g_line As MapObjects2.Line
Dim pts As Points
Dim p As Point
Dim sym As Symbol
Private Sub Command1_Click()
Set g_line = New MapObjects2.Line
Set pts = New Points
Set p = Map1.ToMapPoint()
Set p = Map1.ToMapPoint()
g_line.Parts.Add pts 'PartsLinePartsPartsPartsPartsPoints
Set pts = g_line.Parts(0)
Map1.Refresh
Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)
If Not g_line Is Nothing Then
Dim sym As New Symbol
If pts.Count & 1 Then’ CountPoints
sym.Color = moRed
sym.SymbolType = moLineSymbol
sym.Size = 5
Map1.DrawShape g_line, sym
Dim g_line As MapObjects2.Line
Dim pts As Points
Dim p As Point
Dim sym As Symbol
Private Sub Command1_Click()’
Set g_line = Nothing
Set pts = Nothing
Map1.Refresh
Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)
Dim sym As New Symbol
If Not g_line Is Nothing Then
sym.Color = moBlack
Map1.DrawShape pts, sym
If pts.Count & 1 Then
sym.Color = moRed
sym.SymbolType = moLineSymbol
sym.Size = 5
Map1.DrawShape g_line, sym
Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
If g_line Is Nothing Then
Set g_line = New MapObjects2.Line
If pts Is Nothing Then
Set pts = New Points
Set p = Map1.ToMapPoint(X, Y)
If pts.Count = 1 Then
g_line.Parts.Add pts
Set pts = g_line.Parts(0)
Map1.TrackingLayer.Refresh True
MsgBox "right"
1topleftbottomrightDrawShapeXYtopleftbottomright
Option Explicit
Dim rect As MapObjects2.Rectangle
Private Sub Command1_Click()
Dim dist As Double
Dim pt As New Point
Set rect = New MapObjects2.Rectangle
dist = 0.2
Set pt = Map1.ToMapPoint()’
rect.Right = pt.X + dist
rect.Left = pt.X - dist
rect.Top = pt.Y + dist
rect.Bottom = pt.Y - dist
Map1.Refresh
Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)
If Not rect Is Nothing Then
Dim sym As New Symbol
sym.SymbolType = moFillSymbol
sym.Style = moDiagonalCrossFill
sym.Color = moBlue
Map1.DrawShape rect, sym
Option Explicit
Dim rect As MapObjects2.Rectangle
Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)
& Dim sym As New MapObjects2.Symbol
& If Not rect Is Nothing Then
&&& sym.SymbolType = moFillSymbol
&&& sym.Style = moDiagonalCrossFill
&&& sym.Color = moBlue
&&& Map1.DrawShape rect, sym
Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
& Set rect = Map1.TrackRectangle
& Map1.TrackingLayer.Refresh True
MOTrackCircleTrackRectangleTrackPolygonTrackTrackTrackingLayer
Option Explicit
Dim eli As MapObjects2.Ellipse
Dim recs As MapObjects2.Rectangle
Dim ply As MapObjects2.Polygon
Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)
& Dim sym As New MapObjects2.Symbol
&&&&& sym.SymbolType = moFillSymbol
&&& sym.Style = moDiagonalCrossFill
& If Not recs Is Nothing Then
&&& sym.Color = moBlue
&&& Map1.DrawShape recs, sym
& If Not eli Is Nothing Then
& sym.Color = moRed
&& Map1.DrawShape eli, sym
&& If Not ply Is Nothing Then
&& sym.Color = moGreen
&& Map1.DrawShape ply, sym
Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
& If Option1 Then
& Set recs = Map1.TrackRectangle
& ElseIf Option2 Then
& Set eli = Map1.TrackCircle
& Set ply = Map1.TrackPolygon
& Map1.TrackingLayer.Refresh True
MODrawTextmotruetypemarker
object.DrawText text, shape, symbol
objecttextshapesymbolTextsymbol
Option Explicit
Dim p As MapObjects2.Point
Dim tSym As New TextSymbol
Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)
If Not p Is Nothing Then
&&&&& Dim sym As New Symbol
&&&&& tSym.Color = moRed
Map1.DrawText Text1.Text, p, tSym
Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
&&& Set p = Map1.ToMapPoint(x, y)
Map1.TrackingLayer.Refresh True
Option Explicit
Dim g_line As MapObjects2.Line
Dim pts As MapObjects2.Points
Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)
& ' make sure there's a line
& If Not g_line Is Nothing Then
&&& ' make sure there's at least two points in the line
&&& If pts.Count & 1 Then
&&&&& Dim tSym As New TextSymbol
&&&&& ' use the font of the textbox control
&&&&& Set tSym.Font = Text1.Font
&&&&& Dim sym As New Symbol
&&&&& sym.Color = moRed
&&&&& Map1.DrawShape g_line, sym
&&&&& Map1.DrawText Text1.Text, g_line, tSym
&&& End If
Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
& If Button = 1 Then
&&& ' create the line if it does not exist
&&& If g_line Is Nothing Then
&&&& &Set g_line = New MapObjects2.Line
&&& End If
&&& If pts Is Nothing Then
&&&&& Set pts = New MapObjects2.Points
&&& End If
&&& ' create a point and add it to the line
&&& Dim p As Point
&&& Set p = Map1.ToMapPoint(x, y)
&&& pts.Add p
&&& If pts.Count = 1 Then
&&&&&&& g_line.Parts.Add pts
&&&&&&& Set pts = g_line.Parts(0)
&&& End If
&&& ' refresh the trackingLayer
&&& Map1.TrackingLayer.Refresh True
&&& Dim r As MapObjects2.Rectangle
&&& Set r = Map1.TrackRectangle
&&& If Not r Is Nothing Then Map1.Extent = r
SymbolSymbollayer.Symbol.Color = moRedSymbolMO
Dim sym As New Symbol
SymbolType
Constant &&&&& Value&& & Description
moPointSymbol&&&& 0&&&& symbol for a Point or Points object
moLineSymbol&&&&&& 1&&&& symbol for a Line object
moFillSymbol 2&&&& symbols for a Polygon, Rectangle or Ellipse object
sym.SymbolType = moFillSymbol
Symbolstyle
sizecolorfont
SymbolstylemoTrueTypeMarker&& sym.Style = moTrueTypeMarkersym.CharacterIndex = 35CharacterIndex33
Option Explicit
Dim Pt(400) As MapObjects2.Point
Dim Pt1(400) As MapObjects2.Point
Dim Sym(400) As New MapObjects2.Symbol
Dim tSym As New MapObjects2.TextSymbol
Private Sub Form_Load()
& Dim i As Integer
& Dim Swidth As Integer
& Dim Sheight As Integer
'& Swidth = Screen.Width
'& Sheight = Screen.Height
& Swidth = 800 * 15
& Sheight = 600 * 15
& Me.Height = Sheight - 100
& Me.Width = Swidth - 300
& Map1.Height = Me.Height - 200
& Map1.Width = Me.Width - 200
& Map1.Top = 100
& Map1.Left = 100
& For i = 0 To 399
&&& With Sym(i)
&&& .Style = moTrueTypeMarker
&&& .SymbolType = moPointSymbol
&&& '.Font = "ESRI Transportation & Municipal"
&&& .Size = 20
&&& .Style = moTrueTypeMarker
&&& .Color = moBlack
&&& End With
& tSym.Color = moBlack
& tSym.Font.Size = 10
Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)
& Dim i As Integer
& For i = 0 To 399
&&& If Not Pt(i) Is Nothing Then
&&&&& Map1.DrawShape Pt(i), Sym(i)
&&&&& Map1.DrawText 33 + i, Pt1(i), tSym
&&& End If
Private Sub Map1_Click()
& Dim i As Integer, j As Integer, k As Integer
& Const Mx0 = 400
& Const My0 = 300
& Const Mxc = 520
& Const Myc = 800
& For i = 0 To 199
& 'For i = 200 To 399
&&& Set Pt(i) = Map1.ToMapPoint(j * Mxc + Mx0, My0 + k * Myc)
&&& Set Pt1(i) = Map1.ToMapPoint(j * Mxc + Mx0, My0 + 400 + k * Myc)
&&& Sym(i).CharacterIndex = 33 + i
&&& j = j + 1
&&& If j &= 20 Then
&&&&& j = 0
&&&&& k = k + 1
&&& End If
& Map1.TrackingLayer.Refresh True
Option Explicit
Dim Pt(400) As MapObjects2.Point
Dim Pt1(400) As MapObjects2.Point
Dim Sym(400) As New MapObjects2.Symbol
Dim tSym As New MapObjects2.TextSymbol
Private Sub Form_Load()
& Dim i As Integer
& Dim Swidth As Integer
&&Dim Sheight As Integer
& Dim fnt As New StdFont
& fnt.Name = "Wingdings"
'& Swidth = Screen.Width
'& Sheight = Screen.Height
& Swidth = 800 * 15
& Sheight = 600 * 15
& Me.Height = Sheight - 100
& Me.Width = Swidth - 300
& Map1.Height = Me.Height - 200
& Map1.Width = Me.Width - 200
& Map1.Top = 100
& Map1.Left = 100
& For i = 0 To 399
&&& With Sym(i)
&&& .Style = moTrueTypeMarker
&&& .SymbolType = moPointSymbol
&&& '.Font = "ESRI Transportation & Municipal"
&&& .Font = fnt
&&& .Size = 20
&&& .Style = moTrueTypeMarker
&&& .Color = moBlack
&&& End With
& tSym.Color = moBlack
& tSym.Font.Size = 10
Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)
& Dim i As Integer
& For i = 0 To 399
&&& If Not Pt(i) Is Nothing Then
&&&&& Map1.DrawShape Pt(i), Sym(i)
&&&&& Map1.DrawText 33 + i, Pt1(i), tSym
&&& End If
Private Sub Map1_Click()
& Dim i As Integer, j As Integer, k As Integer
& Const Mx0 = 400
& Const My0 = 300
& Const Mxc = 520
& Const Myc = 800
& For i = 0 To 199
& 'For i = 200 To 399
&&& Set Pt(i) = Map1.ToMapPoint(j * Mxc + Mx0, My0 + k * Myc)
&&& Set Pt1(i) = Map1.ToMapPoint(j * Mxc + Mx0, My0 + 400 + k * Myc)
&&& Sym(i).CharacterIndex = 33 + i
&&& j = j + 1
&&& If j &= 20 Then
&&&&& j = 0
&&&&& k = k + 1
&&& End If
& Map1.TrackingLayer.Refresh True

我要回帖

更多关于 cad线段加箭头 的文章

 

随机推荐