空间查询实验报告

本科学生实验报告学号姓名学院专业、班级实验课程名称教师及职称开课学期至学年学期填报时间年月日通过绘制图形实现对shapfile 文件的查询2实验原理、实验流程或装置示意图（试验浓缩版步骤或者流程图）借助 vb 工具和 mo 模块实现画点、线、面、多边形，shapfile 文件的查询。3实验设备及材料计算机， vb6.0 软件， mo 组件。（ 1） 实验方法步骤及注意事项一：利用 vb 工具制作界面（添加按钮，图像显示框，图像目录框架）；首先在部件里面加载： esri mapobjects2.2；esri mapobjects legendcontrol;；microsoft common dialog controls 6.0；microsoft windows common controls6.0。等窗体 1 界面；云南师范大学教务处编印实验序号实验名称空间查询实验时间2014 年 5 月 8 日实验室gis 实验室一实验预习1实验目的精品资料窗体二界面：二：在代码窗口编写代码窗 体 1 代 码 如 下 ： option explicitdim pshape as objectdim pt as mapobjects2.point dim pline as mapobjects2.linedim prectangle as mapobjects2.rectangle dim ppolygon as mapobjects2.polygon dim recs as mapobjects2.recordsetprivate sub command1_click() frmadspatialsel.showend subprivate sub map1_aftertrackinglayerdraw(byval hdc as stdole.ole_handle) dim psymsel as new mapobjects2.symboldim psym as new mapobjects2.symbolif not pt is nothing then psym.color = moblue map1.drawshape pt, psymend ifif not pline is nothing then psym.color = moblue map1.drawshape pline, psymend ifif not prectangle is nothing thenpsym.symboltype = mofillsymbol psym.style = motransparentfill psym.color = moblue psym.outlinecolor = moblue map1.drawshape prectangle, psymend ifif not ppolygon is nothing then psym.outlinecolor = moblue psym.symboltype = mofillsymbol psym.style = motransparentfill map1.drawshape ppolygon, psymend ifif not psel is nothing then psymsel.color = moyellow map1.drawshape psel, psymselend if end subprivate sub map1_mousedown(button as integer, shift as integer, x as single, y as single)if frmadspatialsel.toolbar1.buttons(points).value = 1 thenset pt = map1.tomappoint(x, y) set pshape = ptexecutesearchdisplayselfeatureelseif frmadspatialsel.toolbar1.buttons(lines).value = 1 thenset pline = map1.trackline set pshape = pline executesearch displayselfeatureelseif frmadspatialsel.toolbar1.buttons(rectangles).value = 1 thenset prectangle = map1.trackrectangle set pshape = prectangle executesearchdisplayselfeatureelseif frmadspatialsel.toolbar1.buttons(polygons).value = 1 thenset ppolygon = map1.trackpolygon set pshape = ppolygonexecutesearchdisplayselfeatureelseif frmadspatialsel.toolbar1.buttons(sel).value = 1 then dim thetol as singlethetol = 0.01dim pts as mapobjects2.point set pts = map1.tomappoint(x, y)setrecs= map1.layers(frmadspatialsel.cbolayer.listindex).searchbydistance(pts, thetol, )if recs.eof = false thenset pshape = recs(shape).value executesearchdisplayselfeatureelse end ifend ifmap1.refresh end subsub executesearch()set psel = nothingsetpsel= map1.layers(frmadspatialsel.cbolayer.listindex).searchshape(pshape, frmadspatialsel.cbomethod.listindex, )end sub用表显示选中图形sub displayselfeature()if not psel is nothing thendim tdesc as mapobjects2.tabledesc dim i as integerset tdesc = psel.tabledesc dim recscount as integer* 以下代码用来填充msgflexgriddim m as integerdim n as integerpsel.movefirstdo while not psel.eof psel.movenextrecscount = recscount + 1loop msgbox recscountfrmadspatialsel.msflexgrid1.cols = tdesc.fieldcount + 1 frmadspatialsel.msflexgrid1.rows = recscount + 1 frmadspatialsel.msflexgrid1.allowuserresizing = flexresizecolumns frmadspatialsel.msflexgrid1.clear frmadspatialsel.msflexgrid1.cellalignment = flexalignleftcenterfor i = 1 to tdesc.fieldcountfrmadspatialsel.msflexgrid1.colwidth(i) = tdesc.fieldlength(i- 1) *72next ito filled the fields name into grid frmadspatialsel.msflexgrid1.textmatrix(0, 0) = 特 征 idfor i = 1 to recscountfrmadspatialsel.msflexgrid1.textmatrix(i, 0) = i frmadspatialsel.msflexgrid1.cellalignment = flexalignleftcenternext ifor i = 0 to tdesc.fieldcount - 1frmadspatialsel.msflexgrid1.textmatrix(0,i+1)= tdesc.fieldname(i)frmadspatialsel.msflexgrid1.colalignment(i) = flexalignleftcenter frmadspatialsel.msflexgrid1.colwidth(i) = 1200next ifrmadspatialsel.msflexgrid1.colalignment(0) = flexaligncentercenter frmadspatialsel.msflexgrid1.colwidth(0) = 680psel.movefirstfor m = 1 to recscountfor n = 0 to tdesc.fieldcount - 1 frmadspatialsel.msflexgrid1.textmatrix(m,n+1)=psel.fields(tdesc.fieldname(n).valuenext npsel.movenextnext mpsel.movefirst frmadspatialsel.msflexgrid1.refreshend if end sub窗体 2 代码如下：private sub cmdcenter_click() on error resume nextdim rect as rectangle, rect2 as rectangle dim shapex as double, shapey as double dim deltax as double, deltay as doubledim theshape as object, pinpoint as mapobjects2.pointdim recno as integerrecno = msflexgrid1.row - 1psel.movefirst记录指针移动到属性数据表选择中的记录上for i = 0 to recno - 1psel.movenext next iset theshape = psel(shape).value if psel(shape).type = mopoint thenset rect2 = form1.map1.extent shapex = psel(shape).value.x shapey = psel(shape).value.y deltax = shapex - rect2.center.x deltay = shapey - rect2.center.yrect2.offset deltax, deltayrect2.scalerectangle 0.1 form1.map1.extent = rect2elseset rect = psel(shape).value.extent rect.scalerectangle 1.1 form1.map1.extent = rectend ifset rect2 = nothing set theshape = nothingend subprivate sub cmdflash_click() call movepointcall flash_shape end sub* 闪烁private sub flash_shape()on error resume next form1.map1.flashshape psel(shape).value, 3end sub移动private sub movepoint()on error resume nextdim recno as integer dim i as integerrecno = msflexgrid1.row - 1psel.movefirst记录指针移动到属性数据表选择中的记录上for i = 0 to recno - 1psel.movenext next iend sub *private sub form_load()setwindowpos me.hwnd, hwnd_topmost, 0, 0, 0, 0, swp_nomove or swp_nosizedim layer as mapobjects2.maplayer set layer = new mapobjects2.maplayercbolayer.clearfor each layer in form1.map1.layers if layer.layertype = 0 thencbolayer.additem layer.namei = i + 1 end ifnext layer cbolayer.listindex = 0初始化空间搜索方法cbomethod.additem 重叠cbomethod.additem cbomethod.additem 有一个公共点 边缘相交 cbomethod.additem 有一条公共边 cbomethod.additem 有公共点或边缘相交cbomethod.additem 有交集cbomethod.additem cbomethod.additem 内交内交，但边缘不相交cbomethod.additem 特征包含形 cbomethod.additem 形 包 含 特 征 cbomethod.additem 特 征 完 全 包 含 形 cbomethod.additem 形 完 全 包 含 特 征 cbomethod.additem 特征包含形的第一个点 cbomethod.additem 形包含特征的中心 cbomethod.additem 特 征 和 形 相 同 cbomethod.listindex = 5end subprivate sub msflexgrid1_click() cmdcenter_clickend subprivate sub toolbar1_buttonclick(byval button as comctllib.button) 清除选中的图形if button.key = clean thenmsflexgrid1.clearif not pt is nothing then set pt = nothingif not pline is nothing then set pline = nothingif not prectangle is nothing then set prectangle = nothing if not ppolygon is nothi