AutoCAD VBA对象的组合和拆散

AutoCAD VBA对象的组合和拆散，很好用的操作，代码如下。

Sub AddUnNameGroup()
Dim SelObjects As AcadSelectionSet
Dim appendObjs() As AcadEntity
Set SelObjects = GetSelSet
Dim UnNameGroup As AcadGroup
Set UnNameGroup = ThisDrawing.Groups.Add("*")
ReDim appendObjs(0 To SelObjects.Count - 1)
Dim i As Integer
For i = 0 To SelObjects.Count - 1
Set appendObjs(i) = SelObjects.Item(i)
Next
UnNameGroup.AppendItems appendObjs
End Sub
Public Function GetSelSet() As AcadSelectionSet
Dim ss As AcadSelectionSet
Set ss = ThisDrawing.PickfirstSelectionSet
If ss.Count = 0 Then
Dim ssName As String
ssName = "strSSet"
On Error Resume Next
Set ss = ThisDrawing.SelectionSets(ssName)
If Err Then Set ss = ThisDrawing.SelectionSets.Add(ssName)
ss.Clear
ss.SelectOnScreen
End If
Set GetSelSet = ss
End Function
Sub DelUnNameGroup()
Dim SelGroup As AcadGroup
Dim SelObjects As AcadSelectionSet
Set SelObjects = GetSelSet
Dim ObjInSelSet As AcadObject
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim ObjInGroup As AcadObject
On Error Resume Next
For i = 0 To SelObjects.Count - 1
Set ObjInSelSet = SelObjects.Item(i)
For j = 0 To ThisDrawing.Groups.Count - 1
For k = 0 To ThisDrawing.Groups.Item(j).Count - 1
Set ObjInGroup = ThisDrawing.Groups.Item(j).Item(k)
If ObjInGroup.ObjectID = ObjInSelSet.ObjectID Then
ThisDrawing.Groups.Item(i).Delete
Exit For
End If
Next
Next
Next
End Sub

代码完。