Option Explicit
'创建选择集
Public Function createSSet(ByVal SSetName As String) As AcadSelectionSet
Dim SSet As AcadSelectionSet
Dim i As Integer
For i = 0 To ThisDrawing.SelectionSets.Count - 1
Set SSet = ThisDrawing.SelectionSets.Item(i)
If StrComp(SSet.Name, SSetName, vbTextCompare) = 0 Then
SSet.Delete
Exit For
End If
Next i
Set createSSet = ThisDrawing.SelectionSets.Add(SSetName)
End Function
Public Sub demoAddSSet()
Dim ss As AcadEntity
Dim c As AcadCircle
Dim a As AcadLine
Dim b As AcadArc
Dim d As AcadLWPolyline
Dim cc As Double
Dim dd As Double
Dim ee As Double
Dim ff As Double
cc = 0: dd = 0: ee = 0: ff = 0
Dim SSet As AcadSelectionSet
Set SSet = createSSet("mySelectionSet")
SSet.SelectOnScreen
For Each ss In SSet
If TypeOf ss Is AcadCircle Then
cc = cc + ss.Circumference
ElseIf TypeOf ss Is AcadLine Then
dd = dd + ss.Length
ElseIf TypeOf ss Is AcadArc Then
ee = ee + ss.ArcLength
ElseIf TypeOf ss Is AcadLWPolyline Then
ff = ff + ss.Length
End If
Next
MsgBox "所有圆的周长:" & cc & " " & Chr(10) & "所有线段总长:" & dd & " " & Chr(10) & "所有圆弧总长:" & cc & " " & Chr(10) & "所有多段线总长:" & cc & " "
End Sub