'将选定的组合分解开 '由于不能通过选定的对象来直接找到其组合名称,只能通过循环比较对象ID的方法 '来解决这个问题,运行时可能会慢点,但对象不多的情况下应该没问题 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(J).Delete Exit For End If Next Next Next End Sub
'对象选择函数 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 <> 0 Then Err.Clear Set ss = ThisDrawing.SelectionSets.Add(ssName) End If ss.Clear ss.SelectOnScreen End If Set GetSelSet = ss End Function