通过鼠标点取数字进行求和、求积的程序

gjliang

Sub opsum()
Dim ss As AcadSelectionSet
Set ss = GetSelSet
Dim i As Integer
Dim a As Double
Dim ent As AcadEntity
For Each ent In ss
a = ent.textString
e = a
d = d + e
Dim ent2height As String
ent2height = ent.height
Next
f = FormatNumber(d, 3, vbture, , vbFalse)
Dim text2 As String
ThisDrawing.Utility.InitializeUserInput 0, "1 2"
text2 = ThisDrawing.Utility.GetKeyword(vbCrLf & 选项"[更改(1)/插入(2)](1): ")
If text2 = "" Or text2 = "1" Then text2 = "1"
If text2 = "1" Then
Dim ent1 As AcadEntity
ThisDrawing.Utility.GetEntity ent1, pt1, "选择更改数字："
ent1.textString = f
End If
If text2 = "2" Then
Dim pt2 As Variant
Dim ent2 As AcadText
pt2 = ThisDrawing.Utility.GetPoint(, "插入：")
Set ent2 = ThisDrawing.ModelSpace.AddText(f, pt2, ent2height)
End If
End Sub

Sub opmul()
Dim ss As AcadSelectionSet
Set ss = GetSelSet
Dim ent As AcadEntity
Dim a As Double
Dim d As Double
d = 1
For Each ent In ss
a = ent.textString
e = a
d = d * e
Dim height As String
height = ent.height
Next
f = FormatNumber(d, 3, vbture, , vbFalse)
On Error Resume Next
ThisDrawing.Utility.InitializeUserInput 0, "1 2"
text2 = ThisDrawing.Utility.GetKeyword(vbCrLf & "选项[更改(1)/插入(2)](1): ")
If text2 = "" Or text2 = "1" Then text2 = "1"
If text2 = "1" Then
Dim ent1 As AcadEntity
ThisDrawing.Utility.GetEntity ent1, pt1, "选择更改数字："
ent1.textString = f
End If
If text2 = "2" Then
Dim pt2 As Variant
Dim ent2 As AcadText
pt2 = ThisDrawing.Utility.GetPoint(, "插入点：")
Set ent2 = ThisDrawing.ModelSpace.AddText(f, pt2, height)
End If
End Sub

Function GetSelSet() As AcadSelectionSet
Dim ss As AcadSelectionSet
Dim ssName As String
ssName = "ICKFIRST"
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
ThisDrawing.SetVariable "filedia", 1
End Function

subtlation

text2 = ThisDrawing.Utility.GetKeyword(vbCrLf & 选项"[更改(1)/插入(2)](1): ")
这句有错误，引号的位置不对。
特意为什么功能编的？输出数据确定为3位小数。象标高

gzy

刚翻译到SuppressTrailingZeros 属性，想起你这个程序。
  觉得你可以使用该属性去控制小数后面的0。

gjliang

统计材料表时不用按计算器了啊，用鼠标点就可以了:)

subtlation

哦，我做结构的，不用材料表，不熟悉。
如果材料表的项数和每一项名称都固定。用属性做个属性块。让属性块里面的数据自动求和求乘积也不错。
我的钢筋表就是这样做的。

xbbcad

用属性块好还是用扩展数据好？我觉得给对象添加扩展数据蛮有用的。

lixy

good

mikewolf2k

subtlation发表于2003-12-2 9:09:00text2 = ThisDrawing.Utility.GetKeyword(vbCrLf & 选项"(1): ")
这句有错误，引号的位置不对。
特意为什么功能编的？输出数据确定为3位小数。象标高

text2 = ThisDrawing.Utility.GetKeyword(vbCrLf & 选项 & "[更改(1)/插入(2)](1): ")

另外有个formatnumber函数没有,运行不了(autocad2000 EN)
等有空了仔细看看,我也向做个一样功能的.谢谢搂主.

gjliang

是统计材料明细表用的，我们专业没有专业的二次开发软件，都是在cad下画图，至于一些材料明细表都是拷贝上次的图进行修改，这样在计算时比较麻烦，就写了这个程序，计算时直接在屏幕上选取数值就可以进行求和、求积的计算了，图省事。formatnumber是格式化数字格式的，我不知道是不是需要装vb6.0才能用啊，我们同事没有装vb6.0的用的都挺好。（cad2002）

岁月无身

subtlation发表于2003-12-3 13:13:00哦，我做结构的，不用材料表，不熟悉。如果材料表的项数和每一项名称都固定。用属性做个属性块。让属性块里面的数据自动求和求乘积也不错。我的钢筋表就是这...

我也是做结构的，但我对程序还不怎么懂，我们的材料表中一般要统计的数字是这样的 钢板的格式 单重 数量 总重 -20x120x120 20 2 40 我想单重通过钢板的格式中提取数据求得，总重又通过单重和数量的乘积得出 怎么弄这个程序呢？ 你说你的钢筋材料表是这么统计的吗？