; Group and Ungroup -- Group (block and Ungroup (explode) entities

; Alias for Ungroup
(defun C:UNGROUP ()
  (princ "Remember to purge the block table.\n")
  (command "EXPLODE")
  (princ))

; Make a block name with suffix  
(defun MakeBlkName () 
  (strcat "$GROUP" (itoa _GroupSuffix))
  )
  
; Get an unused block name
(defun GetBlkName ()
  (if (null _GroupSuffix)    ;if suffix not yet defined,
    (setq _GroupSuffix 1))   ;star with suffix 1
  (while (not (null (tblsearch "BLOCK" (MakeBlkName))))   ;if block exists,
    (setq _GroupSuffix (1+ _GroupSuffix)))         ;increment suffix
    (MakeBlkName) ;return block name
)        

; Group main program
(defun C:BGROUP ()
  (setq Set1 (ssget))              ;select objects
  (if (not (null Set1))  (progn    ;if set is not empty....  
    (setq InsPoint                      ;use as the insertion point
      (cdr (assoc 10                    ;the first point of,
        (entget (ssname Set1 0)))))     ;the first entity selected
    (setq BlkName (GetBlkName))          ;stor block name
    (command "BLOCK" BlkName InsPoint Set1 "")      ;make block
    (command"INSERT" BlkName InsPoint "1" "1" "0")  ;insert block 
    (setq Set1 nil)  ;clear selection set to free memory
  ))
  (princ)  ;prevent echo
)

; Load Message
(princ "\nBgroup y Ungroup by Carl Guerin 11/11/92")
(princ "\nAgrupa objetos en bloques. Digite BGROUP o UNGROUP.")
(princ)