根据要求编写的vba程序如下,楼主不妨试试。
Option Explicit
'适用单行文字和部分多行文字
Private Sub 数字文本同步增减()
On Error Resume Next
Dim SSet As AcadSelectionSet
Set SSet = ThisDrawing.PickfirstSelectionSet
If SSet.count = 0 Then
If Not IsNull(ThisDrawing.SelectionSets.Item("Example")) Then
Set SSet = ThisDrawing.SelectionSets.Item("Example")
SSet.Delete
End If
Set SSet = ThisDrawing.SelectionSets.Add("Example")
SSet.SelectOnScreen
Else
ThisDrawing.Utility.Prompt vbLf & "已选择操作对象"
End If
Dim Ent As AcadEntity
Dim A As String
Dim B As Variant
Dim Increment As Double
Increment = ThisDrawing.Utility.GetReal(vbLf & "请输入数字增量: ")
For Each Ent In SSet
If IsNumeric(Ent.TextString) = True Then
A = Ent.TextString
B = Val(A)
B = B + Increment
' b = Format(b, "##.00") '可设置小数位数
B = CStr(B)
Ent.TextString = B
End If
Next
End Sub
全部回复(1 )
只看楼主 我来说两句 抢板凳Option Explicit
'适用单行文字和部分多行文字
Private Sub 数字文本同步增减()
On Error Resume Next
Dim SSet As AcadSelectionSet
Set SSet = ThisDrawing.PickfirstSelectionSet
If SSet.count = 0 Then
If Not IsNull(ThisDrawing.SelectionSets.Item("Example")) Then
Set SSet = ThisDrawing.SelectionSets.Item("Example")
SSet.Delete
End If
Set SSet = ThisDrawing.SelectionSets.Add("Example")
SSet.SelectOnScreen
Else
ThisDrawing.Utility.Prompt vbLf & "已选择操作对象"
End If
Dim Ent As AcadEntity
Dim A As String
Dim B As Variant
Dim Increment As Double
Increment = ThisDrawing.Utility.GetReal(vbLf & "请输入数字增量: ")
For Each Ent In SSet
If IsNumeric(Ent.TextString) = True Then
A = Ent.TextString
B = Val(A)
B = B + Increment
' b = Format(b, "##.00") '可设置小数位数
B = CStr(B)
Ent.TextString = B
End If
Next
End Sub
回复 举报