[求助]：这个功能能否将其编成一个按钮？

geraldxyz

在cad板块发现了这样一篇帖子：
原文地址：http://www.xdcad.net/forum/showt ... d=894063#post894063

摘录精华如下：

回复: 最初由 chenhang 发布
请问怎么把组分解开
因为我图中的组都没有命名，而且有很多组，如果把要分解的组在GROUP的菜单中找出来再分解很麻烦。有什么命令可以直接分解组。就象炸开块一样？  



这是别人写的，借花献佛

代码:

  
'将选定的组合分解开
'由于不能通过选定的对象来直接找到其组合名称，只能通过循环比较对象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

  


看代码似乎可以实现在CAD正式版中得到像CAD LT版一样的快速解组功能，但是不知道如何才能把它编为一个工具栏的按钮，哪位朋友可以帮忙编译一下生成一个直接可以用的脚本啊？多谢了！