xjtuandrew
路人甲
路人甲
  • 注册日期2003-10-07
  • 发帖数56
  • QQ
  • 铜币264枚
  • 威望0点
  • 贡献值0点
  • 银元0个
阅读:1702回复:2

合并两块区域为一块

楼主#
更多 发布于:2003-12-15 12:22
各味大侠,如何将两个Poly 合并为一格ploy区域对象呢?
多谢
喜欢0 评分0
gis1117
  • 注册日期
  • 发帖数
  • QQ
  • 铜币
  • 威望
  • 贡献值
  • 银元
1楼#
发布于:2003-12-15 13:45
看看这个吧

http://gisempire.com/bbs/dispbbs.asp?boardID=39&ID=7049&replyID=51623&skin=1
举报 回复(0) 喜欢(0)     评分
gis1117
  • 注册日期
  • 发帖数
  • QQ
  • 铜币
  • 威望
  • 贡献值
  • 银元
2楼#
发布于:2003-12-15 13:48
This example uses the Union method to allow the user to union rectangles, ellipses and polygons. The user point and the new shape generated by the Union operation are added to the tracking layer as GeoEvents. To try this example, paste the code into the Declarations section of a form containing a Map named Map1 that has at least one MapLayer, and 3 OptionButtons named Option1, Option 2, and Option3. Press F5, and choose an option, then click on the map.  

Option Explicit
Dim shape1 As Object
Dim shape2 As Object
Dim union As Boolean

Private Sub doUnion(shape As Object)
  If Not union Then
    Set shape1 = shape
    union = True
    
  ElseIf union Then
    Set shape2 = shape
    Dim unionShape As MapObjects2.Polygon
    Dim unionEvent As New MapObjects2.GeoEvent
    
    Set unionShape = shape1.union(shape2, Map1.FullExtent)
    Set unionEvent = Map1.TrackingLayer.AddEvent(unionShape, 1)
    
    Set shape1 = Nothing

    union = False
  End If
End Sub

Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  
  If Button = 2 Then
    Dim r As New MapObjects2.Rectangle
    Set r = Map1.TrackRectangle
    Map1.Extent = r
    Exit Sub
  End If
  
  'Rectangle union
  If Option1.Value Then
    Dim rect As New MapObjects2.Rectangle
    Dim eventRect As New MapObjects2.GeoEvent
    Set rect = Map1.TrackRectangle
    Set eventRect = Map1.TrackingLayer.AddEvent(rect, 0)

    Call doUnion(rect)
    
  'Ellipse union
  ElseIf Option2.Value Then
    Dim elli As New MapObjects2.Ellipse
    Dim theExt As New MapObjects2.Rectangle
    Dim eventElli As New MapObjects2.GeoEvent
    
    Set theExt = Map1.TrackRectangle
    elli.Bottom = theExt.Bottom
    elli.Top = theExt.Top
    elli.Left = theExt.Left
    elli.Right = theExt.Right
    
    Set eventElli = Map1.TrackingLayer.AddEvent(elli, 0)
    Call doUnion(elli)
    
  'Polygon union

  ElseIf Option3.Value Then
    Dim poly As New MapObjects2.Polygon
    Dim eventPoly As New MapObjects2.GeoEvent
    Set poly = Map1.TrackPolygon
    Set eventPoly = Map1.TrackingLayer.AddEvent(poly, 0)
    Call doUnion(poly)
  End If
End Sub

Private Sub Form_Load()
  Option1.Caption = "Rectangle"
  Option2.Caption = "Ellipse"
  Option3.Caption = "Polygon"
  
  Map1.TrackingLayer.SymbolCount = 2
  With Map1.TrackingLayer.Symbol(0)
    .SymbolType = moFillSymbol

    .Style = moGrayFill
    .Color = moRed
    .OutlineColor = moRed
  End With
  With Map1.TrackingLayer.Symbol(1)
    .SymbolType = moFillSymbol
    .Style = moGrayFill
    .Color = moBlue
    .OutlineColor = moBlue
  End With
End Sub
举报 回复(0) 喜欢(0)     评分
xjtuandrew
路人甲
路人甲
  • 注册日期2003-10-07
  • 发帖数56
  • QQ
  • 铜币264枚
  • 威望0点
  • 贡献值0点
  • 银元0个
3楼#
发布于:2003-12-16 18:10
我用的是 VC++
代码如下:
VARIANT va;
VariantInit(&va);
va.vt=VT_DISPATCH
va.pdispatch = poly1.GetExtent().m_lpdispatch

CMoPolygon poly(poly1.Union(poly2,va));//执行到此行程序时,出现不可调试的错误 OLEAUT32的错误
如何解释呢?
举报 回复(0) 喜欢(0)     评分
gis1117
  • 注册日期
  • 发帖数
  • QQ
  • 铜币
  • 威望
  • 贡献值
  • 银元
4楼#
发布于:2003-12-17 09:01
Set unionShape = shape1.union(shape2, Map1.FullExtent)
    Set unionEvent = Map1.TrackingLayer.AddEvent(unionShape, 1)
是否语法错误?vc我没怎么写过
举报 回复(0) 喜欢(0)     评分
yaohongbo_play
路人甲
路人甲
  • 注册日期2003-10-16
  • 发帖数39
  • QQ85043308
  • 铜币182枚
  • 威望0点
  • 贡献值0点
  • 银元0个
5楼#
发布于:2003-12-25 10:10
procedure TForm_Main.MergeRecsPolygons(recs: IMoRecordset);
var
  Poly,Poly_LS:IMoPolygon;
begin
  if (not VarIsEmpty(recs))and(not VarIsNull(recs)) then
  begin
    if GetRecordShapeType(recs)=moPolygon then
    begin
      Poly_LS:=CoPolygon.Create;
      recs.MoveFirst;
      if not recs.EOF then
      begin
        poly:=IMoPolygon(IUnknown(recs.Fields.Item('Shape').Value));
        Poly_LS:=Poly;
      end;
      recs.MoveNext;
      while not recs.EOF do
      begin
        poly:=IMoPolygon(IUnknown(recs.Fields.Item('Shape').Value));
        Poly_LS:=IMoPolygon(Poly_LS.Union(poly,Map1.FullExtent));
        recs.MoveNext;
      end;
      if not VarIsEmpty(Poly_LS) then m_polys.Add(Poly_LS);
    end;
  end;
end;
举报 回复(0) 喜欢(0)     评分
游客

返回顶部