求助

sdo7758258

请问：以下程序是用什么编的，在CAD中如何使用？ 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

efan2000

是VBA的程序，从代码上看是对文字进行修改和插入的操作，可以直接在VB编辑器中粘贴运行。