原帖由 landis 于 2007-9-29 11:00 发表 
材料表中的数据求和，要能自动去除非数字字符，比如框选的对象中有"/"之类的非数字字符。最后给出有效数据总数及求和结果。
Sub jia()
ActiveDocument.Utility.Prompt "请选择text或Mtext数字求和"
Dim total As Double
Dim j As Integer
total = 0
Dim ssetObj As AcadSelectionSet
Set ssetObj = CreateSelectionSet("numberobj")
Dim ftype, fdata
'BuildFilter ftype, fdata, 0, "text"
BuildFilter ftype, fdata, -4, "<or", 0, "text", 0, "Mtext", -4, "or>"
ssetObj.SelectOnScreen ftype, fdata
For i = 0 To ssetObj.Count - 1
If IsNumeric(ssetObj.Item(i).textString) Then
total = total + ssetObj.Item(i).textString
j = j + 1
Else
End If
Next i
ssetObj.Delete
ActiveDocument.Utility.Prompt "共选择了 " & j & " 个数,总和 ＝ " & total
Dim returnPnt As Variant
' Return a point using a prompt
returnPnt = ThisDrawing.Utility.GetPoint(, "Enter a point: ")
' Create the text object in model space
Set textObj = ThisDrawing.ModelSpace.AddText("求和=" & Str(total), returnPnt, height)
End Sub
Sub cheng()
ActiveDocument.Utility.Prompt "请选择text或Mtext求积"
Dim ji As Double
Dim j As Integer
ji = 1
Dim ssetObj As AcadSelectionSet
Set ssetObj = CreateSelectionSet("numberobj")
Dim ftype, fdata
BuildFilter ftype, fdata, -4, "<or", 0, "text", 0, "Mtext", -4, "or>"
ssetObj.SelectOnScreen ftype, fdata
For i = 0 To ssetObj.Count - 1
If IsNumeric(ssetObj.Item(i).textString) Then
ji = ji * ssetObj.Item(i).textString
j = j + 1
Else
End If
Next i
Dim textObj As AcadText
ssetObj.Delete
ActiveDocument.Utility.Prompt "共选择了 " & j & " 个数,乘积 ＝ " & ji
height = 4
End Sub
Sub Example_AddText()
' This example creates a text object in model space.
Dim textObj As AcadText
Dim textString As String
Dim insertionPoint(0 To 2) As Double
Dim height As Double
' Define the text object
textString = "Hello, World."
insertionPoint(0) = 2: insertionPoint(1) = 2: insertionPoint(2) = 0
height = 100
Dim returnPnt As Variant
' Return a point using a prompt
returnPnt = ThisDrawing.Utility.GetPoint(, "Enter a point: ")
' Create the text object in model space
Set textObj = ThisDrawing.ModelSpace.AddText(textString, returnPnt, height)
ZoomAll
End Sub
Public Function CreateSelectionSet(Optional ssName As String = "ss") As AcadSelectionSet
'返回一个空白选择集
Dim ss As AcadSelectionSet
'该句改为:
'BuildFilter ftype, fdata, -4, "<or", 0, "text", 0, "Mtext", -4, "or>"
'然后再取值适用性就广了哈
On Error Resume Next
Set ss = ThisDrawing.SelectionSets(ssName)
If Err Then Set ss = ThisDrawing.SelectionSets.Add(ssName)
ss.Clear
Set CreateSelectionSet = ss
End Function
Public Sub BuildFilter(typeArray, dataArray, ParamArray gCodes())
'用数组方式填充一对变量以用作为选择集过滤器使用
Dim ftype() As Integer, fdata()
Dim index As Long, i As Long
index = LBound(gCodes) - 1
For i = LBound(gCodes) To UBound(gCodes) Step 2
index = index + 1
ReDim Preserve ftype(0 To index)
ReDim Preserve fdata(0 To index)
ftype(index) = CInt(gCodes(i))
fdata(index) = gCodes(i + 1)
Next
typeArray = ftype: dataArray = fdata
End Sub |
狗仔卡
楼主
