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

fang:

我想通过这段代码实现提取"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

首先 i=i+1 这句去掉

tnt123688

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:

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

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

tnt123688

fang: 发表于 2012-6-10 17:59
不行啊，亲!直接显示执行错误！？？？？

错误信息？

yshf

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

2. 
   
3. Dim sum As Single
   
4.     Dim i As Integer
   
5.     Dim PlineObj As Object
   
6.    
   
7.     For i = 0 To sset.Count - 1
   
8.         Set PlineObj = sset.Item(i)
   
9.         sum = sum + PlineObj.Area
   
10.     Next
    

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

fang:

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

,多谢多谢！

VBALISPER

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

其实就是多余了i = i + 1