| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > функции выбора. Вспомогательная информация

функции выбора. Вспомогательная информация

Ответ
Поиск в этой теме
Непрочитано 30.05.2010, 16:24 #1
функции выбора. Вспомогательная информация
sdv79
 
Инженер ЭОМ
 
Москва
Регистрация: 05.03.2009
Сообщений: 215

Если использовать
Код:
[Выделить все]
 (entsel"Выберите коммутационный аппарат")
В AutoCADе при активном Динамическом вводе высветится "Выберите коммутационный аппарат" Как такое же реализовать
Код:
[Выделить все]
(ssget '((0 . "INSERT")))
Просмотров: 9724
 
Непрочитано 30.05.2010, 16:36
#2
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Средствами lisp'а такое не сделать. Единственный вариант - попробовать через prompt показать свое сообщение и запросить выбор, "погасив" вывод в ком.строку (cmdecho = 0, menuecho = 0). Кажется, так.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 30.05.2010, 17:06
#3
sdv79

Инженер ЭОМ
 
Регистрация: 05.03.2009
Москва
Сообщений: 215
Отправить сообщение для sdv79 с помощью Skype™


Попробовал
Код:
[Выделить все]
(setvar "cmdecho" 0)
(setvar "menuecho" 0)
(prompt "Хочу выбрать блок")
(ssget '((0 . "INSERT")))
не помогает
sdv79 вне форума  
 
Непрочитано 30.05.2010, 17:14
#4
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Код:
[Выделить все]
(defun test (/ lst ss)

  (prompt "\nВыбери хоть что-нибудь ")
  (setq lst (mapcar
              (function
                (lambda (x / res)
                  (setq res (cons (car x) (getvar (car x))))
                  (setvar (car x) (cdr x))
                  res
                  ) ;_ end of lambda
                ) ;_ end of function
              '(
                ("menuecho" . 0)
                ("cmdecho" . 0)
          ;("nomutt" . 1)
                )
              ) ;_ end of mapcar
        ) ;_ end of setq
  (setq ss (ssget))
  (foreach item lst
    (setvar (car item) (cdr item))
    ) ;_ end of foreach
  (sssetfirst ss ss)
  ) ;_ end of defun
Лог ком.строки:
Код:
[Выделить все]
Команда: (test)

Выбери хоть что-нибудь
Выберите объекты: Противоположный угол: найдено: 2

Выберите объекты:
(<Selection set: 9> <Selection set: 9>)
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 30.05.2010, 17:22
#5
sdv79

Инженер ЭОМ
 
Регистрация: 05.03.2009
Москва
Сообщений: 215
Отправить сообщение для sdv79 с помощью Skype™


Спасибо. Наверное я плохо изложил свою мысль. Я хотел чтобы при включенном динамическом вводе высвечивалась эта надпись "Выберите коммутационное оборудование"
Код:
[Выделить все]
(princ "\n   Выберите коммутационное оборудование:") (prin1)
(setq viborka_avtomatov (ssget '((0 . "INSERT"))) )
Служебная информация вида "Выберите коммутационное оборудование" в динамическом вводе не отображается а вот при
Код:
[Выделить все]
(entsel"Выберите коммутационный аппарат")
работает на УРА
sdv79 вне форума  
 
Непрочитано 30.05.2010, 17:52
#6
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


lisp'ом такое не сделать (хотя через ObjectARX вроде бы есть возможность изменить приглашение).
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 30.05.2010, 17:53
#7
sdv79

Инженер ЭОМ
 
Регистрация: 05.03.2009
Москва
Сообщений: 215
Отправить сообщение для sdv79 с помощью Skype™


Грустно...
sdv79 вне форума  
 
Непрочитано 31.05.2010, 11:57
#8
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,702
Отправить сообщение для Do$ с помощью Skype™


Думаю, что подобное можно сделать и лиспом.
При помощи комбинаций функций entsel, getcorner, ssget.
Do$ вне форума  
 
Непрочитано 31.05.2010, 12:36
#9
Александр Ривилис

программист, рыцарь ObjectARX
 
Регистрация: 09.05.2005
Киев
Сообщений: 2,405
Отправить сообщение для Александр Ривилис с помощью Skype™


Цитата:
Сообщение от Do$ Посмотреть сообщение
Думаю, что подобное можно сделать и лиспом.
При помощи комбинаций функций entsel, getcorner, ssget.
Теоретически - да, практически - для полной эмуляции кода будет немеряно.
Средствами ObjectARX это сделать очень просто.
Александр Ривилис вне форума  
 
Непрочитано 31.05.2010, 13:39
#10
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


Может так?
Код:
[Выделить все]
(defun test (/ a b viborka_avtomatov)
  (setq
    b (getcorner
        (setq
          a (getpoint
              "\rВыберите коммутационное оборудование:\r"
            ) ;_ end of getpoint
        ) ;_ end of setq
      ) ;_ end of getcorner
  ) ;_ end of setq
  (setq viborka_avtomatov
         (ssget "_C" a b '((0 . "INSERT")))
  ) ;_ end of setq
  (sssetfirst nil viborka_avtomatov)
  (princ)
) ;_ end of defun
CB вне форума  
 
Непрочитано 31.05.2010, 15:39
#11
ShaggyDoc

Thượng Tá Quân Đội Nhân Dân Việt Nam
 
Регистрация: 14.03.2005
44d32'44"С, 33d26'51"В
Сообщений: 13,381


Цитата:
Может так?
Только не так!

Нельзя подменять выбор объектов (одного или нескольких) указаниями точек ради "красивого" приглашения. Вреда от этого будет больше.

Программист обязан предоставить пользователю возможность использовать все штатные средства выбора, имеющиеся в AutoCAD.

Если необходим выбор множества объектов, то специфичное приглашение достаточно вывести один раз, как показано в #4. И пусть потом повторяется штатное "Выберите объекты" - это нормальный режим работы.

Как вариант, возможен цикл с entsel, т.е. с выбором объектов по одному. Иногда это даже бывает предпочтительней, так как можно сразу отбрасывать объекты недопустимых типов.

Конечно, хотелось бы иметь дополнительный аргумент приглашения в ssget... Но имеем то, что имеем...
ShaggyDoc вне форума  
 
Непрочитано 31.05.2010, 17:01
#12
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,702
Отправить сообщение для Do$ с помощью Skype™


Моя идея вот в чем: сделать выбор объектов по аналогии с выбором объектов к примеру в команде matchprop. То есть, если пользователь щелкает на примитиве - тот добавляется в набор (в цикле работает функция entsel и функция ssadd), если на пустом месте - то щелчек воспринимается как первая точка рамки (весто entsel запускается функция getcorner) и предлагается указать вторую точку. Ну и дальше - если вторая точка левее первой - рамка секущая, правее - охватывающая... Все примитивы, выбранные рамками также добавляются в набор. Заканчиваетсяя выбор нажатием Enter. При этом, можно при помощи initget задавать дополнительные опции. Все, что я описал - легко реализуемо, даже представляю, как это можно сделать. Но вот как пропускать выбираемые объекты через фильтр ssget, для меня пока задача не решенная...
Do$ вне форума  
 
Непрочитано 31.05.2010, 17:16
#13
Александр Ривилис

программист, рыцарь ObjectARX
 
Регистрация: 09.05.2005
Киев
Сообщений: 2,405
Отправить сообщение для Александр Ривилис с помощью Skype™


Цитата:
Сообщение от Do$ Посмотреть сообщение
Но вот как пропускать выбираемые объекты через фильтр ssget, для меня пока задача не решенная...
Ну это как раз просто. Если тебе известны две точки, то (ssget "_B" p1 p2 filtr)
Александр Ривилис вне форума  
 
Непрочитано 31.05.2010, 17:53
#14
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,702
Отправить сообщение для Do$ с помощью Skype™


С рамкой-то понятно... Вот как отдельный примитив, выбранный с помощью entsel, внести в набор с учетом фильтра? Впрочем, есть пара задумок, надо садиться писать код
Стоп, а "_B" - это как? Что это за опция? я знаю только "_W" - выбор рамкой и "_C" - секущей рамкой.
Do$ вне форума  
 
Непрочитано 31.05.2010, 18:11
#15
Александр Ривилис

программист, рыцарь ObjectARX
 
Регистрация: 09.05.2005
Киев
Сообщений: 2,405
Отправить сообщение для Александр Ривилис с помощью Skype™


Цитата:
Сообщение от Do$ Посмотреть сообщение
С рамкой-то понятно... Вот как отдельный примитив, выбранный с помощью entsel, внести в набор с учетом фильтра? Впрочем, есть пара задумок, надо садиться писать код
Стоп, а "_B" - это как? Что это за опция? я знаю только "_W" - выбор рамкой и "_C" - секущей рамкой.
"_B" - от BOX (проверил в AutoCAD 2008 - работает некорректно). Так что или "_W" или "_C".
Александр Ривилис вне форума  
 
Непрочитано 31.05.2010, 19:25
#16
ShaggyDoc

Thượng Tá Quân Đội Nhân Dân Việt Nam
 
Регистрация: 14.03.2005
44d32'44"С, 33d26'51"В
Сообщений: 13,381


Цитата:
То есть, если пользователь щелкает на примитиве - тот добавляется в набор (в цикле работает функция entsel и функция ssadd), если на пустом месте - то щелчек воспринимается как первая точка рамки (весто entsel запускается функция getcorner) и предлагается указать вторую точку.
Do$, не забывай про возможность прерывания функции entsel пользователем. Варианты:
1. Нажата ESC - значит все дальнейшие действия надо безопасно прекращать.

2. Пользователь просто "промазал" мимо примитива. Здесь ты предполагаешь ввод точки. Может быть. А может и начать ssget.

Для анализа причин завершения entsel используй errno.

Вот примеры:
1. Низкоуровневая функция:
Код:
[Выделить все]
(defun _ru-get-ent-default (message       default_str   quoted_get_func esc_enabled
                            /             result        question
                            lst_params    key_str
                           )
;;;  Выбор
  (if default_str
    (setq
      question (strcat "\n" message " <" default_str ">: ")
    ) ;_ end of setq
    (setq
      question (strcat "\n" message ": ")
    ) ;_ end of setq

  ) ;_ end of if
  (setq lst_params (list question)
   end nil     
        )
   (while
   (not end)

   (ru-error-catch
    (function (lambda ()
        (cond ((and initget_param keywords)
               (initget initget_param (strcat keywords alt_key_str))
              )
              ((not (null initget_param))
               (initget initget_param)
              )
              ((not (null keywords))
               (initget (strcat keywords alt_key_str))
              )
        ) ;_ end of cond

        (setq result (vl-catch-all-apply quoted_get_func lst_params)
              end T)
          result      
                      
              ) ;_ end of lambda
    ) ;_ end of function
    ;;Это выполняется при ошибке
      (function
       (lambda (msg)
        (if esc_enabled
         (setq result nil
               end t
         ) ;_ end of setq
         (progn 
         (princ "\nЗдесь прерывание по ESC недопустимо!")
          (setq ;;result nil
               end NIL
         )
         )
        ) ;_ end of if
        (princ)
       ) ;_ end of lambda
      ) ;_ end of function
 
   ) ;_ end of ru-error-catch
 ) ;_ end of while
  result
) ;_ end of defun
2. Выбор без промаха:

Код:
[Выделить все]
(defun _ru-get-entsel-no-error (message / ent)
  ;; (_ru-get-entsel-no-error "Выбери объект, но не промахнись!")
  (setvar "errno" 0)
  (while
    (and
      (not (setq ent (entsel (strcat "\n" message))) ;)
      ) ;_ end of not
      (equal 7 (getvar "errno"))
      ;;Ошибка указания при выборе
      ;; блокированный слой?
    ) ;_ end of and
     (setvar "errno" 0)
  ) ;_ end of while
  (cond
    ((equal (getvar "errno") 52)
     ;; пустой ответ
     nil
    )
    (t
     (list (car ent) (trans (cadr ent) 1 0))
    )
  ) ;_ end of cond
) ;_ end of defun
Универсальный выбор одного объекта:

Код:
[Выделить все]
(defun ru-get-entsel (message)
  ;; (ru-get-entsel "Выбери объект, но не промахнись!")
  ;; Применять при отсутствии требований к блокирове и типам
  ;; примитивов
  ;; Возвращает примитив и точку указания
  (_ru-get-ent-default message "Выход" '_ru-get-entsel-no-error T)
)
Выбор объекта допустимых типов
Код:
[Выделить все]
(defun ru-get-entsel-by-type
                             (message     msg_err_types
                              list_types  no_locked   /
                              ent         ent_type    bad_type
                              locked      do
                             )
                             ;|
Выбор примитива с воможностью задать допустимые типы и выбор на не блокированном слое
с возможностью выхода и с блокировкой ESC
Параметры:
message - сообщение
msg_err_types - сообщение о неверном типе если задан список типов, иначе ""
list_types - список допустимх типов или NIL
no_locked  - выбор на не блокированном слое -T, на любом -NIL
 (ru-get-entsel-by-type "Выбери отрезок или полилинию" "Это не ОТРЕЗОК и не ПОЛИЛИНИЯ" (list "LINE" "LWPOLYLINE") T)
 (ru-get-entsel-by-type "Выбери объект на неблокированном слое" "" nil  T)
 (ru-get-entsel-by-type "Выбери отрезок или полилинию - можно на блокированном" "Это не ОТРЕЗОК и не ПОЛИЛИНИЯ" (list "LINE" "LWPOLYLINE") nil)
Возвращает имя примитива и точку указания или nil при отказе
 |;

  (setq do t)
  (while do
    (setq bad_type t
          locked t
    ) ;_ end of setq
    (if (setq ent (ru-get-entsel message))
      (progn
        (setq ent_type (cdr (assoc 0 (entget (car ent)))))
        (if (and list_types
                 (not (member ent_type list_types))
            ) ;_ end of and
          (princ (strcat "\nОШИБКА: Указан объект типа '"
                         ent_type
                         "'. "
                         msg_err_types
                 ) ;_ end of strcat
          ) ;_ end of princ
          (setq bad_type nil)
        ) ;_ end of if
        (if (and no_locked
                 (ru-layer-is-lock (cdr (assoc 8 (entget (car ent)))))
            ) ;_ end of and
          (princ "\nОШИБКА: Объект на заблокированном слое!")
          (setq locked nil)
        ) ;_ end of if
        (setq do (or bad_type locked))
      ) ;_ end of progn
      (setq do nil)
    ) ;_ end of if
  ) ;_ end of while
  ent
) ;_ end of defun
И вариант для размышления
Код:
[Выделить все]
(defun ru-ssentget-by-type (msg types bits / sel cmd_lst)
;;;
;;; Параметры:
;;; msg - краткое приглашение для выбора, допускается NIL
;;; bits - целое от 0 до 15, битовый переключатель, значения битов:
;;;    1 - разрешение выбора на заблокированном слое
;;;    2 - разрешение многократного выбора
;;;    4 - разрешение выбора рамкой / секрамкой
;;;    8 - возвращать набор
;;; types - список имен допустимых типов примитивов, допускается NIL
;;;
;;; Пример:
;;; (ru-ssentget-by-type "Выбери отрезок или полилинию" '("LINE" "LWPOLYLINE") 0)
;;;
;;; Возвращает имя _первого_ примитива из попавших в набор, при удачном выборе
;;; или NIL при отказе с помощью Enter или прерывании по Esc, в последнем случае,
;;; одновременно выводит сообщение о прерывании в командную строку.
;;;
;;; При наличииии любого из битов: 2, 4 или 8 и при успешном выборе, возвращает
;;; не имя примитива, а набор.
;;;
    (setq msg     (strcat "\n"
                          (if msg
                              (strcat msg " ")
                              ""
                          ) ;_ end of if
                          (if (= (strcase (getvar "SYSCODEPAGE")) "ANSI_1251")
                              "<Выход>"
                              "<Exit>"
                          ) ;_ end of if
                  ) ;_ end of strcat
          cmd_lst (if (= (logand bits 2) 0)
                      ":S"
                      ""
                  ) ;_ end of if
          cmd_lst (if (= (logand bits 4) 0)
                      (strcat cmd_lst ":E")
                      cmd_lst
                  ) ;_ end of if
          cmd_lst (if (= (logand bits 1) 0)
                      (strcat cmd_lst ":L")
                      cmd_lst
                  ) ;_ end of if
          cmd_lst (if (/= cmd_lst "")
                      (list (strcat "_" cmd_lst))
                  ) ;_ end of if
          types   (mapcar (function (lambda (x) (cons 0 x))) types)
    ) ;_ end of setq
    (if (and types (> (length types) 1))
        (setq types
                 (append (cons '(-4 . "<OR") types) '((-4 . "OR>")))
        ) ;_ end of setq
    ) ;_ end of if
    (if types
        (setq cmd_lst (append cmd_lst (list types)))
    ) ;_ end of if
    (setvar "ERRNO" 0)
    (while (and (/= (getvar "ERRNO") 52) (not sel))
        (princ msg)
        (vl-catch-all-error-p (setq sel (vl-catch-all-apply 'ssget cmd_lst)))
        (if (and (not sel) (= (logand bits 2) 2))
            (setq sel t)
        ) ;_ end of if
    ) ;_ end of while
    (cond
        ((not sel) nil)
        ((= (type sel) 'pickset)
         (if (= (logand bits 14) 0)
             (ssname sel 0)
             sel
         ) ;_ end of if
        )
        ((= (type sel) 'vl-catch-all-apply-error)
         (princ (vl-catch-all-error-message sel))
         nil
        )
        (t nil)
    ) ;_ end of if
) ;_ end of defun
ShaggyDoc вне форума  
 
Автор темы   Непрочитано 31.05.2010, 22:22
#17
sdv79

Инженер ЭОМ
 
Регистрация: 05.03.2009
Москва
Сообщений: 215
Отправить сообщение для sdv79 с помощью Skype™


сколько наваяли...
Последний код можно реконструировать для множества объектов?
sdv79 вне форума  
 
Непрочитано 01.06.2010, 01:49
1 | #18
Vov.Ka


 
Регистрация: 21.07.2008
Луцьк
Сообщений: 179


sdv79,
http://www.theswamp.org/index.php?to...6261#msg246261
убрать из функции SelAtts привязку к атрибутам, плюс добавить обработку нажатости shift функцией (acet-sys-shift-down), плюс фильтры и будет что-то похожее на ssget
Vov.Ka вне форума  
 
Непрочитано 17.07.2016, 23:13
#19
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,653


Здесь и сейчас предлагаю продолжить викторину, которую начал Дима_ в этой теме (начало в посте #10), поскольку предлагаемая мной задачка попадает в рамки данной темы.
Похожие темы (это если вдруг вы решите "погрузиться", выдержка из них будет чуть ниже):
Как заменить текст запроса в стандартной команде?
Lisp. Квинтэссенция ssget/entsel/vla-selectOnScreen для динамического ввода.
Пустой ввод при выполнении entsel.

Итак, Внимание, викторина!

Я утверждаю, что на лиспе можно создать функцию, которая будет вести себя в точности как стандартная функция ssget или как стандартный запрос на множественный выбор объектов большинства штатных команд, но при этом вместо неинформативного "Выберите объекты: " можно будет увидеть возле курсора любое приглашение, если включен динамический ввод. На выходе функция вернет созданный интерактивно набор.

Понимаю, что само понятие викторины не подразумевает столь глобальных изысканий и столь глобальных кусков кода, чтобы полностью повторить все поведение ssget, поэтому сразу приведу соль указанных тем и нужные куски кода, а вопросом викторины станет одна хитрая функция, которую первым опубликует победитель. Наградой будет второй тур викторины, в котором я выложу код, практически полностью повторяющий поведение ssget и даже больше, но в нем есть несколько отклонений от поведения стандартной функции выбора, которые участникам второго тура предстоит определить, просто жутко любопытно, насколько глубоко пользователи используют опции при выборе объектов. И потом совместными усилиями найти хитрые способы их устранения (это по ходу будет третий тур).
Идею очень хорошо описал Do$ чуть выше, в #12:
Цитата:
Сообщение от Do$ Посмотреть сообщение
Моя идея вот в чем: сделать выбор объектов по аналогии с выбором объектов к примеру в команде matchprop. То есть, если пользователь щелкает на примитиве - тот добавляется в набор (в цикле работает функция entsel и функция ssadd), если на пустом месте - то щелчек воспринимается как первая точка рамки (весто entsel запускается функция getcorner) и предлагается указать вторую точку. Ну и дальше - если вторая точка левее первой - рамка секущая, правее - охватывающая... Все примитивы, выбранные рамками также добавляются в набор. Заканчиваетсяя выбор нажатием Enter. При этом, можно при помощи initget задавать дополнительные опции. Все, что я описал - легко реализуемо, даже представляю, как это можно сделать. Но вот как пропускать выбираемые объекты через фильтр ssget, для меня пока задача не решенная...
Взяв за основу этот алгоритм, и следуя советам уважаемого ShaggyDoc из текущей и других указанных в начале тем, я собрал первую версию pseudo-ssget, которая попадает на dwg.ru как 0.9 beta:

Код:
[Выделить все]
 
(defun pseudo-ssget (prompt_string / *error* LtoT sset1_plus_sset2
											 total_ss en oldOSMODE 
											 repeatedly_added excluded on_locked_layers
											 previous_ss i ss_temp sss
					)
	(vl-load-com)
	
	(defun get_ss_by_win ( / pt1 pt2 ssmode ss)
		(setq i 0
			  pt1 (cadr (grread t 1))
			  pt2 nil
		)
		(while (null pt2) 
			   (setq pt2 (getcorner pt1 "Противоположный угол: "))
		)
		(if (<= (car pt2) (car pt1))
			(setq ssmode "_C")
			(setq ssmode "_W") 
		)
		(setq ss (ssget ssmode pt1 pt2) excluded 0)
		ss
	)
	
	(defun *error* (msg)   
		(setq i 0)
		(if total_ss
			(repeat (sslength total_ss)
				(vla-Highlight (vlax-ename->vla-object (ssname total_ss i)) :vlax-false)
				(setq i (1+ i))
			)
		)
		(redraw)
		(if oldOSMODE (setvar "OSMODE" oldOSMODE))
		(princ msg)
		(princ)
	) ;defun *error*
	
	(defun LtoT (l1 div1 / t1 v1)
		(if (not div1)(setq div1 " "))
		(if (> (length l1) 1)
			(progn 
				(setq t1 (car l1))
				(foreach v1 (cdr l1)
					(setq t1 (strcat t1 div1 v1))
				)
			)
			(car l1)
		)
	) ;defun LtoT
	
	(defun sset1_plus_sset2 (sset1 sset2 / sset3 )
		(setq sset3 (ssadd))
		(if (= (type sset1)(quote pickset))
			(setq scount (sslength sset1))
			(setq scount 0)
		)
		(while (> scount 0)
			(ssadd (ssname sset1 (setq scount (1- scount))) sset3)
		)
		(if (= (type sset2)(quote pickset))
			(setq scount (sslength sset2))
			(setq scount 0)
		)
		(while (> scount 0)
			(ssadd (ssname sset2 (setq scount (1- scount))) sset3)
		)
		sset3
	) ;defun sset1_plus_sset2
	
;;; Начало описания основной функции
	(setq total_ss (ssadd) ;;; Cоздаем общий (тотальный) набор, который 
						;;; будем наполнять по мере интерактивного выбора.
		  en T			   ;;; Задаем переменной значение для запуска цикла, далее
						;;; в зависимости от того, что вернет (entsel),
						;;; она станет ENAME или STR
		  oldOSMODE (getvar "OSMODE") 
	) ;setq
	
	;;; Запускаем цикл: пока существует переменная en и пока она не станет строкой
	(while (and en (not (= (type en)(quote STR))))
		(setq repeatedly_added 0 ; счетчик повторно добавленных в набор примитивов
			  excluded 0 ; счетчик исключенных из набора примитивов (при удержании Shift)
			  on_locked_layers 0 ; счетчик примитивов, находящихся на блокированных слоях
		)
		(setvar "ERRNO" 0)
		(initget (strcat (if keyword_list (LtoT keyword_list " ") "") " p т"))
		(setq en 
			(entsel
				(strcat (if (> (sslength total_ss) 0)
							(strcat "\nВыбрано " (vl-princ-to-string (sslength total_ss)))
							""
						)
						"\n" (if prompt_string prompt_string "Выберите объекты")
						(if (and (= (sslength total_ss) 0) keyword_list) 
							(strcat " или [" (LtoT keyword_list "/") "]")
							""
						)
						": "
				)
			);entsel
		);setq
		(if (= (type en)(quote LIST))(setq en (car en)))
		(cond 
		  (	(and (= (type en)(quote STR)) 
				 (or (= en "p")(= en "previous")(= en "т")(= en "Текущий"))
			)
			(if (setq previous_ss (ssget "_p"))
				(progn
					(setq en T i 0)
					(repeat (sslength previous_ss)
						(if (not (ssmemb (ssname previous_ss i) total_ss))
							(progn
								(vla-Highlight (vlax-ename->vla-object (ssname previous_ss i)) :vlax-true)
								(setq i (1+ i))
							)
							(progn
								(setq repeatedly_added (1+ repeatedly_added))
								(setq i (1+ i))
							)
						)
					)
					(setq total_ss (sset1_plus_sset2 previous_ss total_ss))
					(princ 
						(strcat  
							"найдено: "(vl-princ-to-string (sslength total_ss))
							(if (> repeatedly_added 0) 
								(strcat 
									" ("
									(vl-princ-to-string repeatedly_added)
									" повторно)"
								)
								""
							)
							", всего: "
							(vl-princ-to-string (sslength total_ss))
							"\n"
						)
					)
				) ;progn
				(progn
					(princ "\nТекущий (предыдущий) набор еще не был создан.\n")
					(princ)
					(setq en T)
				)
			) ;if
		  )
		  (	(and en 
				(= (type en)(quote ENAME))
				(ssmemb en total_ss)
				acet-sys-shift-down
				(acet-sys-shift-down)
			)
			(ssdel en total_ss)
			(vla-Highlight (vlax-ename->vla-object en) :vlax-false)
			(princ (strcat
						"найдено: " (vl-princ-to-string 1)
						", исключено: " (vl-princ-to-string 1)
						", всего: " (vl-princ-to-string (sslength total_ss))
					)
			)
		  )
		  (	(and en 
				(= (type en)(quote ENAME))
				(ssmemb en total_ss)
				(not (acet-sys-shift-down))
			)
			(setq repeatedly_added (1+ repeatedly_added))
			(princ (strcat
						"найдено: " (vl-princ-to-string 1)
						(if (> repeatedly_added 0) 
							(strcat " ("(vl-princ-to-string repeatedly_added) " повторно)")
							""
						)
						", всего: " (vl-princ-to-string (sslength total_ss))
					)
			)
		  )
		  (	(and en 
				(= (type en)(quote ENAME))
				(not (ssmemb en total_ss))
				acet-sys-shift-down
				(acet-sys-shift-down)
			)
			(princ 
				(strcat  
					"найдено: " (vl-princ-to-string 1)
					", всего: " (vl-princ-to-string (sslength total_ss))
				)
			)
		  )
		  (	(and en 
				(= (type en)(quote ENAME))
				(not (ssmemb en total_ss))
				(not (acet-sys-shift-down))
			)
			(if	(= (vla-get-Lock (vla-item (vla-get-layers(vla-get-activedocument (vlax-get-acad-object)))
						(vla-get-Layer (vlax-ename->vla-object en)))) :vlax-true)
				(setq on_locked_layers 1)
				(progn
					(setq ss_temp nil ss_temp (ssadd))
					(ssadd en ss_temp)
					(sssetfirst nil ss_temp)
					(ssget "_I")
					(sssetfirst nil nil)
					(setq ss_temp nil ss_temp (ssget "_P"))
					(if ss_temp
						(progn
							(vla-Highlight (vlax-ename->vla-object en) :vlax-true)
							(ssadd en total_ss)
						)
						(progn
							(princ "\nОбъект не удовлетворяет заданному фильтру.\n")
							(princ)
						)
					)
				)
			)
			(princ 
				(strcat  
					"найдено: " (vl-princ-to-string 1)
					(if (> repeatedly_added 0) 
						(strcat " (" (vl-princ-to-string repeatedly_added) " повторно)")
						""
					)
					", всего: " (vl-princ-to-string (sslength total_ss))
					(if (= on_locked_layers 1)
						"\nНаходится на блокированном слое: 1"
						""
					)
				)
			)
		  )
		  (	(and (not en) 
				 (= (getvar "ERRNO") 52)
			)
			(setq i 0)
			(repeat (sslength total_ss)
				(vla-Highlight (vlax-ename->vla-object (ssname total_ss i)) :vlax-false)
				(setq i (1+ i))
			)
			(princ 
				(strcat  
					"найдено: "(vl-princ-to-string (sslength total_ss))
					(if (> repeatedly_added 0) 
						(strcat 
							" ("
							(vl-princ-to-string repeatedly_added)
							" повторно)"
						)
						""
					)
					", всего: "
					(vl-princ-to-string (sslength total_ss))
					"\n"
				)
			)
			(princ)
			;total_ss
		  )
		  (	(and (not en) 
				 (= (getvar "ERRNO") 7)
			)
			(setvar "OSMODE" 0)
			(setq sss (get_ss_by_win))
			(if (null sss)(setq sss (ssadd))) 
			(setvar "OSMODE" oldOSMODE)					
			(if (and acet-sys-shift-down (acet-sys-shift-down))
				(progn
					(repeat (sslength sss)
						(if (ssmemb (ssname sss i) total_ss)
							(progn
								(ssdel (ssname sss i) total_ss)
								(vla-Highlight (vlax-ename->vla-object (ssname sss i)) :vlax-false)
								(setq i (1+ i)
									  excluded (1+ excluded))
							)
							(setq excluded 0 i (1+ i))
						)
					)
					(princ (strcat  "найдено: " (vl-princ-to-string (sslength sss))
									", исключено: " (vl-princ-to-string excluded)
									", всего: " (vl-princ-to-string (sslength total_ss))
							)
					)
					(setq en T)
				)
				(progn
					(setq on_locked_layers 0 i 0)
					(repeat (sslength sss)
						(if	(= (vla-get-Lock (vla-item (vla-get-layers(vla-get-activedocument (vlax-get-acad-object)))
								(vla-get-Layer (vlax-ename->vla-object (ssname sss i))))) :vlax-true
							)
							(progn
								(setq on_locked_layers (1+ on_locked_layers))
								(ssdel (ssname sss i) sss)
							)
							(if (not (ssmemb (ssname sss i) total_ss))
								(progn
									(vla-Highlight (vlax-ename->vla-object (ssname sss i)) :vlax-true)
									(setq i (1+ i))
								)
								(progn
									(setq repeatedly_added (1+ repeatedly_added))
									(setq i (1+ i))
								)
							)
						)
					)
					(setq total_ss (sset1_plus_sset2 sss total_ss))
					(princ (strcat  "найдено: " (vl-princ-to-string (sslength sss))
									(if (> repeatedly_added 0) 
										(strcat " (" (vl-princ-to-string repeatedly_added) " повторно)")
										""
									)
									(strcat ", всего: " (vl-princ-to-string (sslength total_ss)))
									(if (> on_locked_layers 0)
										(if (= on_locked_layers 1)
											(strcat "\nНаходится на блокированном слое: " (vl-princ-to-string 1))
											(strcat "\nНаходятся на блокированном слое: " (vl-princ-to-string on_locked_layers))
										)
										""
									)
							)
					)
					(setq en T)
				) ;progn
			) ;if(acet-sys-shift-down)
		  )
		) ;cond
	) ;while
	(setq i 0)
	(repeat (sslength total_ss)
		(vla-Highlight (vlax-ename->vla-object (ssname total_ss i)) :vlax-false)
		(setq i (1+ i))
	)
	(cond 
	  (	(and (= (type total_ss)(quote PICKSET)) 
			 (= (sslength total_ss) 0)
			 (null en)
		) 
		nil
	  )
	  (	(and (= (type total_ss)(quote PICKSET)) 
			 (> (sslength total_ss) 0))
		total_ss
	  )
	  (	(= (type en)(quote STR))
		en
	  )
	)
) ;defun pseudo-ssget
Пример вызова:
Код:
[Выделить все]
(sssetfirst nil (pseudo-ssget "Пора знать, что выбирать!"))
Кстати, не забудьте предварительно включить динамический ввод - программа за вас этого не сделает, неа

ВНИМАНИЕ, вопрос викторины

Написать "хитрую" функцию на AutoLISP, которая заменит в коде функцию (get_ss_by_win) и в результате выдаст "правильную" рамку выбора объектов: залитую синим при выборе слева направо, и зеленым - справа налево.
skkkk вне форума  
 
Непрочитано 18.07.2016, 07:21
#20
gomer

строю, ломаю
 
Регистрация: 03.04.2008
Украина
Сообщений: 5,515


столько шухера ради одной строчки?
gomer вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > функции выбора. Вспомогательная информация

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Предложение: Готовые функции Apelsinov Библиотека функций 170 27.06.2010 23:51
Функции AutoLISP из ... DLL! Supermax LISP 21 27.06.2010 14:18
FILTER / фильтр BM60 Справочник команд 0 08.07.2008 15:35
Информация по работе EPC/EPCM подрядчика Кочетков Андрей Поиск литературы, чертежей, моделей и прочих материалов 0 14.03.2008 11:22
Выбор примитивов в функции (command) mmax Программирование 12 19.05.2006 20:02