|
|
Public Sub addentstosset(ByVal ents As Variant, ByRef sset As AcadSelectionSets)
Dim objcollection() As AcadEntity
ReDim objcollection(UBound(ents))
If VarType(ents) vbArray + vbArray Then
MsgBox "数据无效！"
End If
For i = 0 To UBound(ents)
objcollection(i) = ents(i)
Next i
sset.AddItems objcollection
End Sub
Sub creat()
Dim sset As AcadSelectionSet
On Error Resume Next
If Not IsNull(ThisDrawing.SelectionSets.Item("example")) Then
Set sset = ThisDrawing.SelectionSets.Item("example")
sset.Delete
End If
Set sset = ThisDrawing.SelectionSets.Add("example")
Dim pt(0 To 2) As Double
pt(0) = 0
pt(1) = 0
pt(2) = 0
Dim cirl1 As AcadCircle, cirl2 As AcadCircle, cirl3 As AcadCircle
Set cirl1 = ThisDrawing.ModelSpace.AddCircle(pt, 50)
Set cirl2 = ThisDrawing.ModelSpace.AddCircle(pt, 80)
Set cirl3 = ThisDrawing.ModelSpace.AddCircle(pt, 110)
Dim objcollection(0 To 2) As AcadEntity
Set objcollection(0) = cirl1
Set objcollection(1) = cirl2
Set objcollection(2) = cirl3
Call addentstosset(objcollection, sset)
MsgBox sset.Count
sset.Delete
End Sub |
|
置顶卡
