Jump to content

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


Recommended Posts

Posted

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

  • Replies 23
  • Created
  • Last Reply

Top Posters In This Topic

  • Sweety

    10

  • pBe

    6

  • VVA

    1

  • Lee Mac

    1

Popular Days

Top Posters In This Topic

Guest kruuger
Posted

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

 

kruuger

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

 

kruuger

 

Where is that collection dear krugger ?

 

Thanxxxxxxx

Posted

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

Posted
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

Posted

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

Guest kruuger
Posted
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

Posted
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

Posted
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

Posted
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.

Posted

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

I heard a voice say.....

 

"dont try to re-invent the wheel"

 

:D

Guest kruuger
Posted
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

Posted (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 by pBe
Update to remove VL-cmdf
Posted
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

Posted

:shock: hahaha guess you're right

 

oh well. i needed the practice anyway

besides ... its explode option inside Group command

 

no worries Sweety :)

Posted
:shock: 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.

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...