Как расформировать группы?

Спасибо за дельный совет. У меня 3 книги по Акаду
ни в одной из них этого нет.

Хелп это хорошая штука я полностью согласен, единственное но, справка в каде на англицком. =( Языка к сожалению я незнаю. А руский хелп к 2004-му  немогу найти.

;       
;Команды автоматической ГРУППИРОВКИ (<GR> или <ПК>) и РАЗГРУППИРОВКИ (<RG>или <КП>) - указанных объектов       
;плюс команды ДОБАВЛЕНИЯ (<GRR> или <ПКК>) или УДАЛЕНИЯ (<RGG> или <КПП>) указанных элементов в выбранной группы   
;При вызове команды выбираете объекты-группы.                                                                     
;Позволяет создавать вложенные группы.                                                                            
;Имя группы автоматически формируется из системной переменной текущего времени                       
;При наличии вложенной группы ВНЕШЯЯ группа получает аналогичное имя последней группы с добавлением в начале символа <$>
;При выборе графического элемента автоматически  определяется ИМЯ последней группы, в которую он входит           
;Разгруппировка со вложенными наборами осуществляется в обратном порядке                                          
;Выполнил Толстов Е.В. Казань, КГАСА,каф.САПР 2.11.2000г.                                            
;------------------------------------------------------------------------------------------------------
(setq -gr "O'k");Для определения загрузки команды в других программах (hotm)
;------------------------------------------------------------------------------------------------------
(DEFUN tol-gr (tip nabor / ln name nname naa aa f prSpis i ss ls x spname No tmpFILE)
(setvar "cmdecho" 0);Off echo command
(setq name nil nname nil spname '() No 0);Исходные параметры переменных
(if(= nabor nil)(SETQ nabor (SSGET)))
(if(= nabor nil)(princ "<Отмена>");if1-проверка отказа выбора объектов
   (progn;pr1
(SETQ ln(sslength nabor))           ;ВЫБОР ОБЬЕКТОВ и определение кол-ва выбр.элементов
(WHILE(< No ln);создание списка групп, вложенных и в наборе
    (SETQ aa(SSNAME nabor No)    ;имя элемента в наборе
      prSpis(ENTGET aa)      ;список свойств элемента
      name(cdr(car prSpis))    ;имя-код элемента в списке
          ss(cdr(member '(102 . "{ACAD_REACTORS")prSpis));отрезаем список Элемента до начала перечисления групп
      ss(reverse ss)        ;переворачиваем
      SS(CDR(MEMBER '(102 . "}")ss));отрезаем список после перечисления групп((330 . <код группы>)(330 . <>)...)
      ls(length ss))        ;кол-во имен-кодов групп
    (foreach i ss    ;проходим по списку кодов <ss> и записываем наст.имена групп в список <spname>
      (setq naa(cdr i)            ;naa - код группы
        prSpis(ENTGET naa)        ;список группы
            aa(cdr(assoc 330 prspis))    ;код-адрес таблицы имен групп
        prSpis(ENTGET aa)        ;список элемента таблицы групп
            aa(reverse prspis);переворачиваем список, чтобы код группы оказалсе перед именем (3 . "имя")<->(350 . <naa>)
        nname(cdr(cadr(member(cons 350 naa)aa))));считываем имя как следующее за кодом группы
      (if(= spname nil)(setq spname(cons nname '())));cоздает список с первым именем группы
      (if(=(member nname spname)nil)(setq spname(cons nname spname)));добавляет имя в список, если отсутствует.
    );for-конец списка кодов групп
    (setq No(1+ No));Переход к след.номеру элементу в наборе
);w - конец перебора набора
(setq nname(last spname));в качестве имени группы берем одно из последних в списке найденных (1 из созданных в наборе - текущая группа)
;если требуется создать группу - берем имя вложенной группы(если есть, т.е /= nil) и добавляем <$> пока не станет уникальным
(if(and(= tip nil)(/= nname nil)(=(substr nname 1 1)"*"))(setq nname(substr nname 2 128)))
(while(and(= tip nil)(/=(member nname spname)nil))(setq nname(strcat "$" nname)))
;если требуется создать группу - а имени вложенных групп нет - создаем из текущей переменной машинной даты-времени
(if(and(= tip nil)(= nname nil))(setq nname(rtos(getvar "cdate")2 20)nname(strcat(substr nname 1 8)"_"(substr nname 10 8))));;;;;;
(setq ls(length spname))
(cond;Группировка-разгруппировка объектов с определенным именем
      ((and(= tip nil)(< ln 2))(princ "\n<Отмена> Невозможно СГРУППИРОВАТЬ 1 элемент !"))
      ((and(= tip nil)(>= ln 2)(>= ls 1))(setq x(princ "Выполнено !\n Включено вложенных групп - ")х(princ ls)x(command "_-group" "_c" nname "Создан прогр.TOL-GR" nabor "")))
      ((and(= tip nil)(>= ln 2)(< ls 1))(setq x(princ "Выполнено !")x(command "_-group" "_c" nname "Прогр.<TOL-GR.lsp> Толстов Е.В. Казань 2000г." nabor "")))
      ((and(= tip 0)(/= nname nil)(= ls 1))(setq x(princ "Выполнено !")x(command "_-group" "_e" nname)))
      ((and(= tip 0)(/= nname nil)(> ls 1))(setq x(princ "Выполнено!\n Осталось вложенных групп - ")x(princ(1- ls))x(command "_-group" "_e" nname)))
      ((and(= tip 0)(= nname nil))(Princ "\n<Отмена> Объект не принадлежит ГРУППЕ !"))
      ((and(= tip 1)(/= nname nil)(>= ls 1))(setq x(princ "Укажите добавляемые к группе элементы!")x(command "_-group" "_a" nname )))
      ((and(= tip 1)(= nname nil))(Princ "\n<Отмена> ГРУППА не найдена !"))
      ((and(= tip -1)(/= nname nil)(>= ls 1))(setq x(princ "Укажите удаляемые из группы элементы!")x(command "_-group" "_r" nname )))
      ((and(= tip -1)(= nname nil))(Princ "\n<Отмена> ГРУППА не найдена !"))
)
    );Pr1 - группа операций при выбранных объектах
);if1 - проверка отказа выбора объектов
(princ)
);END tol-gr
;------------------------------------------------------------------------------------------------------------------
(defun c:пк()(princ "\nСГруппировать объекты ")(tol-gr nil nil));Вызов команды при русской раскладке клавиатуры
(defun c:gr()(princ "\nСГруппировать объекты ")(tol-gr nil nil))
(defun c:кп()(princ "\nРАЗГруппировать объекты ")(tol-gr 0 nil));Вызов команды при русской раскладке клавиатуры
(defun c:rg()(princ "\nРАЗГруппировать объекты ")(tol-gr 0 nil))
(defun c:пкк()(princ "\nУкажите ЦЕЛЕВУЮ ГРУППУ для ПРИСОЕДИНЕНИЯ элементов:")(tol-gr 1 nil));Вызов команды при русской раскладке клавиатуры
(defun c:grr()(princ "\nУкажите ЦЕЛЕВУЮ ГРУППУ для ПРИСОЕДИНЕНИЯ элементов:")(tol-gr 1 nil))
(defun c:ккп()(princ "\nУкажите ИСХОДНУЮ ГРУППУ для УДАЛЕНИЯ элементов:")(tol-gr -1 nil));Вызов команды при русской раскладке клавиатуры
(defun c:rgg()(princ "\nУкажите ИСХОДНУЮ ГРУППУ для УДАЛЕНИЯ элементов:")(tol-gr -1 nil))
;(princ "\nКоманды гуппировки <gr>, разгруппировки <rg>, удаления <rgg> и присоединения <grr> элементов в группе - загружены.\nТолстов.Е.В. Казань 2000г.")

> Teodor_2000
Еще один вариант подобной функции можно посмотреть здесь или здесь

Посмотри здесь LISP. Группировка и разгруппировка объектов

Посмотри команды из последнего поста

Посмотрел код из #7. Там пропущено пару скобок. Этот код у меня работает:

;;; 
;;;Команды автоматической ГРУППИРОВКИ (<GR> или <ПК>) и РАЗГРУППИРОВКИ (<RG>или <КП>) - указанных объектов 
;;;плюс команды ДОБАВЛЕНИЯ (<GRR> или <ПКК>) или УДАЛЕНИЯ (<RGG> или <КПП>) указанных элементов в выбранной группы 
;;;При вызове команды выбираете объекты-группы. 
;;;Позволяет создавать вложенные группы. 
;;;Имя группы автоматически формируется из системной переменной текущего времени 
;;;При наличии вложенной группы ВНЕШЯЯ группа получает аналогичное имя последней группы с добавлением в начале символа <$> 
;;;При выборе графического элемента автоматически определяется ИМЯ последней группы, в которую он входит 
;;;Разгруппировка со вложенными наборами осуществляется в обратном порядке 
;;;Выполнил Толстов Е.В. Казань, КГАСА,каф.САПР 2.11.2000г. 
------------------------------------------------------------------------------------------------------ 
(setq -gr "O'k");_Для определения загрузки команды в других программах (hotm) 
;_------------------------------------------------------------------------------------------------------ 
(DEFUN tol-gr (tip nabor / ln name nname naa aa f prSpis i ss ls x spname No tmpFILE) 
(setvar "cmdecho" 0);_Off echo command 
(setq name nil nname nil spname '() No 0);_Исходные параметры переменных 
(if(= nabor nil)(SETQ nabor (SSGET))) 
(if(= nabor nil)(princ "<Отмена>");_if1-проверка отказа выбора объектов 
(progn;_pr1 
(SETQ ln(sslength nabor)) ;_ВЫБОР ОБЬЕКТОВ и определение кол-ва выбр.элементов 
(WHILE(< No ln);_создание списка групп, вложенных и в наборе 
(SETQ aa(SSNAME nabor No) ;_имя элемента в наборе 
prSpis(ENTGET aa) ;_список свойств элемента 
name(cdr(car prSpis)) ;_имя-код элемента в списке 
ss(cdr(member '(102 . "{ACAD_REACTORS")prSpis));_отрезаем список Элемента до начала перечисления групп 
ss(reverse ss) ;_переворачиваем 
SS(CDR(MEMBER '(102 . "}")ss));_отрезаем список после перечисления групп((330 . <код группы>)(330 . <>)...) 
ls(length ss)) ;_кол-во имен-кодов групп 
(foreach i ss ;_проходим по списку кодов <ss> и записываем наст.имена групп в список <spname> 
(setq naa(cdr i) ;_naa - код группы 
prSpis(ENTGET naa) ;_список группы 
aa(cdr(assoc 330 prspis)) ;_код-адрес таблицы имен групп 
prSpis(ENTGET aa) ;_список элемента таблицы групп 
aa(reverse prspis);_переворачиваем список, чтобы код группы оказалсе перед именем (3 . "имя")<->(350 . <naa>) 
nname(cdr(cadr(member(cons 350 naa)aa))));_считываем имя как следующее за кодом группы 
(if(= spname nil)(setq spname(cons nname '())));_cоздает список с первым именем группы 
(if(=(member nname spname)nil)(setq spname(cons nname spname)));_добавляет имя в список, если отсутствует. 
);_for-конец списка кодов групп 
(setq No(1+ No));_Переход к след.номеру элементу в наборе 
);_w - конец перебора набора 
(setq nname(last spname));_в качестве имени группы берем одно из последних в списке найденных (1 из созданных в наборе - текущая группа) 
;_если требуется создать группу - берем имя вложенной группы(если есть, т.е /= nil) и добавляем <$> пока не станет уникальным 
(if(and(= tip nil)(/= nname nil)(=(substr nname 1 1)"*"))(setq nname(substr nname 2 128))) 
(while(and(= tip nil)(/=(member nname spname)nil))(setq nname(strcat "$" nname))) 
;_если требуется создать группу - а имени вложенных групп нет - создаем из текущей переменной машинной даты-времени 
(if(and(= tip nil)(= nname nil))(setq nname(rtos(getvar "cdate")2 20)nname(strcat(substr nname 1 8) "_"(substr nname 10 ))));_;_;_;_;_;_ 
(setq ls(length spname)) 
(cond;_Группировка-разгруппировка объектов с определенным именем 
((and(= tip nil)(< ln 2))(princ "\n<Отмена> Невозможно СГРУППИРОВАТЬ 1 элемент !")) 
((and(= tip nil)(>= ln 2)(>= ls 1))(setq x(princ "Выполнено !\n Включено вложенных групп - ")х(princ ls)x(command "_-group" "_c" nname "Создан прогр.TOL-GR" nabor ""))) 
((and(= tip nil)(>= ln 2)(< ls 1))(setq x(princ "Выполнено !")x(command "_-group" "_c" nname "Прогр.<TOL-GR.lsp> Толстов Е.В. Казань 2000г." nabor ""))) 
((and(= tip 0)(/= nname nil)(= ls 1))(setq x(princ "Выполнено !")x(command "_-group" "_e" nname))) 
((and(= tip 0)(/= nname nil)(> ls 1))(setq x(princ "Выполнено!\n Осталось вложенных групп - ")x(princ(1- ls))x(command "_-group" "_e" nname))) 
((and(= tip 0)(= nname nil))(Princ "\n<Отмена> Объект не принадлежит ГРУППЕ !")) 
((and(= tip 1)(/= nname nil)(>= ls 1))(setq x(princ "Укажите добавляемые к группе элементы!")x(command "_-group" "_a" nname ))) 
((and(= tip 1)(= nname nil))(Princ "\n<Отмена> ГРУППА не найдена !")) 
((and(= tip -1)(/= nname nil)(>= ls 1))(setq x(princ "Укажите удаляемые из группы элементы!")x(command "_-group" "_r" nname ))) 
((and(= tip -1)(= nname nil))(Princ "\n<Отмена> ГРУППА не найдена !")) 
) 
);_Pr1 - группа операций при выбранных объектах 
);_if1 - проверка отказа выбора объектов 
(princ) 
);_END tol-gr 
;_------------------------------------------------------------------------------------------------------------------ 
(defun c:пк()(princ "\nСГруппировать объекты ")(tol-gr nil nil));_Вызов команды при русской раскладке клавиатуры 
(defun c:gr()(princ "\nСГруппировать объекты ")(tol-gr nil nil)) 
(defun c:кп()(princ "\nРАЗГруппировать объекты ")(tol-gr 0 nil));_Вызов команды при русской раскладке клавиатуры 
(defun c:rg()(princ "\nРАЗГруппировать объекты ")(tol-gr 0 nil)) 
(defun c:пкк()(princ "\nУкажите ЦЕЛЕВУЮ ГРУППУ для ПРИСОЕДИНЕНИЯ элементов:")(tol-gr 1 nil));_Вызов команды при русской раскладке клавиатуры 
(defun c:grr()(princ "\nУкажите ЦЕЛЕВУЮ ГРУППУ для ПРИСОЕДИНЕНИЯ элементов:")(tol-gr 1 nil)) 
(defun c:ккп()(princ "\nУкажите ИСХОДНУЮ ГРУППУ для УДАЛЕНИЯ элементов:")(tol-gr -1 nil));_Вызов команды при русской раскладке клавиатуры 
(defun c:rgg()(princ "\nУкажите ИСХОДНУЮ ГРУППУ для УДАЛЕНИЯ элементов:")(tol-gr -1 nil)) 
(princ "\nКоманды гуппировки <gr>, разгруппировки <rg>, удаления <rgg> и присоединения <grr> элементов в группе - загружены.\nТолстов.Е.В. Казань 2000г.")

Вот что у меня пишет ACAD :

Команда:
Команда: gr
СГруппировать объекты
Выберите объекты: найдено: 1
Выберите объекты: найдено: 1, всего: 2
Выберите объекты: найдено: 1, всего: 3
Выберите объекты: найдено: 1, всего: 4
Выберите объекты:
; ошибка: слишком много аргументов
Команда:

ACAD 2007 rus SP2

работает

Спасибо за труды, код работает.
Очень удобно четыре команды в одном ;)