;;; Deletes all empty groups (named and anonymous)

View Full Version : Getting a list of groups used in autocad

---

nixon202

26th Mar 2007, 05:49 am

I want to check if a group exists in Autocad. Does anyone have any lisp code that will retrive either a list of groups used in the dwg or check to see whether a group exists? I think it might have something to do with xrecords or dictionarys.

---

fuccaro

26th Mar 2007, 06:17 am

Hello Nixon202 and welcome in the forum!

Try this:

;; by Michael Puckett
;; Returns a list of group names the ename is a child of,
;; innermost first in the list.
(defun gnames (ename / key dct rtn)
(setq key (cons 340 ename)
dct (dictsearch (namedobjdict) "acad_group")
)
(while (setq dct (member (assoc 3 dct) dct))
(if (member key (entget (cdadr dct)))
(setq rtn (cons (cdar dct) rtn))
)
(setq dct (cddr dct))
)
(reverse rtn)
) ;end

---

ASMI

26th Mar 2007, 07:20 am

Existing groups list:

(defun GroupList()
(mapcar 'cdr(vl-remove-if '(lambda(x)(/= 3(car x)))
(dictsearch(namedobjdict)"ACAD_GROUP")))
); end of GroupList

---

ASMI

26th Mar 2007, 08:17 am

Or with VisualLISP:

(defun GroupList(/ outLst)
(vl-load-com)
(vlax-for x(vla-get-Groups(vla-get-ActiveDocument(vlax-get-acad-object)))
(setq outLst(cons(vla-get-Name x)outLst)))
); end of GroupList

---

VVA

26th Mar 2007, 02:54 pm

Some functions on work with groups

; PurgeAllGroups
; Deletes the description of all groups
; Arguments [Type]:
; None
; Return: Nil
(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
; Deletes the description of all empty groups
; Arguments [Type]:
; Named = Type [INT]
; 0 — Only the named groups
; 1 — Only anonymous groups
; t,nil — all groups
; Return: Nil
(defun PurgeEmptyGroups ( named / grpList index grp egrp named_list e_list)
(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
; Deletes the description of all anonymous groups *Annn
; Arguments [Type]: NoNE
; Return: 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
; Removal of group by name
; Arguments [Type]:
; Name = Group name [STR]
; Return: Null
(defun DeleteGroupbyName (Name)
(or *activedoc*
(setq *activedoc* (vla-get-activedocument (vlax-get-acad-object)))
)
(vl-catch-all-apply
'(lambda ()
(vla-delete
(vla-item
(vla-get-groups *activedoc*)
Name
)
)
)
)
(princ)
)
; GetObjGroupNames
; Return the list of names of groups of object or nil.
; Arguments [Type]:
; Obj = Object [VLA-OBJECT or ENAME]
; Return [Type]:
; The list of names of groups
[list]
(defun GetObjGroupNames (Obj / Cur_ID NmeLst)
(or *activedoc*
(setq *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 *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)
)
;;; Deletes all empty groups (named and anonymous)
;;; Objects, entering into groups remove, and the description of groups remains
(defun PurgeAllEmptyGroups ()(PurgeEmptyGroups t))
;;; Deletes all empty groups (named)
(defun PurgeAllNamedEmptyGroups ()(PurgeEmptyGroups 0))
;;; Deletes all empty groups (anonymous)
(defun PurgeAllUnNamedEmptyGroups ()(PurgeEmptyGroups 1))
;;;=============================================== ========
;;; Commands
;;;=============================================== ========
;;; Delete All Groups
(defun C:PAG ()(PurgeAllGroups))
;;; Purge Empty Groups
(defun C:PEG ()(PurgeAllEmptyGroups))
;;; Purge Unnamed (anonymous) Groups
(defun C:PUG ()(PurgeAllUnNamedGroups))