获取组名清单lisp程序

wyj_007 · 发表于 2004-3-4 12:58

请求编写获取组名清单lisp程序，主要功能是获取组名清单，包刮未命名编组名。如谁能编出，本人不胜感激。

meflying · 发表于 2004-3-4 14:52

(defun c:test( / objdict grpdict lst name names)
(setq objdict (namedobjdict))
(setq grpdict (dictsearch objdict "ACAD_GROUP"))
(setq lst (entget (cdar grpdict)))
(while (setq name (assoc 3 lst))
(setq names (append names (list (cdr name))))
(setq lst (cdr (member name lst)))
)
names
)

wyj_007 · 发表于 2004-3-4 21:25

没想到这么快就有了lisp程式，你们的敬业精神令我十分敬佩!
我连忙欣喜若狂在CAD2000下进行测试，但发现它还不能清除那些不在Group命令表现的组名。
如下面例子中grouptext1.dwg文件中NAMES体现为
NAMES = ("*A1" "*A2" "*A3" "*A4" "*A5" "*A6" "*A7" "*A8" "*A9"
"*A10" "*A11" "*A12" "*A13")
但"*A9" "*A10" "*A11" "*A12"组名在Group命令组名清单中是不体现的。
我迫切需要能获得仅包含Group命令中组名清单的lisp程式。
万分感谢您对我的帮助，真希望“明经CAD社区”越办越旺! ! !

meflying · 发表于 2004-3-5 08:21

是你说要包括未命名的啊？？？这些*A?就是未命名的组名，看了你图，没有一个已命名的组（就是用group命令在对话框里看不到），那些组都是未命名，它们的组名就是你返回的那些，并没有错啊。。。

如果你不想要这些未命名的组名，可以返回后去掉前面带*号的组名。。。

wyj_007 · 发表于 2004-3-5 09:17

如果您点中group命令中的第六个参数框(先把光标位置放于group清单中，再用tab键移至第六个参数框），也就是从上到下算起的第一个叫包含未命名的复选框(unnamed),答案就出现了，您会发现"*A9" "*A10" "*A11" "*A12"确实不出现，但"*A1" "*A2" "*A3" "*A4" "*A5" "*A6" "*A7" "*A8" "*A9"却是出现的，而NAMES = ("*A1" "*A2" "*A3" "*A4" "*A5" "*A6" "*A7" "*A8" "*A9" "*A10" "*A11" "*A12" "*A13") 又是正确的，对于这个现象我该How to do ?对于这个困惑和解决办法我已思考了好几个月了，恳请大侠百忙中指点迷津，在下万分感激。

meflying · 发表于 2004-3-5 17:55

(defun Hasent(grpdict grpname)
(setq group (dictsearch (cdar grpdict) grpname))
(if (= (cdr (assoc 70 group)) 3)
nil
t)
) (defun c:test( / objdict lst name names)
(setq objdict (namedobjdict))
(setq grpdict (dictsearch objdict "ACAD_GROUP"))
(setq lst (entget (cdar grpdict)))
(while (setq name (assoc 3 lst))
(if (Hasent grpdict (cdr name))
(setq names (append names (list (cdr name))))
)
(setq lst (cdr (member name lst)))
)
names
)

wyj_007 · 发表于 2004-3-5 20:48

我用怀疑的心情赶紧进行了测试，但这次结果使我喜出望外，我终于摆脱这个使我夜不能寝的Group魔咒了，您真是我的大恩人!!! 本人一口气地数了两遍，程式一共使用了368个字符(不包括空格和说明)。为了表达我对您最崇高的敬意和谢意，我决定给您汇368元酬金以表感谢。请您在后面的帖子上附上您的一个信用卡帐号和名字或汇款地址，请您务必收下!!!

还有我刚去了XDCAD网站，他们的爱心币银行做法可以使网站办得更红火更旺，很值得借鉴，真希望你们的网站有更多更好更精彩的内容。那真是广大CAD爱好者的福音啊!

wyj_007 · 发表于 2004-3-8 11:25

请超级版主meflying快给给我一个回音!!谢谢!!

meflying · 发表于 2004-3-8 12:35

回什么？

wyj_007 · 发表于 2004-3-10 16:10

为了表达我对您最崇高的敬意和谢意，我决定给您汇368元酬金以表感谢,请您告诉我一个信用卡帐号和名字或汇款地址，请您务必收下!!! 我终于摆脱这个使我夜不能寝的Group魔咒了，您真是我的大恩人!!!

账号		自动登录	找回密码
密码			注册

获取组名清单lisp程序

本帖子中包含更多资源