Lisp or codes to explode group of entities (gathered by GROUP command)

[Sweety]

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

[Guest kruuger]

here is nice collection of "PURGE" routines (PurgeAllGroups)

 

kruuger

[Sweety]

here is nice collection of "PURGE" routines (PurgeAllGroups)

 

kruuger

 

Where is that collection dear krugger ?

 

Thanxxxxxxx

[Guest kruuger]

Where is that collection dear krugger ?

 

Thanxxxxxxx

upsss:oops: link is here: http://www.jtbworld.com/lisp/purger.htm

kruuger

[VVA]

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))

[Sweety]

upsss:oops: link is here: http://www.jtbworld.com/lisp/purger.htm

kruuger

 

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

[pBe]

All "GROUPS" within the drawing or a particular GROUP? by name or via selection?

[Guest kruuger]

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

[Sweety]

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))

 

Thank you so much Mr VVA.

 

that's really great .

 

But how to make it by the user selection one by one ?

 

Appreciated

[Sweety]

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

[Guest kruuger]

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

[Sweety]

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.

[Lee Mac]

http://www.cadtutor.net/forum/showthread.php?54230-Group-command-routine

[pBe]

Well. what can i say... 30 seconds-in on writing a code.....

I heard a voice say.....

 

"dont try to re-invent the wheel"

 

[Guest 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.

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

[Sweety]

http://www.cadtutor.net/forum/showthread.php?54230-Group-command-routine

 

Yeah ... that's wonderful as usual Mr Lee.

 

Thank you so much.

[pBe]

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

[Sweety]

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

[pBe]

hahaha guess you're right

 

oh well. i needed the practice anyway

besides ... its explode option inside Group command

 

no worries Sweety

[Sweety]

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.