Sweety Posted December 29, 2010 Share Posted December 29, 2010 Hello GUYS. Is there any ready lisp or codes that could explode a group of enities that gathered by Group command please ? Thank you all. Sweety Quote Link to comment Share on other sites More sharing options...
Guest kruuger Posted December 29, 2010 Share Posted December 29, 2010 here is nice collection of "PURGE" routines (PurgeAllGroups) kruuger Quote Link to comment Share on other sites More sharing options...
Sweety Posted December 29, 2010 Author Share Posted December 29, 2010 here is nice collection of "PURGE" routines (PurgeAllGroups) kruuger Where is that collection dear krugger ? Thanxxxxxxx Quote Link to comment Share on other sites More sharing options...
Guest kruuger Posted December 29, 2010 Share Posted December 29, 2010 Where is that collection dear krugger ? Thanxxxxxxx upsss:oops: link is here: http://www.jtbworld.com/lisp/purger.htm kruuger Quote Link to comment Share on other sites More sharing options...
VVA Posted December 29, 2010 Share Posted December 29, 2010 Try it PAG - Purge All Groups PEG - Purge Empty Groups PUG - Purge Unnamed Groups (like *Annn) ; Ф-ция PurgeAllGroups ; Удаляет описание всех групп ; Аргумент [Тип]: ; НЕТ ; Возвращает: Nil (vl-load-com) (defun PurgeAllGroups (/ grpList index grp) (setq grpList (dictsearch (namedobjdict) "ACAD_GROUP")) (setq index 1) (while (setq grp (nth index grplist)) (if (= (car grp) 3) (entdel (cdr (nth (+ index 1) grplist))) ) (setq index (+ 1 index)) ) (princ)) ; Ф-ция PurgeEmptyGroups ; Удаляет описание всех пустых групп ; Аргумент [Тип]: ; Named = Тип [iNT] ; 0 — только именованные группы ; 1 — только неименованные группы ; t,nil — все группы ; Возвращает: Nil (defun PurgeEmptyGroups ( named / grpList index grp egrp named_list e_list) ;;; Библиотечная ф-ция, возвращает multiple group code (defun massoc (key alist / x nlist) (foreach x alist (if (eq key (car x)) (setq nlist (cons (cdr x) nlist)) )) (reverse nlist)) (setq named_list '(0 1)) (if (member named named_list)(setq named_list (list named))) (setq grpList (dictsearch (namedobjdict) "ACAD_GROUP")) (setq index 1) (while (setq grp (nth index grplist)) (if (= (car grp) 3) (progn (setq egrp (entget (cdr (nth (+ index 1) grplist)))) (if (member (cdr (assoc 70 egrp)) named_list) (progn (setq e_list (massoc 340 egrp)) (if(not (vl-member-if 'entget e_list)) (entdel (cdr (nth (+ index 1) grplist))) ) ) ) ) ) (setq index (+ 1 index)) ) (princ)) ; Ф-ция PurgeAllUnNamedGroups ; Удаляет описание всех анонимных групп *Annn ; Аргумент [Тип]: ; НЕТ ; Возвращает: Nil (defun PurgeAllUnNamedGroups (/ grpList index grp) (setq grpList (dictsearch (namedobjdict) "ACAD_GROUP")) (setq index 1) (while (setq grp (nth index grplist)) (if (= (car grp) 3) (progn (if (= (chr 42) (substr (cdr grp) 1 1)) (entdel (cdr (nth (+ index 1) grplist))) ) ) ) (setq index (+ 1 index)) ) (princ) ) ; Ф-ция DeleteGroupbyName ; Удаление группы по имени. ; Аргумент [Тип]: ; Name = Имя группы [sTR] ; Возвращает: Null (defun DeleteGroupbyName (Name) (or *kpblc-activedoc* (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object))) ) (vl-catch-all-apply '(lambda () (vla-delete (vla-item (vla-get-groups *kpblc-activedoc*) Name ) ) ) ) (princ) ) ; Ф-ция GetObjGroupNames ; Возвращает список имен групп объекта или nil. ; Arguments [Type]: ; Obj = Object [VLA-OBJECT] ; Obj = Object [ENAME] ; Возвращает [Type]: ; Список имен групп [list] ; (defun GetObjGroupNames (Obj / Cur_ID NmeLst) (or *kpblc-activedoc* (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object))) ) (if (= (type Obj) 'ENAME)(setq Obj (vlax-ename->vla-object Obj))) (setq Cur_ID (vla-get-ObjectID Obj)) (vlax-for Grp (vla-get-Groups *kpblc-activedoc*) (vlax-for Ent Grp (if (equal (vla-get-ObjectID Ent) Cur_ID) (setq NmeLst (cons (vla-get-Name Grp) NmeLst)) ) (vlax-release-object Ent) ) (vlax-release-object Grp) ) (reverse NmeLst) ) ;;;Удаляет все пустые группы (именованные и неименованные) ;;;Объеткты, входящие в группы удаленны, а описание групп осталось ;;;http://dwg.ru/forum/viewtopic.php?t=4762 (defun PurgeAllEmptyGroups ()(PurgeEmptyGroups t)) ;;;Удаляет все пустые группы (именованные) (defun PurgeAllNamedEmptyGroups ()(PurgeEmptyGroups 0)) ;;;Удаляет все пустые группы (неименованные) (defun PurgeAllUnNamedEmptyGroups ()(PurgeEmptyGroups 1)) ;;;======================================================= ;;; Команды ;;;======================================================= ;;; Удаляет все группы Purge All Groups (defun C:PAG ()(PurgeAllGroups)) ;;; Удаляет все пустые группы Purge Empty Groups (defun C:PEG ()(PurgeAllEmptyGroups)) ;;; Удаляет все неименованные группы Purge Unnamed Groups (defun C:PUG ()(PurgeAllUnNamedGroups)) Quote Link to comment Share on other sites More sharing options...
Sweety Posted December 29, 2010 Author Share Posted December 29, 2010 upsss:oops: link is here: http://www.jtbworld.com/lisp/purger.htmkruuger Thanks a lot. But I am not looking forward to use purge command which although already existed in Autocad . I need to explode group on entities that collected with eachothers by group command . Thanks Quote Link to comment Share on other sites More sharing options...
pBe Posted December 29, 2010 Share Posted December 29, 2010 All "GROUPS" within the drawing or a particular GROUP? by name or via selection? Quote Link to comment Share on other sites More sharing options...
Guest kruuger Posted December 29, 2010 Share Posted December 29, 2010 Thanks a lot. But I am not looking forward to use purge command which although already existed in Autocad . I need to explode group on entities that collected with eachothers by group command . Thanks did you try my or VVA code? Purge here means explode all group (you can't purge group with autocad PURGE command). kruuger Quote Link to comment Share on other sites More sharing options...
Sweety Posted December 29, 2010 Author Share Posted December 29, 2010 Try itPAG - Purge All Groups PEG - Purge Empty Groups PUG - Purge Unnamed Groups (like *Annn) ; Ф-ция PurgeAllGroups ; Удаляет описание всех групп ; Аргумент [Тип]: ; НЕТ ; Возвращает: Nil (vl-load-com) (defun PurgeAllGroups (/ grpList index grp) (setq grpList (dictsearch (namedobjdict) "ACAD_GROUP")) (setq index 1) (while (setq grp (nth index grplist)) (if (= (car grp) 3) (entdel (cdr (nth (+ index 1) grplist))) ) (setq index (+ 1 index)) ) (princ)) ; Ф-ция PurgeEmptyGroups ; Удаляет описание всех пустых групп ; Аргумент [Тип]: ; Named = Тип [iNT] ; 0 — только именованные группы ; 1 — только неименованные группы ; t,nil — все группы ; Возвращает: Nil (defun PurgeEmptyGroups ( named / grpList index grp egrp named_list e_list) ;;; Библиотечная ф-ция, возвращает multiple group code (defun massoc (key alist / x nlist) (foreach x alist (if (eq key (car x)) (setq nlist (cons (cdr x) nlist)) )) (reverse nlist)) (setq named_list '(0 1)) (if (member named named_list)(setq named_list (list named))) (setq grpList (dictsearch (namedobjdict) "ACAD_GROUP")) (setq index 1) (while (setq grp (nth index grplist)) (if (= (car grp) 3) (progn (setq egrp (entget (cdr (nth (+ index 1) grplist)))) (if (member (cdr (assoc 70 egrp)) named_list) (progn (setq e_list (massoc 340 egrp)) (if(not (vl-member-if 'entget e_list)) (entdel (cdr (nth (+ index 1) grplist))) ) ) ) ) ) (setq index (+ 1 index)) ) (princ)) ; Ф-ция PurgeAllUnNamedGroups ; Удаляет описание всех анонимных групп *Annn ; Аргумент [Тип]: ; НЕТ ; Возвращает: Nil (defun PurgeAllUnNamedGroups (/ grpList index grp) (setq grpList (dictsearch (namedobjdict) "ACAD_GROUP")) (setq index 1) (while (setq grp (nth index grplist)) (if (= (car grp) 3) (progn (if (= (chr 42) (substr (cdr grp) 1 1)) (entdel (cdr (nth (+ index 1) grplist))) ) ) ) (setq index (+ 1 index)) ) (princ) ) ; Ф-ция DeleteGroupbyName ; Удаление группы по имени. ; Аргумент [Тип]: ; Name = Имя группы [sTR] ; Возвращает: Null (defun DeleteGroupbyName (Name) (or *kpblc-activedoc* (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object))) ) (vl-catch-all-apply '(lambda () (vla-delete (vla-item (vla-get-groups *kpblc-activedoc*) Name ) ) ) ) (princ) ) ; Ф-ция GetObjGroupNames ; Возвращает список имен групп объекта или nil. ; Arguments [Type]: ; Obj = Object [VLA-OBJECT] ; Obj = Object [ENAME] ; Возвращает [Type]: ; Список имен групп [list] ; (defun GetObjGroupNames (Obj / Cur_ID NmeLst) (or *kpblc-activedoc* (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object))) ) (if (= (type Obj) 'ENAME)(setq Obj (vlax-ename->vla-object Obj))) (setq Cur_ID (vla-get-ObjectID Obj)) (vlax-for Grp (vla-get-Groups *kpblc-activedoc*) (vlax-for Ent Grp (if (equal (vla-get-ObjectID Ent) Cur_ID) (setq NmeLst (cons (vla-get-Name Grp) NmeLst)) ) (vlax-release-object Ent) ) (vlax-release-object Grp) ) (reverse NmeLst) ) ;;;Удаляет все пустые группы (именованные и неименованные) ;;;Объеткты, входящие в группы удаленны, а описание групп осталось ;;;http://dwg.ru/forum/viewtopic.php?t=4762 (defun PurgeAllEmptyGroups ()(PurgeEmptyGroups t)) ;;;Удаляет все пустые группы (именованные) (defun PurgeAllNamedEmptyGroups ()(PurgeEmptyGroups 0)) ;;;Удаляет все пустые группы (неименованные) (defun PurgeAllUnNamedEmptyGroups ()(PurgeEmptyGroups 1)) ;;;======================================================= ;;; Команды ;;;======================================================= ;;; Удаляет все группы Purge All Groups (defun C:PAG ()(PurgeAllGroups)) ;;; Удаляет все пустые группы Purge Empty Groups (defun C:PEG ()(PurgeAllEmptyGroups)) ;;; Удаляет все неименованные группы Purge Unnamed Groups (defun C:PUG ()(PurgeAllUnNamedGroups)) Thank you so much Mr VVA. that's really great . But how to make it by the user selection one by one ? Appreciated Quote Link to comment Share on other sites More sharing options...
Sweety Posted December 29, 2010 Author Share Posted December 29, 2010 All "GROUPS" within the drawing or a particular GROUP? by name or via selection? Yes, it would be very great if I could select one group by one . Thanks Quote Link to comment Share on other sites More sharing options...
Guest kruuger Posted December 29, 2010 Share Posted December 29, 2010 try this: http://kojacek.republika.pl/mag.html (mag.fas) MAB - create group UGR - ungroup by selection Wskaż obiekt do rozbicia grupy: -> Select object to explode group: Wszystkie -> All kruuger Quote Link to comment Share on other sites More sharing options...
Sweety Posted December 29, 2010 Author Share Posted December 29, 2010 try this: http://kojacek.republika.pl/mag.html (mag.fas)MAB - create group UGR - ungroup by selection Wskaż obiekt do rozbicia grupy: -> Select object to explode group: Wszystkie -> All kruuger Yeah .... That's great . But all codes and functions are hidden by .fas file . Hope that someone would rise these codes for us . Greatly appreciated. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted December 29, 2010 Share Posted December 29, 2010 http://www.cadtutor.net/forum/showthread.php?54230-Group-command-routine Quote Link to comment Share on other sites More sharing options...
pBe Posted December 29, 2010 Share Posted December 29, 2010 Well. what can i say... 30 seconds-in on writing a code..... I heard a voice say..... "dont try to re-invent the wheel" Quote Link to comment Share on other sites More sharing options...
Guest kruuger Posted December 29, 2010 Share Posted December 29, 2010 Yeah .... That's great . But all codes and functions are hidden by .fas file . Hope that someone would rise these codes for us . Greatly appreciated. this is not my program so i can't show you the code. but now with VVA and Lee Mac code we can do something similar to MAG.FAS kruuger Quote Link to comment Share on other sites More sharing options...
Sweety Posted December 29, 2010 Author Share Posted December 29, 2010 http://www.cadtutor.net/forum/showthread.php?54230-Group-command-routine Yeah ... that's wonderful as usual Mr Lee. Thank you so much. Quote Link to comment Share on other sites More sharing options...
pBe Posted December 29, 2010 Share Posted December 29, 2010 (edited) try this little bitty code and tell me what you think (defun c:test (/ this-dwg lko action) (vl-load-com) (setq this-dwg (vla-get-activedocument (vlax-get-acad-object))) (vla-zoomextents (vlax-get-acad-object)) (vlax-for ol (vla-get-groups this-dwg) (if (/= (vla-get-count ol) 0) (progn (setq lko (ssadd)) (vlax-for lk ol (setq lko (ssadd (vlax-vla-object->ename lk) lko)) ) (sssetfirst nil lko) (princ (strcat "\nGroup name " (setq gn (vla-get-name ol)))) (initget 1 "D C") (setq action (getkword "\nSpecify action [[color=blue]Delete/[/color]Continue]: ")) (cond [color=blue]((= action "D")[/color] [color=blue](vla-delete ol )[/color] [color=blue] (princ (strcat "\nGroup Name " gn " Deleted"))[/color] (setq lko (ssadd)) ) ((= action "C") (princ (strcat "\nGroup Name " gn " not deleted")) ) ) ) ) ) (princ) ) i started it a while ago. might as well post it here Edited December 31, 2010 by pBe Update to remove VL-cmdf Quote Link to comment Share on other sites More sharing options...
Sweety Posted December 29, 2010 Author Share Posted December 29, 2010 try this little bitty code and tell me what you think (defun c:test (/ this-dwg lko action) (vl-load-com) (setq this-dwg (vla-get-activedocument (vlax-get-acad-object))) (vla-zoomextents (vlax-get-acad-object)) (vlax-for ol (vla-get-groups this-dwg) (if (/= (vla-get-count ol) 0) (progn (setq lko (ssadd)) (vlax-for lk ol (setq lko (ssadd (vlax-vla-object->ename lk) lko)) ) (sssetfirst nil lko) (princ (strcat "\nGroup name " (setq gn (vla-get-name ol)))) (initget 1 "X C") (setq action (getkword "\nSpecify action [eXplode/Continue]: ")) (cond ((= action "X") (vl-cmdf "_.Group" "Explode" gn) (vl-cmdf "regen") (setq lko (ssadd)) ) ((= action "C") (princ (strcat "\nGroup Name " gn " not explode")) ))))) (princ) ) i started it a while ago. might as well post it here It does not, because the following code that you used . (vl-cmdf "_.Group" "Explode" gn) If command Explode works with group , I would not ask for a routine to do that instead . many thanks Quote Link to comment Share on other sites More sharing options...
pBe Posted December 29, 2010 Share Posted December 29, 2010 hahaha guess you're right oh well. i needed the practice anyway besides ... its explode option inside Group command no worries Sweety Quote Link to comment Share on other sites More sharing options...
Sweety Posted December 29, 2010 Author Share Posted December 29, 2010 hahaha guess you're right oh well. i needed the practice anyway besides ... its explode option inside Group command no worries Sweety Thank you man . I enjoyed sharing opinions with you and the others as well . thanks a lot. Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.