阅读:2016回复:4
如何合并多个记录集
各位高手,我现在有多个记录集,结构完全相同,如何合并他们呢?同时,相同的记录不再重复。就是说合并后的记录集中没有重复记录,因为我这几个记录集中可能有相同的部分记录。多谢!
|
|
1楼#
发布于:2003-10-08 18:22
请讲清楚你什么意思:
1)"有很多相同结构的记录" 同一个shp文件的所有记录当然结构完全相同 2)"相同的记录不再重复" 一个shp文件为什么要有相同的记录,相同的记录代表图元重复,你为什么会有这种情况 3)"因为我这几个记录集中可能有相同的部分记录" 你这些记录集是怎么得到的 |
|
2楼#
发布于:2003-10-08 18:29
转贴一个!
希望达到arcview和arcinfo中union操作的功能,但感觉mo中的union命令是把相邻的polygon做了融合,对于那种成十字交*的多边形,用part提取后,得不到非重叠区的polygon,面积和周长都是0,我把我的代码贴上,大家看看哪里有问题,谢谢。 Private Sub menuUnioner_Click() Dim pRecordset1 As New MapObjects2.Recordset Dim pRecordset2 As New MapObjects2.Recordset Dim i As Long, j As Long 'On Error GoTo errHandle: If mapDisp.Layers.count < 2 Then MsgBox "少于两个图层,不做整合运算" Exit Sub Else frmSelRecord.Show vbModal End If '获取两个记录集 If sLayer1 = "" Or sLayer2 = "" Then Exit Sub Set pRecordset1 = mapDisp.Layers(sLayer1).Records Set pRecordset2 = mapDisp.Layers(sLayer2).Records Dim pPolygon1 As MapObjects2.Polygon Dim pPolygon2 As MapObjects2.Polygon Dim pTempPoly As MapObjects2.Polygon Dim pPolygon3 As MapObjects2.Polygon Dim pPolygon4 As MapObjects2.Polygon Dim pUnionShape As MapObjects2.Polygon Dim pUnionEvent As New MapObjects2.GeoEvent pRecordset1.MoveFirst pRecordset2.MoveFirst Do Until pRecordset1.EOF Set pPolygon1 = pRecordset1.Fields("shape").value Do Until pRecordset2.EOF Set pPolygon2 = pRecordset2.Fields("shape").value Set pTempPoly = pPolygon1.Intersect(pPolygon2, mapDisp.FullExtent) If Not pTempPoly Is Nothing Then i = i + 1 'ReDim Preserve pObject(i) pObject.Add pTempPoly, CStr(i) Set pPolygon3 = pPolygon1.Difference(pTempPoly, mapDisp.FullExtent) If Not pPolygon3 Is Nothing Then If pPolygon3.Parts.count = 1 Then i = i + 1 'ReDim Preserve pObject(i) pObject.Add pPolygon3, CStr(i) 'Set pUnionEvent = mapDisp.TrackingLayer.AddEvent(pPolygon3, 0) Else For j = 1 To pPolygon3.Parts.count i = i + 1 'ReDim Preserve pObject(i) pObject.Add pPolygon3.Parts(j - 1), CStr(i) Next j End If End If Set pPolygon4 = pPolygon2.Difference(pTempPoly, mapDisp.FullExtent) If Not pPolygon4 Is Nothing Then If pPolygon4.Parts.count = 1 Then i = i + 1 'ReDim Preserve pObject(i) pObject.Add pPolygon4, CStr(i) 'Set pUnionEvent = mapDisp.TrackingLayer.AddEvent(pPolygon3, 0) Else For j = 1 To pPolygon4.Parts.count i = i + 1 'ReDim Preserve pObject(i) pObject.Add pPolygon4.Parts(j - 1), CStr(i) Next j End If End If End If DoEvents pRecordset2.MoveNext Loop mapDisp.TrackingLayer.ClearEvents pRecordset2.MoveFirst pRecordset1.MoveNext Loop Debug.Print pObject.count Dim aa As Integer pRecordset1.MoveFirst pRecordset2.MoveFirst Do Until pRecordset2.EOF Set pPolygon2 = pRecordset2.Fields("shape").value aa = 0 Do Until pRecordset1.EOF Set pTempPoly = pPolygon2.Intersect(pPolygon1, mapDisp.FullExtent) If Not pTempPoly Is Nothing Then aa = 1 Exit Do Else pRecordset1.MoveNext End If Loop If aa = 0 Then i = i + 1 'ReDim Preserve pObject(i) pObject.Add pPolygon2, CStr(i) End If pRecordset2.MoveNext Loop Debug.Print pObject.count '图层名清空 sLayer1 = "" sLayer2 = "" If MsgBox("是否生成新的shapefile文件?", vbCritical, Me.Caption) = vbOK Then Call AnalystExportShp(pObject) End If MsgBox "完成", vbInformation, "提示" mapDisp.Refresh legMapDisp.LoadLegend True '对象销毁 If Not pPolygon1 Is Nothing Then Set pPolygon1 = Nothing If Not pPolygon2 Is Nothing Then Set pPolygon2 = Nothing If Not pPolygon3 Is Nothing Then Set pPolygon2 = Nothing If Not pPolygon4 Is Nothing Then Set pPolygon2 = Nothing If Not pUnionShape Is Nothing Then Set pUnionShape = Nothing 'If Not pUnionEvent Is Nothing Then Set pUnionEvent = Nothing If Not pRecordset1 Is Nothing Then Set pRecordset1 = Nothing If Not pRecordset2 Is Nothing Then Set pRecordset2 = Nothing If Not pTempPoly Is Nothing Then Set pTempPoly = Nothing Dim k As Long For k = 1 To pObject.count pObject.Remove (k - 1) Next k Exit Sub 'errHandle: ' MsgBox "发生意外错误", vbInformation, "提示" ' Exit Sub End Sub '***************************************************** '获取要素集数组,循环插入新建的shapefile(polygon)中 '该shapefile文件放在程序文件夹的下的shape文件夹 '传入参数pEvent为shape集合 '***************************************************** Private Sub AnalystExportShp(pEvent As Collection) Dim gds As MapObjects2.GeoDataset Dim sName As String Dim desc As New MapObjects2.TableDesc Dim dc As New MapObjects2.DataConnection Dim lyr As New MapObjects2.MapLayer Dim lPoly As Long 'Dim pPolygons As New Collection Dim per As Integer per = 5 'On Error GoTo errHandle With CommonDialog1 .DialogTitle = "导出分析结果" .InitDir = App.path .Filter = "ESRI Shapefiles (*.shp)|*.shp" .DefaultExt = ".shp" .ShowSave End With If Len(CommonDialog1.fileName) = 0 Then Exit Sub dc.Database = CurDir If Not dc.Connect Then Exit Sub sName = Left(CommonDialog1.FileTitle, Len(CommonDialog1.FileTitle) - 4) With desc .FieldCount = 3 '外加字段3个,名称、面积、周长 .FieldName(0) = "Name" .FieldName(1) = "Area" .FieldName(2) = "Perimeter" .FieldType(0) = moString '地段类型 .FieldType(1) = moDouble .FieldType(2) = moDouble .FieldLength(0) = 16 '字段长度 .FieldPrecision(1) = 15 '字段精度 .FieldPrecision(2) = 15 .FieldScale(1) = 1 '小数点位数 .FieldScale(2) = 1 End With Set gds = dc.AddGeoDataset(sName, moShapeTypePolygon, desc) If gds Is Nothing Then Exit Sub Set lyr.GeoDataset = gds mapDisp.Layers.Add lyr legMapDisp.LoadLegend True '进度条控制 Dim lCount As Long lCount = pEvent.count \ 20 frmProgress.Left = (Screen.Width - frmProgress.Width) / 2 frmProgress.Top = (Screen.Height - frmProgress.Height) / 2 frmProgress.Show frmProgress.ProgressBar1.Max = pEvent.count + 1 frmProgress.ProgressBar1.Visible = True frmProgress.ProgressBar1.ZOrder 0 If lyr.Records.Updatable Then '如果polygon的数目小于20,则进度条按polygon的数据计算 If lCount = 0 Then frmProgress.ProgressBar1.Min = 1 frmProgress.ProgressBar1.Max = pEvent.count + 1 Else frmProgress.ProgressBar1.Min = 1 frmProgress.ProgressBar1.Max = 20 End If For lPoly = 1 To pEvent.count 'recordset数组上下界 With lyr.Records .AddNew .Fields("Shape").value = pEvent(lPoly) .Fields("Name").value = "Poly " & (lPoly) .Fields("Area").value = pEvent(lPoly).Area //面积和周长赋值就会出问题,因为集合中十字交叉的非公共区要素并没有图形 .Fields("Perimeter").value = pEvent(lPoly).Perimeter .Update If lCount = 0 Then frmProgress.ProgressBar1.value = frmProgress.ProgressBar1.value + 1 Else If lPoly >= 20 * lCount Then frmProgress.ProgressBar1.value = frmProgress.ProgressBar1.value Else If lPoly Mod lCount <> 0 Then frmProgress.ProgressBar1.value = frmProgress.ProgressBar1.value Else frmProgress.ProgressBar1.value = frmProgress.ProgressBar1.value + 1 per = per + 5 frmProgress.Caption = "创建Shape文件进度:" + str(per) + "%" End If End If End If End With DoEvents Next ' frmProgress.Caption = "创建Shape文件进度:100%" End If Unload frmProgress '对象销毁 Set gds = Nothing Set desc = Nothing Set dc = Nothing Set lyr = Nothing 'Set pPolygons = Nothing Exit Sub 'errHandle: ' Exit Sub End Sub |
|
|
3楼#
发布于:2003-10-08 19:23
其实我的意思很简单,就是一个shape文件的记录集,我选中了其中的几个部分,并且可能又重叠的,我如何把这些选中的部分合成一个记录集
|
|
4楼#
发布于:2003-10-13 17:15
这样啊 ,用recordset.union就可以了吧
|
|