分享
 
 
 

mapx+vb实战摘要(四)

王朝vb·作者佚名  2006-01-09
窄屏简体版  字體: |||超大  

12 查找图元

mapx查找地图上的图元有多种方法

a, FindObj.Search

这种方法在用的时候有局限性:数据集必须要有索引,查找的字段类型不能是10进制类型(可能还有其它的类型,忘了),否则在图上找不到。

Set FindObj = fMainForm.Map1.Layers(LayerCombo.Text).Find

Set FindObj.FindDataset = fMainForm.Map1.DataSets(LayerCombo.Text & " dataset")

Set FindObj.FindField = FindObj.FindDataset.Fields(FieldCombo.Text)

Set FoundFeature = FindObj.Search(FindText.Text)

If FoundFeature.FindRC Mod 10 = 1 Or FoundFeature.FindRC Mod 10 = 2 Then

fMainForm.Map1.Layers(LayerCombo.Text).Selection.Add FoundFeature

fMainForm.Map1.AutoRedraw = False

fMainForm.Map1.CenterX = FoundFeature.CenterX

fMainForm.Map1.CenterY = FoundFeature.CenterY

End If

b,SQL语句方法

Dim ftrs As MapXLib.Features

Dim lyr As Layer

Dim i As Integer

Set lyr = fMainForm.Map1.Layers(RoadlyrName)

Dim strs As String

strs = Trim("路线编码 = " + Chr(34) + ComRoadID.List(ComRoadID.ListIndex) + Chr(34))‘在值前面加双引号如:ID="001", 观测点名称 like "%天平庄"

Set ftrs = lyr.Search(strs)

lyr.Selection.ClearSelection

lyr.Selection.Add ftrs

If ftrs.Count > 0 Then

fMainForm.Map1.CenterX = ftrs.Item(1).CenterX

fMainForm.Map1.CenterY = ftrs.Item(1).CenterY

End If

13显示鼠标当前的经纬度

Private Sub Map1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

Dim MX As Double, MY As Double

Map1.ConvertCoord x, y, MX, MY, 1

Text1.Item(1).Caption = "当前位置"

Text1.Item(2).Caption = "东经 " & Format(MX, "###0.0000") + ",北纬 " + Format(MY, "###0.0000")

Text1.Item(3).Caption = " 当前图层"

Text1.Item(4).Caption = Map1.Layers(1).Name

End Sub

14自动滚屏

Private Sub Map1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

If mnuMoveCenter.Checked = True Then

If x > Map1.MapScreenWidth - 10 Then

Map1.CenterX = Map1.CenterX + 0.05

Map1.Refresh

Else

If x < 10 Then

Map1.CenterX = Map1.CenterX - 0.05

Map1.Refresh

Else

If y > Map1.MapScreenHeight - 10 Then

Map1.CenterY = Map1.CenterY - 0.05

Map1.Refresh

Else

If y < 10 Then

Map1.CenterY = Map1.CenterY + 0.05

Map1.Refresh

End If

End If

End If

End If

End If

End Sub

15测距和测面积

Private Sub Form_Load()

Map1.CreateCustomTool PolyRulerToolID, miToolTypePoly, miSizeAllCursor

Map1.CreateCustomTool PolyAreaToolID, miToolTypePolygon, miSelectRegionMinusCursor

End Sub

Private Sub Map1_PolyToolUsed(ByVal ToolNum As Integer, ByVal flags As Long, ByVal Points As Object, ByVal bShift As Boolean, ByVal bCtrl As Boolean, EnableDefault As Boolean)

If ToolNum = PolyRulerToolID Then

Dim i As Integer

Dim DistanceSoFar As Double

Map1.MapUnit = RulerUnit

DistanceSoFar = 0#

If Points.Count > 1 Then

For i = 2 To Points.Count

DistanceSoFar = DistanceSoFar + Map1.Distance(Points.Item(i).x, Points.Item(i).y, Points.Item(i - 1).x, Points.Item(i - 1).y)

Next

End If

If flags = miPolyToolEnd Then

'First, clear the status bar

Text1.Item(4).Caption = ""

MsgBox "距离: " & DistanceSoFar & " " & RulerUnitString

Else

Text1.Item(3).Caption = "距离"

Text1.Item(4).Caption = DistanceSoFar & " " & RulerUnitString

End If

End If

If ToolNum = PolyAreaToolID Then

'面积

Map1.AreaUnit = miUnitSquareKilometer

On Error Resume Next

Dim apolygoN As New MapXLib.Feature

Dim ax As Double

If (Points.Count > 2) Then

Set apolygoN = New Feature

Set apolygoN = Map1.FeatureFactory.CreateRegion(Points)

ax = apolygoN.Area

MsgBox "面积: " & ax

End If

End If

End Sub

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有