[求助]关于属性块内属性值的求和
各位好，我平时在做材料明细表时一般都是用属性块来做，然后导出到excel里求值后再导回cad，最近写了个程序可以直接对属性块内的数量和单重进行求值，但我想求出各个结果后在求总和，但本人由于才疏学浅无法实现这一目的，请各位帮忙给改一下程序，程序代码如下：（另附上一个属性块做的明细表，可以用这个文件进行调试）Sub cal()
Dim ent As Object
Dim attvar As Variant
Dim ss As AcadSelectionSet
Set ss = GetSelSet
For Each ent In ss
If TypeOf ent Is AcadBlockReference Then
attvar = ent.GetAttributes
End If
Dim i As Integer
i = 0
For i = LBound(attvar) To UBound(attvar)
Dim a As Double
Dim b As Double
Dim c As Variant
Dim d As Variant
a = attvar(3).textString
b = attvar(4).textString
c = a * b
attvar(5).textString = c
Dim n As Integer
For n = 0 To ss.Count - 1
n = n + 1
d = c
d = d + d
Next
Next
Next
Dim newtext As AcadText
Dim point1 As Variant
point1 = ThisDrawing.Utility.GetPoint(, "输入总和插入点：")
'attvar(5).textString = c
Set newtext = ThisDrawing.ModelSpace.AddText(d, point1, 3.5)
End Sub
Function GetSelSet() As AcadSelectionSet
Dim ss As AcadSelectionSet
Dim ssName As String
ssName = "PICKFIRST"
On Error Resume Next
Set ss = ThisDrawing.SelectionSets.add(ssName)
If Err Then
Set ss = ThisDrawing.SelectionSets(ssName)
ss.Delete
End If
Set ss = ThisDrawing.PickfirstSelectionSet
If ss.Count = 0 Then
Set ss = ThisDrawing.SelectionSets(ssName)
If Err Then Set ss = ThisDrawing.SelectionSets.add(ssName)
ss.Clear
ss.SelectOnScreen
End If
Set GetSelSet = ss
End Function
这是图形文件
本帖最后由 作者 于 2003-6-14 17:15:56 编辑这是图形文件,期望得到您的帮助
在循环体外定义一个变量保存值即可.
Dim d As Variant,比如这儿定义d保存总重.For Each ent In ss
If TypeOf ent Is AcadBlockReference Then
attvar = ent.GetAttributes
End If
Dim i As Integer
i = 0
For i = LBound(attvar) To UBound(attvar)
Dim a As Double
Dim b As Double
Dim c As Variant
a = attvar(3).textString
b = attvar(4).textString
c = a * b
attvar(5).textString = c
d = d + c
Next
Next
其实变量最好放到循环体外这样可以加快运行速度也可使值不会在下一次循环时被清除. 大侠些，有没有这种现成的求多个相同块中某个数值的和，插入到指定位置？求分享一个，感激不尽。
页:
[1]