在晓东cad板块发现了这样一篇帖子: 原文地址:http://www.xdcad.net/forum/showthre...4063#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版一样的快速解组功能,但是不知道如何才能把它编为一个工具栏的按钮,哪位朋友可以帮忙编译一下生成一个直接可以用的脚本啊?多谢了! |