[在线等待]请问在建立选择集时怎样才能使用平移与缩放命令？

arden

主要是统计面积，我先用闭合多段线框出不同的用地范围，然后统计各种用地的面积。有谁能给出更好的方法，我觉得还是用选择好些。

myfreemind

原来是统计面积啊，这个简单啊，你可以把不同的多边形赋给它编码，然后按照编码来统计不就简单的多了，也不用去手选！

myfreemind

这个程序给你参考一下，是我以前写的，我只统计两种用地类型，你可以再加！

Option Explicit
Public fl As Integer
Sub Flmjtj()
On Error Resume Next
Dim outtxt As String
Dim s(50) As Long
Dim zmj As Long
Dim zs As Integer
Dim i As Integer
Dim areaobj As AcadLWPolyline
Dim sset As AcadSelectionSet
Dim minpnt As Variant
Dim maxpnt As Variant
Dim areains(0 To 2) As Double
Dim txtarea As String
Dim txtins As String
Dim ms As String
Dim txtobj As AcadText
Dim Ftype As Variant
Dim Fdata  As Variant
Dim entity As AcadEntity
Dim hatchobj As AcadHatch
Dim pname As String
Dim pype As Long
Dim outloop(0 To 0) As AcadEntity
Dim zminpnt(0 To 2) As Double
Dim zmaxpnt(0 To 2) As Double
Dim sclayer As String
Dim Fllayer As String
Dim out1 As String
Select Case fl
Case 0
Fllayer = "LD"
Case 1
Fllayer = "SY"
Case 2
Fllayer = "ALLTD"
End Select

Dim us1 As Integer
us1 = ThisDrawing.GetVariable("userr1")
sclayer = ThisDrawing.GetVariable("clayer")


If ThisDrawing.SelectionSets.Count > 0 Then
        For i = 0 To ThisDrawing.SelectionSets.Count - 1
        ThisDrawing.SelectionSets.Item(i).Clear
        ThisDrawing.SelectionSets.Item(i).Delete
        Next
End If

'**************
Dim gpCode(3) As Integer, dataValue(3) As Variant

  '创建过滤器
  '本例为过滤polyline or lwpolyline
  '使用的是变体数组进行定义

  '分组运算符
  gpCode(0) = -4
  dataValue(0) = "<or"

  'polyline过滤器
  gpCode(1) = 0
  dataValue(1) = "olyLINE"

  'lwpolyline过滤器
  gpCode(2) = 0
  dataValue(2) = "LwPolyline"
  
  



  '分组运算符
  gpCode(3) = -4
  dataValue(3) = "or>"

  Ftype = gpCode
  Fdata = dataValue
'**************






Set sset = ThisDrawing.SelectionSets.Add("smarea1")
'选择
sset.Select acSelectionSetAll, , , Ftype, Fdata
i = 1
For Each entity In sset
If entity.Layer = Fllayer Then  
   
        entity.GetBoundingBox minpnt, maxpnt
        
      
        zminpnt(0) = minpnt(0) - 250
        zminpnt(1) = minpnt(1) - 250
        zminpnt(2) = 0
        zmaxpnt(0) = maxpnt(0) + 250
        zmaxpnt(1) = maxpnt(1) + 250
        zmaxpnt(2) = 0
        
      
        If entity.Closed = False Then
      
         ThisDrawing.Application.ZoomWindow zminpnt, zmaxpnt
          entity.Color = acRed
        entity.Highlight True '高亮
         MsgBox "当前视口图形不闭合，请检查！"
        
        
        Exit Sub
         End If
        
        
        '判断比例尺
        
        Select Case us1
        Case 500
        txtarea = entity.Area / 4
        
        Case 1000
        txtarea = entity.Area
        Case 2000
        txtarea = entity.Area * 4
         Case Else
        MsgBox "你的比例尺不在可计算之列,请检查你的比例尺"
        Exit Sub
        
        End Select
        
        s(i) = txtarea
   
         form1.TextBox1.Text = i
        i = i + 1
      
End If
Next
zs = i
For i = 1 To zs
zmj = zmj + s(i)
Next
Select Case fl
Case 0
outtxt = "绿地总面积=" & Format(zmj, "#0.00") & "平方米" & "=" & Format(zmj / 666.66666, "####0.00") & "亩"
out1 = "******************************************" & vbCrLf & outtxt & vbCrLf & "******************************************"
Case 1
outtxt = "水域总面积=" & Format(zmj, "#0.00") & "平方米" & "=" & Format(zmj / 666.66666, "####0.00") & "亩"
out1 = "******************************************" & vbCrLf & outtxt & vbCrLf & "******************************************"
End Select
form1.Label1.Caption = out1
'Debug.Print out1
'Open "l:\flmj.txt" For Output As #1
'Print #1, out1
'Close #1

'MsgBox zmj
sset.Clear
sset.Delete

End Sub

arden

非常谢谢myfreemind,这两天没上网,你的程序还没来得及细看,我是要统计各村组的各种土地利用情况,我也是给每个多边形加了属性,但村组之间分开还是要分别选.