Jump to content

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


Sweety

Recommended Posts

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

Link to comment
Share on other sites

  • 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

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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
Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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