明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1090|回复: 2

[求助]这个功能(快速解组)能否将其编成一个按钮? (附代码)

[复制链接]
发表于 2008-5-27 00:34:00 | 显示全部楼层 |阅读模式

在晓东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版一样的快速解组功能,但是不知道如何才能把它编为一个工具栏的按钮,哪位朋友可以帮忙编译一下生成一个直接可以用的脚本啊?多谢了!

发表于 2008-5-27 18:12:00 | 显示全部楼层
把以下内容编辑成LSP文件并加载到启动组中去:
  1. ;;加载VBA程序
  2. (vl-vbaload (findfile "UnNameGroup.dvb"))
  3. ;;一些VBA程序的触发程序
  4. (defun c:ag()(princ))
  5. (defun c:dg()(princ))
把以下文件下载并保存到AUTOCAD支持目录下:

命令:
AG:将选择集自动转化为无名组合。
DG:将选定的组合打散。
 楼主| 发表于 2008-5-28 21:12:00 | 显示全部楼层

多谢管理员热情相助!问题已经完美解决了!

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-26 09:37 , Processed in 0.170402 second(s), 24 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表