fang: 发表于 2012-6-10 16:08:48

VBA某一图层中所有二位闭合多段线面积统计输出！？

我想通过这段代码实现提取"JMD"图层中所有闭合二位多段线的面积统计，但是不知道哪儿错了？面积一直显示为0！希望高手指点
' 创建新的选择集
    Dim sset As AcadSelectionSet
    Dim FilterType As Variant, FilterData As Variant
    Dim gpCode(2) As Integer, dataValue(2) As Variant

    Set sset = ThisDrawing.SelectionSets.Add("ssl")
    '创建过滤器
    '本例为过滤图层为“JMD”的闭合多段线
    '使用的是变体数组进行定义

    '多段线过滤器
    gpCode(2) = 0
    dataValue(2) = "LWPolyline"

    '图层过滤器
    gpCode(1) = 8
    dataValue(1) = "JMD"

    FilterType = gpCode
    FilterData = dataValue

    ' 添加至选择集中，在选择过程中进行过滤
    ' 完成选择后按回车。
    sset.Select acSelectionSetAll, , , FilterType, FilterData

    ' 在选择集中循环并将每一已合条件的对象面积统计输出。

    Dim sum As Single
    Dim i As Integer
    Dim s As Variant
    Dim PlineObj As AcadLWPolyline
    For i = 0 To ssetObj.Count - 1
      i = i + 1
      PlineObj = ssetObj.Item(i)
      s(i) = PlineObj.Area
      sum = sum + s(i)
    Next i
    ThisDrawing.Utility.Prompt "拆除砌体总面积为：" & sum & "平方米"

tnt123688 发表于 2012-6-10 16:20:38

首先 i=i+1 这句去掉

tnt123688 发表于 2012-6-10 16:23:12

For i = 0 To ssetObj.Count - 1
      i = i + 1
      PlineObj = ssetObj.Item(i)
      s(i) = PlineObj.Area
      sum = sum + s(i)
    Next i

改成
sum =0
for each PlineObj in ssetObj
sum = sum+PlineObj.Area
next

fang: 发表于 2012-6-10 17:59:22

tnt123688 发表于 2012-6-10 16:23 static/image/common/back.gif
For i = 0 To ssetObj.Count - 1
      i = i + 1
      PlineObj = ssetObj.Item(i)


不行啊，亲!直接显示执行错误！？？？？

tnt123688 发表于 2012-6-10 22:08:41

fang: 发表于 2012-6-10 17:59 static/image/common/back.gif
不行啊，亲!直接显示执行错误！？？？？

错误信息？

yshf 发表于 2012-6-10 22:52:04

Public Sub abc()
' 创建新的选择集
    Dim sset As AcadSelectionSet
    Dim FilterType As Variant, FilterData As Variant
    Dim gpCode(1) As Integer, dataValue(1) As Variant

    Set sset = ThisDrawing.SelectionSets.Add("ssa")
    '创建过滤器
    '本例为过滤图层为“JMD”的闭合多段线
    '使用的是变体数组进行定义

    '多段线过滤器
    gpCode(0) = 0
    dataValue(0) = "LWPOLYLINE"
   

    '图层过滤器
    gpCode(1) = 8
    dataValue(1) = "JMD"

    FilterType = gpCode
    FilterData = dataValue

    ' 添加至选择集中，在选择过程中进行过滤
    ' 完成选择后按回车。
    sset.Select acSelectionSetAll, , , FilterType, FilterData

    ' 在选择集中循环并将每一已合条件的对象面积统计输出。

    Dim sum As Single
    Dim PlineObj As Object
   

    For Each PlineObj In sset
      sum = sum + PlineObj.Area
    Next
    ThisDrawing.Utility.Prompt "拆除砌体总面积为：" & sum & "平方米"

    sset.Delete

End Sub

yshf 发表于 2012-6-10 22:56:34

本帖最后由 yshf 于 2012-6-10 22:58 编辑


Dim sum As Single
    Dim i As Integer
    Dim PlineObj As Object
   
    For i = 0 To sset.Count - 1
      Set PlineObj = sset.Item(i)
      sum = sum + PlineObj.Area
    Next

fang: 发表于 2012-6-11 10:08:36

yshf 发表于 2012-6-10 22:56 static/image/common/back.gif


,多谢多谢！

VBALISPER 发表于 2012-6-11 20:01:49

Sub tt()
' 创建新的选择集
    Dim sset As AcadSelectionSet
    Dim FilterType As Variant, FilterData As Variant
    Dim gpCode(1) As Integer, dataValue(1) As Variant

    Set sset = ThisDrawing.SelectionSets.Add("sss2")
    '创建过滤器
    '本例为过滤图层为“JMD”的闭合多段线
    '使用的是变体数组进行定义


    '图层过滤器
   
    '多段线过滤器
    gpCode(0) = 0
    dataValue(0) = "LWPolyline"

    '图层过滤器
    gpCode(1) = 8
    dataValue(1) = "JMD"

    FilterType = gpCode
    FilterData = dataValue
   
    Dim mode As Integer
    mode = acSelectionSetAll '全选模式

    ' 添加至选择集中，在选择过程中进行过滤
    ' 完成选择后按回车。
    sset.Select mode, , , FilterType, FilterData


    Dim sum As Double
    Dim i As Integer
    Dim s As Variant
    Dim PlineObj As Object
    For i = 0 To ThisDrawing.ActiveSelectionSet.Count - 1

      Set PlineObj = ThisDrawing.ActiveSelectionSet.Item(i)
      s = PlineObj.Area
      sum = sum + s
    Next i
    ThisDrawing.Utility.Prompt "拆除砌体总面积为：" & sum & "平方米"
    ThisDrawing.SelectionSets.Item("sss2").Delete '删除引用的选择集
End
End Sub

ps122hb 发表于 2012-6-13 12:27:26

其实就是多余了i = i + 1
页: [1] 2
查看完整版本: VBA某一图层中所有二位闭合多段线面积统计输出！？