gjliang 发表于 2003-12-1 19:08:00

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

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 = "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
ThisDrawing.SetVariable "filedia", 1
End Function

subtlation 发表于 2003-12-2 09:09:00

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

gzy 发表于 2003-12-2 15:30:00

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

gjliang 发表于 2003-12-3 12:56:00

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

subtlation 发表于 2003-12-3 13:13:00

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

xbbcad 发表于 2003-12-3 15:13:00

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

lixy 发表于 2003-12-29 00:48:00

good

mikewolf2k 发表于 2003-12-29 19:35:00

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


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

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

gjliang 发表于 2004-1-6 15:44:00

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

岁月无身 发表于 2004-4-15 12:35:00

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


<BR>我也是做结构的，但我对程序还不怎么懂，我们的材料表中一般要统计的数字是这样的


钢板的格式                                               单重               数量               总重


-20x120x120                               20                                               2                                                                40


我想单重通过钢板的格式中提取数据求得，总重又通过单重和数量的乘积得出


怎么弄这个程序呢？


你说你的钢筋材料表是这么统计的吗？
页: [1] 2 3
查看完整版本: 通过鼠标点取数字进行求和、求积的程序