;; ------------------------ PurgeNullGroups.LSP -------------------------------
;; Purpose: Purge a drawing of all groups which contain no entities
;; Version: 1.0
;; Date: 17 October 2001
;; Author:  Herman Mayfarth
;; Copyright © 2001 by Herman Mayfarth. All rights reserved.
;; Provided "as is" and without warranty, express or implied.
;; Use at your own risk.
;; Usage:  AutoCAD R14 ->?
;;---------------------------------------------------------------------
;;;global functions
;;;purgenullgroups
;;;purge entries in the ACAD_GROUP dictionary which have no entities associated
;;;external functions: dictent mcdrpos
;;;© 2001 Herman Mayfarth
;;;no warranty, express or implied.
;;;use at your own risk.
(defun purgenullgroups ( / gdict gent)
  (setq gent (dictent "ACAD_GROUP") ;get the group dictionary's ename
        gdict (entget gent))        ;and its contents
  (mapcar '(lambda (alist)
            (if (null (assoc 340 (entget (cdr (nth (cadr alist) gdict)))))
                (dictremove gent (car alist))
            );if
           );lambda
           (mcdrpos 3 gdict)
  )
);purgenullgroups
;;;mcdrpos
;;;returns a list of two element lists - the first element of each list is a
;;;cdr in the input list, and the second element is its position in the input
(defun mcdrpos (key alist / i out pos)
  (setq i 0)
  (foreach n alist
    (progn
      (setq i (1+ i))
      (if (eq (car n) key)
      (setq out (cons (list (cdr n) i) out))
      )
    );progn
  )
  (reverse out)
);mcdrpos
;;;mcdrsread
;;;***use with caution***
;;;provided any of input cdrs are strings (which it checks) the return value
;;;is an association list - the car of each dotted pair is a cdr of
;;;the input, *converted to a (global) symbol* by (read)ing a string value,
;;;and each cdr is the position of its own car in the input list
(defun mcdrsread (key alist / i out pos)
  (setq i 0)
  (foreach n alist
    (progn
      (setq i (1+ i))
      (if (and (eq (car n) key) (= (type (cdr n)) 'STR))
      (setq out (cons (list (read (cdr n)) i) out))
      )
    );progn
  )
  out
);mcdrsread
;;;get Entity Association List for master dictionary record
(defun getNOD () (entget(namedobjdict)))
;;;dictent
;;;get entity name for a dictionary named dstring
(defun dictent (dstring / nodlst OK)
  (setq nodlst (getnod))
  (if (setq OK (assoc (read dstring) (mcdrsread 3 nodlst)))
    (cdr (nth (cadr OK) nodlst))
    nil
  )
)
;;;Command to purge the drawing of all groups which contain no entities
;;;Required external functions:
;;; getNOD dictent mcdrpos mcdrsread purgenullgroups
(defun C:PURGENULLGROUPS ( / i)
  (setq i 0)
  (foreach n
    (purgenullgroups)
    (if n (setq i (1+ i)))
  );foreach
  (princ (strcat "\nPurged " (itoa i) " groups. "))
  (princ)
);C:PURGENULLGROUPS
;;load prompts
(princ "\n PURGENULLGROUPS v1.0 Copyright © 2001 Tekton Construction Services")
(princ "\nType PURGENULLGROUPS to run.")
(princ)