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

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

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

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

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

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


Средствами lisp'а такое не сделать. Единственный вариант - попробовать через prompt показать свое сообщение и запросить выбор, "погасив" вывод в ком.строку (cmdecho = 0, menuecho = 0). Кажется, так.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей 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
С.-Петербург
Сообщений: 36,742


Код:
[Выделить все]
(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>)
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей 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
С.-Петербург
Сообщений: 36,742


lisp'ом такое не сделать (хотя через ObjectARX вроде бы есть возможность изменить приглашение).
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей 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,683
Отправить сообщение для Do$ с помощью Skype™


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

программист, рыцарь ObjectARX
 
Регистрация: 09.05.2005
Киев
Сообщений: 2,273
Отправить сообщение для Александр Ривилис с помощью 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"В
Сообщений: 11,094


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

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

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

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

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

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

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


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

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


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

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


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

программист, рыцарь ObjectARX
 
Регистрация: 09.05.2005
Киев
Сообщений: 2,273
Отправить сообщение для Александр Ривилис с помощью 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"В
Сообщений: 11,094


Цитата:
То есть, если пользователь щелкает на примитиве - тот добавляется в набор (в цикле работает функция 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
Луцьк
Сообщений: 169


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

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,286


Здесь и сейчас предлагаю продолжить викторину, которую начал Дима_ в этой теме (начало в посте #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,550


столько шухера ради одной строчки?
gomer вне форума  
 
Непрочитано 29.07.2016, 20:12
#21
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,286


Цитата:
Сообщение от gomer Посмотреть сообщение
столько шухера ради одной строчки?
Спасибо за проявленный огромный интерес () и здоровый скептицизм, но на самом деле, целью написания кода была, конечно же, не только мелькающая подле курсора строчка с приглашением. Написание ее было смотивировано недовольством стандартными возможностями выбора, включая _.QSELECT, а также симпатией к динамическому вводу и выпадающему под курсором меню.
В том виде, как она есть сейчас, pseudo-ssget принимает больше аргументов:
- prompt_string - строка-приглашение;
- what_if_empty_enter - строка, которая вернется при нажатии Enter (пустой ввод);
- keyword_list - список ключевых слов либо T, во втором случае выпадающее меню повторит стандартные опции - ssget;
- filter - фильтр, такой же, как у ssget.

Возвращает либо набор, если он был создан, либо строку - ключевое слово, если оно было выбрано, либо nil, если ни того ни другого не произошло.
Помимо этого допускается выбор рамкой таким образом, что первый угол рамки может оказаться за пределами видимой области экрана, но все примитивы, не попавшие в экран, выберутся.
Правда, и шухера там гораздо больше, нежели я разместил в рамках получившейся горе-викторины.
Не стану объяснять, какие это открывает возможности - адепты лиспа (если таковые еще не все вымерли) смогут подключить фантазию и воображение, покажу лишь один из примеров использования, имеющий отношение к стандартным действиям в Автокаде, не углубляясь в специфику проектирования.
Миниатюры
Нажмите на изображение для увеличения
Название: Пример.png
Просмотров: 52
Размер:	10.4 Кб
ID:	174071  
skkkk на форуме  
 
Непрочитано 03.08.2016, 16:59
#22
Do$

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


Цитата:
Сообщение от skkkk Посмотреть сообщение
Написать "хитрую" функцию на AutoLISP, которая заменит в коде функцию (get_ss_by_win) и в результате выдаст "правильную" рамку выбора объектов: залитую синим при выборе слева направо, и зеленым - справа налево.
Вот как раз на этом я когда-то давно и споткнулся. Идею с собственным SSGET я, вроде бы, даже реализовал, в нужном мне объеме. И сообщение выводило. Но залитую цветом рамку я не смог победить.
В .NET API такой проблемы нет. Там можно задать собственное сообщение при выборе объектов, и даже ключевые слова использовать. Так что, "хитрую функцию" проще всего сделать как расширение для LISP, написанное на .NET.
Цитата:
Сообщение от skkkk Посмотреть сообщение
Возвращает либо набор, если он был создан, либо строку - ключевое слово, если оно было выбрано, либо nil, если ни того ни другого не произошло.
Кстати, в .NET, насколько я помню, нельзя вернуть ключевое слово вместо набора в методе множественного выбора объектов (Editor.GetSelection). Там обработка ключевых слов во множественном выборе довольно хитро делается и вводом ключевого слова выбор не прерывается.
P.S. А, нет, можно. http://adndevblog.typepad.com/autoca...selection.html. Но это просто чудесно - выход из метода генерацией исключения!
__________________
Толковый выбор приходит с опытом, а к нему приводит выбор бестолковый. (The Mechanic)

Последний раз редактировалось Do$, 03.08.2016 в 17:06.
Do$ вне форума  
 
Непрочитано 04.08.2016, 19:45
#23
frostmourn


 
Регистрация: 23.04.2015
Сообщений: 153


Тут призы ещё раздают, я не опоздал?
Цитата:
Сообщение от skkkk Посмотреть сообщение
Написать "хитрую" функцию на AutoLISP, которая заменит в коде функцию (get_ss_by_win) и в результате выдаст "правильную" рамку выбора объектов: залитую синим при выборе слева направо, и зеленым - справа налево.
Так или нет, но вот чего получилось. Благо, хоть большую часть кода с форума натырил.
Код:
[Выделить все]
 
;Включение / выключение привязок
(Defun changeOsmode ()
  	(setq osmode (getvar "OSMODE"))
	(if (> osmode 16384)
	    (setvar "OSMODE" (- osmode 16384))
	    (setvar "OSMODE" (+ osmode 16384))
	);end if
);end Defun


;Цикл проверки привязки
(Defun osmodLoop(gr osm-lst osmode / O s tp)
      (if (or (= (car gr) 11)
            (= (car gr) 25)
        ) ;_  or
	(setq osmode (list (menu-pop500 gr)))
      (progn
 
        (if (setq
              o (vl-remove-if
                  (function null)
                  (mapcar
                    (function
                      (lambda (x / o)
                        (if (setq o (osnap (cadr gr) x))
                          (list (distance (cadr gr) o) o x (cadr gr))
                        ) ;_  if
                      ) ;_  lambda
                    ) ;_  function
                    osmode
                  ) ;_  mapcar
                ) ;_  vl-remove-if
            ) ;_  setq
          (setq
            o (cdar
                (vl-sort
                  o
                  (function
                    (lambda (a b)
                      (< (car a) (car b))
                    ) ;_  lambda
                  ) ;_  function
                ) ;_  vl-sort
              ) ;_  cdar
          ) ;_  setq
        ) ;_  if
 
        (setq s (/ (getvar "viewsize") (cadr (getvar "SCREENSIZE"))))
        (cond
          ((not o))
          ((= (cadr o) "_non")(setq tp(redraw)))
          ((WCMATCH (cadr o) "_end,_mid,_cen,_nod,_int,_ins")
           (setq tp (car o))
           (setvar "lastpoint" tp)
           (setq o (cons (trans (car o) 1 3) (cdr o)))
           (redraw)
           (grvecs
             (cdr (assoc "tracking" osm-lst))
             (list (list s 0. 0. (caar o))
                   (list 0. s 0. (cadar o))
                   (list 0. 0. s 0.)
                   '(0. 0. 0. 1.)
             ) ;_  list
           ) ;_  grvecs
           (grvecs
             (cdr (assoc (cadr o) osm-lst))
             (list (list s 0. 0. (caar o))
                   (list 0. s 0. (cadar o))
                   (list 0. 0. s 0.)
                   '(0. 0. 0. 1.)
             ) ;_  list
           ) ;_  grvecs
          )
          ((WCMATCH (cadr o) "_nea,_qua,_app")
           (setq o (cons (trans (car o) 1 3) (cdr o)))
           (redraw)
           (grvecs
             (cdr (assoc (cadr o) osm-lst))
             (list (list s 0. 0. (caar o))
                   (list 0. s 0. (cadar o))
                   (list 0. 0. s 0.)
                   '(0. 0. 0. 1.)
             ) ;_  list
           ) ;_  grvecs
          )
          ((and tp (not (equal tp (car o) 1e-8)))
           (redraw)
           (grdraw (car o) tp 7 1)
           (setq o (cons (trans (car o) 1 3) (cdr o)))
           (grvecs
             (cdr (assoc (cadr o) osm-lst))
             (list (list s 0. 0. (caar o))
                   (list 0. s 0. (cadar o))
                   (list 0. 0. s 0.)
                   '(0. 0. 0. 1.)
             ) ;_  list
           ) ;_  grvecs
          )
        ) ;_  cond
        (if tp
          (grvecs
            (cdr (assoc "tracking" osm-lst))
            (list (list s 0. 0. (car (trans tp 1 3)))
                  (list 0. s 0. (cadr (trans tp 1 3)))
                  (list 0. 0. s 0.)
                  '(0. 0. 0. 1.)
            ) ;_  list
          ) ;_  grvecs
        ) ;_  if
      ) ;_  progn
     ) ;_  if
o
);end Defun

;Создание блока
(Defun makeBlock (lst pt / slen n i blk_def)
(setq blk_def
       (vla-add	(vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
		(vlax-3d-point pt)
		"*U"
       )
)


  ;Вставляем в блок и удаляем выбранные элементы
  ;Кол-во выбранных объектов
  ; (setq slen (SSLENGTH ss))
  ; ;Удаляем объекты и вставляем их в блок
  ; (setq i 0)
  ; while (< i slen)
  (foreach n lst
  
     ;имя объекта
     ; (setq n (ssname ss i))
     ;Вставляем объект в блок
     (vlax-invoke
	  (vla-get-activedocument (vlax-get-acad-object))
	  'copyobjects
	  (list n)
	  blk_def
     )

     ;Удаляем объект
     (vla-delete n)
    ; (setq i (1+ i))
  )

  ;Возвращаем описание блока
  blk_def
);end Defun

;Функция отрисовки пунктирного прямоугольника
(Defun drawRect (p1 p2 color / x1 x2 y1 y2 param)
  (setq
	x1 (car p1)
	x2 (car p2)
	y1 (cadr p1)
	y2 (cadr p2)
	param (if (>= x1 x2) 5 0)
  )
	(grdraw  (list x1 y1)(list x1 y2) color param)
	(grdraw (list x1 y2)(list x2 y2) color param)
	(grdraw (list x2 y2)(list x2 y1) color param)
	(grdraw (list x2 y1)(list x1 y1) color param)
	
);end Defun


;; Display GrText  -  Lee Mac
;; pnt  -  cursor point in UCS
;; scal -  scale koefficient for text _* Added
;; vec  -  GrText vector list
;; col  -  Text Colour (ACI Colour)
;; xof  -  x-offset from cursor in pixels
;; yof  -  y-offset from cursor in pixels
 
(defun LM:DisplayGrText ( pnt scal vec col xof yof / scl )
    (setq scl (/ (getvar 'viewsize) (cadr (getvar 'screensize)))
          pnt (trans pnt 1 2)
    )
    (grvecs (cons col vec)
        (list
            (list (* scal scl) 0.0 0.0 (+ (car  pnt) (* xof scl)))
            (list 0.0 (* scal scl) 0.0 (+ (cadr pnt) (* yof scl)))
            (list 0.0 0.0 (* scal scl) 0.0)
           '(0.0 0.0 0.0 1.0)
        )
    )
)



;;-----------------------=={ GrText }==-----------------------;;
;;                                                            ;;
;;  Returns a grvecs pixel vector list relative to the origin ;;
;;  encoding the supplied string.                             ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2013 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  With thanks to ElpanovEvgeniy for the method of vector    ;;
;;  encoding to save me a lot of typing.                      ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  str - String to be expressed in vector list format.       ;;
;;------------------------------------------------------------;;
;;  Returns:  GrVecs Pixel Vector List relative to the Origin ;;
;;------------------------------------------------------------;;
;;  Version 1.1    -    26-03-2011                            ;;
;;------------------------------------------------------------;;

(defun LM:GrText ( str / asc lst vec xco yco )
    (setq vec
       '(
            (033 045 045 065 135)
            (034 104 134 107 137)
            (035 043 063 046 066 084 094 087 097 115 135 118 138 072 078 103 109)
            (036 025 035 052 052 043 047 058 078 083 087 092 112 123 127 118 118 135 135)
            (037 052 052 063 063 074 074 085 085 096 096 107 107 118 118 129 129 047 048 067 068 056 056 059 059 113 114 133 134 122 122 125 125)
            (038 043 046 049 049 052 072 057 058 067 068 076 076 079 079 083 083 085 085 094 094 103 123 134 136 127 127)
            (039 105 135)
            (040 017 017 026 036 045 105 116 126 137 137)
            (041 014 014 025 035 046 106 115 125 134 134)
            (042 073 074 076 077 084 086 092 098 104 106 113 114 116 117)
            (043 055 115 082 084 086 088)
            (044 034 035 045 046 055 057)
            (045 083 088)
            (046 045 046 055 056)
            (047 052 052 063 063 074 074 085 085 096 096 107 107 118 118 129 129)
            (048 044 047 134 137 053 123 058 128)
            (049 044 048 124 125 056 136)
            (050 043 048 053 053 064 064 075 075 086 086 097 097 108 128 134 137 123 123)
            (051 053 053 044 047 058 088 095 097 108 128 134 137 123 123)
            (052 046 048 057 137 078 078 073 076 083 083 094 094 105 115 126 126)
            (053 053 053 044 047 058 088 094 097 093 133 134 138)
            (054 044 047 058 088 095 097 084 084 053 113 124 124 135 137)
            (055 044 054 065 075 086 096 107 117 128 138 133 137 123 123)
            (056 044 047 094 097 134 137 053 083 058 088 103 123 108 128)
            (057 044 046 057 057 068 128 097 097 084 086 134 137 093 123)
            (058 045 046 055 056 095 096 105 106)
            (059 034 035 045 046 055 057 095 096 105 106)
            (060 047 047 056 056 065 065 074 074 083 083 094 094 105 105 116 116 127 127)
            (061 073 078 093 098)
            (062 043 043 054 054 065 065 076 076 087 087 096 096 105 105 114 114 123 123)
            (063 045 045 065 075 086 086 097 097 108 128 134 137 123 123)
            (064 034 038 043 043 052 112 123 123 134 137 128 128 079 119 068 068 065 066 105 106 077 107 074 094)
            (065 041 043 047 049 052 062 058 068 073 077 083 093 087 097 104 114 106 116 125 135 133 134)
            (066 042 047 053 123 058 088 108 128 094 097 132 137)
            (067 044 047 053 053 058 058 062 112 123 123 134 136 127 127 108 138)
            (068 042 046 057 057 127 127 132 136 068 118 053 123)
            (069 042 048 058 058 094 095 086 106 132 137 128 138 053 123)
            (070 042 045 094 095 086 106 132 137 128 138 053 123)
            (071 044 047 053 053 058 078 086 089 062 112 123 123 134 136 127 127 108 138)
            (072 041 043 047 049 131 133 137 139 093 097 052 122 058 128)
            (073 043 047 133 137 055 125)
            (074 052 062 043 046 057 127 135 139)
            (075 042 044 048 049 132 134 136 138 053 123 084 085 095 095 106 116 127 127 076 076 067 067 058 058)
            (076 042 047 048 058 053 123 132 135)
            (077 041 043 047 049 052 122 058 128 131 132 138 139 103 113 107 117 084 094 086 096 065 075)
            (078 041 044 131 132 136 139 052 122 048 128 113 113 094 104 085 085 066 076 057 057)
            (079 044 046 053 053 057 057 123 123 127 127 134 136 062 112 068 118)
            (080 042 045 084 087 132 137 053 123 098 128)
            (081 134 136 123 123 127 127 112 062 118 068 053 053 057 057 044 046 035 036 023 024 027 028)
            (082 042 044 048 049 132 137 123 053 128 098 084 087 076 076 067 067 058 058)
            (083 042 062 053 053 044 047 058 078 086 087 093 095 102 122 133 136 127 127 118 138)
            (084 043 047 055 125 132 138 131 121 139 129)
            (085 044 046 052 053 057 058 062 122 068 128 131 133 137 139)
            (086 045 055 064 074 066 076 083 103 087 107 112 122 118 128 131 133 137 139)
            (087 043 063 047 067 072 092 074 094 076 096 078 098 101 121 105 115 109 129 131 132 138 139)
            (088 041 043 047 049 131 133 137 139 052 052 058 058 063 063 067 067 074 074 076 076 085 095 104 104 106 106 113 113 117 117 122 122 128 128)
            (089 043 047 055 085 094 094 096 096 103 113 107 117 122 122 128 128 131 133 137 139)
            (090 122 122 058 058 132 138 042 048 128 128 052 052 063 063 074 074 085 095 106 106 117 117)
            (091 015 017 135 137 025 125)
            (092 122 122 113 113 104 104 095 095 086 086 077 077 068 068 059 059)
            (093 014 016 134 136 026 126)
            (094 102 102 113 113 124 124 135 135 126 126 117 117 108 108)
            (095 021 029)
            (096 125 125 134 134)
            (097 043 046 048 048 052 072 057 097 083 086 103 106)
            (098 042 043 045 046 054 054 057 058 068 098 097 097 105 106 094 094 132 132 053 133)
            (099 044 046 053 053 057 058 052 092 093 093 104 106 097 098 108 108)
            (100 044 045 047 048 052 092 053 053 056 056 093 093 104 105 096 096 136 136 057 137)
            (101 044 046 053 053 057 058 052 092 093 093 104 106 097 098 088 088 073 078)
            (102 043 046 054 124 093 093 095 096 135 137 128 128)
            (103 013 016 022 032 027 097 107 108 066 066 096 096 054 055 104 105 063 063 093 093 062 092)
            (104 042 044 046 048 057 097 053 133 132 132 094 094 105 106)
            (105 043 047 055 105 103 104 135 135)
            (106 022 022 013 015 026 106 104 105 136 136)
            (107 042 044 046 048 053 133 132 132 057 057 066 066 074 075 085 085 096 106 107 108)
            (108 043 047 055 135 133 134)
            (109 041 043 045 046 048 049 052 102 055 105 058 108 101 101 093 093 104 104 096 096 107 107)
            (110 042 044 046 048 053 103 057 097 102 102 094 094 105 106)
            (111 044 046 104 106 053 053 057 057 093 093 097 097 052 092 058 098)
            (112 012 015 023 103 102 102 054 054 094 094 045 046 105 106 057 058 097 098 068 088)
            (113 015 018 027 107 108 108 056 056 096 096 044 045 104 105 052 053 092 093 062 082)
            (114 042 046 054 104 102 103 095 095 106 108 099 099)
            (115 052 052 043 047 058 068 073 077 082 092 103 107 098 098)
            (116 045 047 058 058 054 124 102 103 105 107)
            (117 102 102 106 106 053 103 056 056 044 045 047 107 048 048)
            (118 045 045 054 064 056 066 073 083 077 087 092 092 098 098 101 103 107 109)
            (119 043 053 047 057 062 092 064 084 066 086 068 098 101 103 095 105 107 109)
            (120 042 044 046 048 102 104 106 108 053 053 057 057 093 093 097 097 064 064 066 066 084 084 086 086 075 075)
            (121 012 013 024 024 035 045 054 064 056 066 073 083 077 087 092 092 098 098 101 103 107 109)
            (122 092 092 058 058 102 108 042 048 097 097 086 086 075 075 064 064 053 053)
            (123 016 017 025 065 073 074 085 125 136 137)
            (124 015 135)
            (125 014 015 026 066 077 078 086 126 134 135)
            (126 112 122 133 134 125 125 116 117 128 138)
            (145 114 116 125 126 136 137)
            (146 114 115 125 126 135 137)
            (161 045 115 135 135)
            (162 026 036 045 047 058 058 054 054 053 093 094 094 098 098 105 107 116 126)
            (163 043 048 054 074 083 086 094 094 103 123 134 136 117 127)
            (164 083 083 088 088 133 133 138 138 094 097 124 127 104 114 107 117)
            (165 044 046 055 075 081 089 094 094 096 096 101 103 107 109 113 113 117 117 122 122 128 128 131 133 137 139)
            (166 015 055 095 135)
            (167 042 042 032 036 047 047 056 057 065 065 074 074 083 083 092 102 068 078 087 087 096 096 105 105 113 114 123 123 134 138 128 128)
            (168 134 134 137 137)
            (169 054 057 063 063 068 068 072 122 079 129 133 133 138 138 144 147 075 076 087 087 084 114 125 126 117 117)
            (170 063 067 084 086 088 088 093 103 097 127 114 116 134 136)
            (171 055 055 064 064 073 073 082 082 093 093 104 104 115 115 058 058 067 067 076 076 085 085 096 096 107 107 118 118)
            (172 068 098 092 097)
            (173 083 088)
            (174 054 057 063 063 068 068 072 122 079 129 133 133 138 138 144 147 074 124 095 096 125 126 077 087 107 117)
            (175 151 159)
            (176 105 106 114 124 117 127 135 136)
            (177 042 048 092 098 065 085 105 125)
            (178 084 087 095 095 106 106 117 127 135 136 124 124)
            (179 094 094 085 086 097 107 116 116 127 127 135 136 124 124)
            (180 125 125 136 136)
            (181 012 012 023 113 044 047 049 049 058 118)
            (182 045 045 049 049 048 128 046 126 133 139 122 125 112 115 102 105 092 095 083 085)
            (183 085 086 095 096)
            (184 014 015 026 026 035 035)
            (185 084 086 124 124 095 135)
            (186 063 067 084 086 134 136 093 123 097 127)
            (187 052 052 063 063 074 074 085 085 094 094 103 103 112 112 055 055 066 066 077 077 088 088 097 097 106 106 115 115)
            (188 048 098 059 059 055 057 065 065 076 076 087 087 083 133 122 122 052 052 063 063 074 074 085 085 096 096 107 107 118 118 129 129)
            (189 046 049 057 057 068 068 079 089 097 098 086 086 083 133 122 122 052 052 063 063 074 074 085 085 096 096 107 107 118 118 129 129)
            (190 048 098 059 059 055 057 065 065 076 076 087 087 092 092 083 084 095 105 114 114 125 125 133 134 122 122 052 052 063 063 074 074 085 085 096 096 107 107 118 118 129 129)
            (191 044 047 058 058 053 073 084 084 095 095 106 116 136 136)
            (192 041 043 047 049 052 062 058 068 073 077 083 093 087 097 104 114 106 116 125 135 133 134 155 155 164 164)
            (193 041 043 047 049 052 062 058 068 073 077 083 093 087 097 104 114 106 116 125 135 133 134 155 155 166 166)
            (194 041 043 047 049 052 062 058 068 073 077 083 093 087 097 104 114 106 116 125 135 133 134 154 154 165 165 156 156)
            (195 041 043 047 049 052 062 058 068 073 077 083 093 087 097 104 114 106 116 125 135 133 134 152 152 163 165 155 157 168 168)
            (196 041 043 047 049 052 062 058 068 073 077 083 093 087 097 104 114 106 116 125 135 133 134 163 163 167 167)
            (197 041 043 047 049 052 062 058 068 073 077 083 093 087 097 104 114 106 116 125 135 133 134 145 145 154 154 165 165 156 156)
            (198 041 043 045 049 052 062 073 093 104 114 125 125 084 085 059 059 056 126 097 098 088 088 108 108 134 139 129 129)
            (199 044 047 053 053 058 058 062 112 123 123 134 136 127 127 108 138 014 015 026 026 035 035)
            (200 042 048 058 058 094 095 086 106 132 137 128 138 053 123 156 156 165 165)
            (201 042 048 058 058 094 095 086 106 132 137 128 138 053 123 155 155 166 166)
            (202 042 048 058 058 094 095 086 106 132 137 128 138 053 123 154 154 165 166 157 157)
            (203 042 048 058 058 094 095 086 106 132 137 128 138 053 123 164 164 167 167)
            (204 043 047 133 137 055 125 155 155 164 164)
            (205 043 047 133 137 055 125 155 155 166 166)
            (206 043 047 133 137 055 125 154 154 165 165 156 156)
            (207 043 047 133 137 055 125 163 163 167 167)
            (208 042 046 057 057 127 127 132 136 068 118 053 123 091 092 094 095)
            (209 041 044 131 132 137 139 052 122 048 128 113 113 094 104 085 085 066 076 057 057 152 152 163 165 155 157 168 168)
            (210 044 046 053 053 057 057 123 123 127 127 134 136 062 112 068 118 155 155 164 164)
            (211 044 046 053 053 057 057 123 123 127 127 134 136 062 112 068 118 155 155 166 166)
            (212 044 046 053 053 057 057 123 123 127 127 134 136 062 112 068 118 154 154 165 165 156 156)
            (213 044 046 053 053 057 057 123 123 127 127 134 136 062 112 068 118 152 152 163 165 155 157 168 168)
            (214 044 046 053 053 057 057 123 123 127 127 134 136 062 112 068 118 163 163 167 167)
            (215 052 052 063 063 074 074 085 085 096 096 107 107 118 118 058 058 067 067 076 076 094 094 103 103 112 112)
            (216 044 046 053 053 057 057 123 123 127 127 134 136 062 112 068 118 043 043 064 074 085 095 106 116 137 137)
            (217 044 046 052 053 057 058 062 122 068 128 131 133 137 139 155 155 164 164)
            (218 044 046 052 053 057 058 062 122 068 128 131 133 137 139 155 155 166 166)
            (219 044 046 052 053 057 058 062 122 068 128 131 133 137 139 154 154 165 165 156 156)
            (220 044 046 052 053 057 058 062 122 068 128 131 133 137 139 163 163 167 167)
            (221 044 046 055 085 094 094 096 096 103 113 107 117 122 122 128 128 131 133 137 139 145 155 166 166)
            (222 042 044 132 132 053 133 074 077 104 107 088 098)
            (223 042 042 043 123 134 136 107 127 095 096 087 087 058 078 045 047)
            (224 043 046 048 048 052 072 057 097 083 086 103 106 125 125 134 134)
            (225 043 046 048 048 052 072 057 097 083 086 103 106 125 125 136 136)
            (226 043 046 048 048 052 072 057 097 083 086 103 106 124 124 135 135 126 126)
            (227 043 046 048 048 052 072 057 097 083 086 103 106 122 122 133 134 125 126 137 137)
            (228 043 046 048 048 052 072 057 097 083 086 103 106 133 133 137 137)
            (229 043 046 048 048 052 072 057 097 083 086 103 106 125 125 134 134 145 145 136 136)
            (230 042 044 046 048 059 059 051 071 082 084 102 104 055 095 076 079 089 099 106 108)
            (231 014 015 026 026 035 035 044 046 053 053 057 058 052 092 093 093 104 106 097 098 108 108)
            (232 044 046 053 053 057 058 052 092 093 093 104 106 097 098 088 088 073 078 125 125 134 134)
            (233 044 046 053 053 057 058 052 092 093 093 104 106 097 098 088 088 073 078 125 125 136 136)
            (234 044 046 053 053 057 058 052 092 093 093 104 106 097 098 088 088 073 078 124 124 135 135 126 126)
            (235 044 046 053 053 057 058 052 092 093 093 104 106 097 098 088 088 073 078 133 133 137 137)
            (236 043 047 055 105 103 104 125 125 134 134)
            (237 043 047 055 105 103 104 124 124 135 135)
            (238 043 047 055 105 103 104 124 124 135 135 126 126)
            (239 043 047 055 105 103 104 133 133 136 136)
            (240 044 046 053 053 057 057 052 082 058 088 083 083 087 107 094 096 116 116 113 114 125 125 134 134 136 137)
            (241 042 044 046 048 053 103 057 097 102 102 094 094 105 106 122 122 133 134 125 126 137 137)
            (242 044 046 104 106 053 053 057 057 093 093 097 097 052 092 058 098 125 125 134 134)
            (243 044 046 104 106 053 053 057 057 093 093 097 097 052 092 058 098 125 125 136 136)
            (244 044 046 104 106 053 053 057 057 093 093 097 097 052 092 058 098 124 124 135 135 126 126)
            (245 044 046 104 106 053 053 057 057 093 093 097 097 052 092 058 098 122 122 133 135 125 127 138 138)
            (246 044 046 104 106 053 053 057 057 093 093 097 097 052 092 058 098 133 133 137 137)
            (247 055 055 115 115 082 088)
            (248 044 046 104 106 053 053 057 057 093 093 097 097 052 092 058 098 042 042 064 064 075 075 086 086 108 108)
            (249 102 102 106 106 053 103 056 056 044 045 047 107 048 048 125 125 134 134)
            (250 102 102 106 106 053 103 056 056 044 045 047 107 048 048 125 125 136 136)
            (251 102 102 106 106 053 103 056 056 044 045 047 107 048 048 124 124 135 135 126 126)
            (252 102 102 106 106 053 103 056 056 044 045 047 107 048 048 133 133 137 137)
            (253 012 013 024 024 035 045 054 064 056 066 073 083 077 087 092 092 098 098 101 103 107 109 125 125 136 136)
            (254 012 015 132 132 023 133 054 054 045 046 057 058 068 088 094 094 105 106 097 098)
            (255 012 013 024 024 035 045 054 064 056 066 073 083 077 087 092 092 098 098 101 103 107 109 133 133 137 137)
        )
    )
    (eval
        (list 'defun 'LM:GrText '( str / asc lst vec xco yco )
            (list 'setq 'vec
                (list 'quote
                    (mapcar
                        (function
                            (lambda ( b )
                                (cons (car b)
                                    (mapcar
                                        (function
                                            (lambda ( a )
                                                (list (rem a 10) (/ a 10))
                                            )
                                        )
                                        (cdr b)
                                    )
                                )
                            )
                        )
                        vec
                    )
                )
            )
           '(setq xco 0 yco 0)
           '(repeat (strlen str)
                (setq asc (ascii str)
                      str (substr str 2)
                )
                (cond
                    (   (= 32 asc)
                        (setq xco (+ xco 09))
                    )
                    (   (= 09 asc)
                        (setq xco (+ xco 36))
                    )
                    (   (= 10 asc)
                        (setq xco 0
                              yco (- yco 16)
                        )
                    )
                    (   (setq lst
                            (cons
                                (mapcar
                                    (function
                                        (lambda ( a )
                                            (list (+ (car a) xco) (+ (cadr a) yco))
                                        )
                                    )
                                    (cdr (assoc asc vec))
                                )
                                lst
                            )
                        )
                        (setq xco (+ xco 9))
                    )
                )
            )
           '(apply 'append lst)
        )
    )
    (LM:GrText str)
)


(defun menu-pop500 (d / lst s)
  ; Choice function of OSNAP through the shortcut menu.
  ; Only, as an example.
  ; Is checked up in AutoCad 2004-2007 (En)
  ; by ElpanovEvgeniy
  ; (2006-10-11)
  ; (menu-pop500 (grread t 5))
  (setq
    lst (reverse
          (menu-index
            ((lambda (x) (list (1- (vla-get-count x)) x))
              (vla-item
                (vla-get-menus
                  (vla-item
                    (vla-get-menugroups
                      (vlax-get-acad-object)
                    ) ;_  vla-get-MenuGroups
                    "ACAD"
                  ) ;_  vla-item
                ) ;_  vla-get-Menus
                "&Object Snap Cursor Menu"
              ) ;_  vla-item
            )
          ) ;_  menu-index
        ) ;_  reverse
  ) ;_  setq
  (while (and
           (listp d)
           (or (= (car d) 5)
               (= (car d) 11)
               (= (car d) 12)
               (= (car d) 25) ; For old version AutoCad
           ) ;_  or
         ) ;_  and
    (cond
      ((= (car d) 25) (menucmd "POP500=*")) ; For old version AutoCad
      ((equal d '(11 0)) (menucmd "POP500=*"))
      ((= (car d) 11) (setq s (nth (- (cadr d) 500) lst)))
    ) ;_  cond
    (if s
      (setq d s)
      (setq d (grread t 5))
    ) ;_  if
  ) ;_  while
  (substr s 1 4)
) ;_  defun
(defun menu-index (l)
  ; Creation of the list of choices of choice of OSNAP
  ; Is checked up in AutoCad 2004-2007 (En)
  ; by ElpanovEvgeniy
  ; (2006-10-11)
                  ;|
(menu-index
 ((lambda (x) (list (1-(vla-get-count x)) x))
  (vla-item
   (vla-get-menus
    (vla-item
     (vla-get-menugroups
      (vlax-get-acad-object)
      ) ;_  vla-get-MenuGroups
     "ACAD"
     ) ;_  vla-item
    ) ;_  vla-get-Menus
   "&Object Snap Cursor Menu"
   ) ;_  vla-item
  )
 ) ;_  menu-index
 |;
 
  (if (not (minusp (car l)))
    (cond
      ((= (vla-get-type (vla-item (cadr l) (car l))) 0)
       (cons
         (vla-get-macro (vla-item (cadr l) (car l)))
         (menu-index (cons (1- (car l)) (cdr l)))
       ) ;_  cons
      )
      ((= (vla-get-type (vla-item (cadr l) (car l))) 1)
       (menu-index (cons (1- (car l)) (cdr l)))
      )
      ((= (vla-get-type (vla-item (cadr l) (car l))) 2)
       (append
         (menu-index
           ((lambda (x) (list (1- (vla-get-count x)) x))
             (vla-get-submenu (vla-item (cadr l) (car l)))
           ) ;_  menu-index
         ) ;_  menu-index
         (menu-index (cons (1- (car l)) (cdr l)))
       ) ;_  append
      )
    ) ;_  cond
  ) ;_  if
) ;_  defun
(defun get_osmode nil
  ; Function create list osmode macro
  ; for result (getvar "OSMODE")
  ; by Evgeniy Elpanov
  ; (get_osmode)
  (mapcar
    (function cdr)
    (vl-remove-if
      (function
        (lambda (x)
          (zerop (logand (getvar "OSMODE") (car x)))
        ) ;_  lambda
      ) ;_  function
      (append
        (if (< 0 (setq cur_mode (getvar "osmode")) 16384)
          '((1 . "_end")
            (2 . "_mid")
            (4 . "_cen")
            (8 . "_nod")
            (16 . "_qua")
            (32 . "_int")
  ;(4096 . "_ext") ; Is not realized
           )
        ) ;_  if
        (if (not (zerop (logand (getvar "autosnap") 16)))
          '((64 . "_ins")
            (128 . "_per")
            (256 . "_tan")
            (512 . "_nea")
  ;(1024 . "_qui") ; Is not realized
            (2048 . "_app")
  ;(8192 . "_par") ; Is not realized
           )
        ) ;_  if
      ) ;_  append
    ) ;_  substr
  ) ;_  mapcar
) ;_  defun
 
 
(defun osmode-grvecs-lst (/ -ASS ASS COL)
  ; Function create list
  ; for drawing icons osmode with the function grvecs
  ; by Evgeniy Elpanov
  ; (osmode-grvecs-lst)
  (setq
    col  (atoi (getenv "AutoSnapColor"))
    ass  (atof (getenv "AutoSnapSize"))
    -ass (- ass)
  ) ;_  setq
  (list
    (list
      "tracking"
      col
      (list (* -ass 0.2) 0.)
      (list (* ass 0.2) 0.)
      col
      (list 0. (* -ass 0.2))
      (list 0. (* ass 0.2))
    ) ;_  list
    (list
      "_end"
      col
      (list -ass -ass)
      (list -ass ass)
      col
      (list (1- -ass) (1- -ass))
      (list (1- -ass) (1+ ass))
      col
      (list -ass ass)
      (list ass ass)
      col
      (list (1- -ass) (1+ ass))
      (list (1+ ass) (1+ ass))
      col
      (list ass ass)
      (list ass -ass)
      col
      (list (1+ ass) (1+ ass))
      (list (1+ ass) (1- -ass))
      col
      (list ass -ass)
      (list -ass -ass)
      col
      (list (1+ ass) (1- -ass))
      (list (1- -ass) (1- -ass))
    ) ;_  list
    (list
      "_mid"
      col
      (list -ass -ass)
      (list 0. ass)
      col
      (list (1- -ass) (1- -ass))
      (list 0. (1+ ass))
      col
      (list 0. ass)
      (list ass -ass)
      col
      (list 0. (1+ ass))
      (list (1+ ass) (1- -ass))
      col
      (list ass -ass)
      (list -ass -ass)
      col
      (list (1+ ass) (1- -ass))
      (list (1- -ass) (1- -ass))
    ) ;_  list
    (list
      "_cen"
      7
      (list (* -ass 0.2) 0.)
      (list (* ass 0.2) 0.)
      7
      (list 0. (* -ass 0.2))
      (list 0. (* ass 0.2))
      col
      (list -ass 0.)
      (list (* -ass 0.86) (* ass 0.5))
      col
      (list (* -ass 0.86) (* ass 0.5))
      (list (* -ass 0.5) (* ass 0.86))
      col
      (list (* -ass 0.5) (* ass 0.86))
      (list 0. ass)
      col
      (list 0. ass)
      (list (* ass 0.5) (* ass 0.86))
      col
      (list (* ass 0.5) (* ass 0.86))
      (list (* ass 0.86) (* ass 0.5))
      col
      (list (* ass 0.86) (* ass 0.5))
      (list ass 0.)
      col
      (list ass 0.)
      (list (* ass 0.86) (* -ass 0.5))
      col
      (list (* ass 0.86) (* -ass 0.5))
      (list (* ass 0.5) (* -ass 0.86))
      col
      (list (* ass 0.5) (* -ass 0.86))
      (list 0. -ass)
      col
      (list 0. -ass)
      (list (* -ass 0.5) (* -ass 0.86))
      col
      (list (* -ass 0.5) (* -ass 0.86))
      (list (* -ass 0.86) (* -ass 0.5))
      col
      (list (* -ass 0.86) (* -ass 0.5))
      (list -ass 0.)
    ) ;_  list
    (list
      "_nod"
      col
      (list -ass -ass)
      (list ass ass)
      col
      (list -ass ass)
      (list ass -ass)
      col
      (list -ass 0.)
      (list (* -ass 0.86) (* ass 0.5))
      col
      (list (* -ass 0.86) (* ass 0.5))
      (list (* -ass 0.5) (* ass 0.86))
      col
      (list (* -ass 0.5) (* ass 0.86))
      (list 0. ass)
      col
      (list 0. ass)
      (list (* ass 0.5) (* ass 0.86))
      col
      (list (* ass 0.5) (* ass 0.86))
      (list (* ass 0.86) (* ass 0.5))
      col
      (list (* ass 0.86) (* ass 0.5))
      (list ass 0.)
      col
      (list ass 0.)
      (list (* ass 0.86) (* -ass 0.5))
      col
      (list (* ass 0.86) (* -ass 0.5))
      (list (* ass 0.5) (* -ass 0.86))
      col
      (list (* ass 0.5) (* -ass 0.86))
      (list 0. -ass)
      col
      (list 0. -ass)
      (list (* -ass 0.5) (* -ass 0.86))
      col
      (list (* -ass 0.5) (* -ass 0.86))
      (list (* -ass 0.86) (* -ass 0.5))
      col
      (list (* -ass 0.86) (* -ass 0.5))
      (list -ass 0.)
    ) ;_  list
    (list
      "_qua"
      col
      (list 0. -ass)
      (list -ass 0.)
      col
      (list 0. (1- -ass))
      (list (1- -ass) 0.)
      col
      (list -ass 0.)
      (list 0. ass)
      col
      (list (1- -ass) 0.)
      (list 0. (1+ ass))
      col
      (list 0. ass)
      (list ass 0.)
      col
      (list 0. (1+ ass))
      (list (1+ ass) 0.)
      col
      (list ass 0.)
      (list 0. -ass)
      col
      (list (1+ ass) 0.)
      (list 0. (1- -ass))
    ) ;_  list
    (list
      "_int"
      col
      (list -ass -ass)
      (list ass ass)
      col
      (list -ass (1+ -ass))
      (list ass (1+ ass))
      col
      (list (1+ -ass) -ass)
      (list (1+ ass) ass)
      col
      (list -ass ass)
      (list ass -ass)
      col
      (list -ass (1+ ass))
      (list ass (1+ -ass))
      col
      (list (1+ -ass) ass)
      (list (1+ ass) -ass)
    ) ;_  list
    (list
      "_ins"
      col
      (list (* -ass 0.1) (* -ass 0.1))
      (list -ass (* -ass 0.1))
      col
      (list -ass (* -ass 0.1))
      (list -ass ass)
      col
      (list -ass ass)
      (list (* ass 0.1) ass)
      col
      (list (* ass 0.1) ass)
      (list (* ass 0.1) (* ass 0.1))
      col
      (list (* ass 0.1) (* ass 0.1))
      (list ass (* ass 0.1))
      col
      (list ass (* ass 0.1))
      (list ass -ass)
      col
      (list ass -ass)
      (list (* -ass 0.1) -ass)
      col
      (list (* -ass 0.1) -ass)
      (list (* -ass 0.1) (* -ass 0.1))
      col
      (list (1- (* -ass 0.1)) (1- (* -ass 0.1)))
      (list (1- -ass) (1- (* -ass 0.1)))
      col
      (list (1- -ass) (1- (* -ass 0.1)))
      (list (1- -ass) (1+ ass))
      col
      (list (1- -ass) (1+ ass))
      (list (1+ (* ass 0.1)) (1+ ass))
      col
      (list (1+ (* ass 0.1)) (1+ ass))
      (list (1+ (* ass 0.1)) (1+ (* ass 0.1)))
      col
      (list (1+ (* ass 0.1)) (1+ (* ass 0.1)))
      (list (1+ ass) (1+ (* ass 0.1)))
      col
      (list (1+ ass) (1+ (* ass 0.1)))
      (list (1+ ass) (1- -ass))
      col
      (list (1+ ass) (1- -ass))
      (list (1- (* -ass 0.1)) (1- -ass))
      col
      (list (1- (* -ass 0.1)) (1- -ass))
      (list (1- (* -ass 0.1)) (1- (* -ass 0.1)))
    ) ;_  list
    (list
      "_tan"
      col
      (list -ass ass)
      (list ass ass)
      col
      (list (1- -ass) (1+ ass))
      (list (1+ ass) (1+ ass))
      col
      (list -ass 0.)
      (list (* -ass 0.86) (* ass 0.5))
      col
      (list (* -ass 0.86) (* ass 0.5))
      (list (* -ass 0.5) (* ass 0.86))
      col
      (list (* -ass 0.5) (* ass 0.86))
      (list 0. ass)
      col
      (list 0. ass)
      (list (* ass 0.5) (* ass 0.86))
      col
      (list (* ass 0.5) (* ass 0.86))
      (list (* ass 0.86) (* ass 0.5))
      col
      (list (* ass 0.86) (* ass 0.5))
      (list ass 0.)
      col
      (list ass 0.)
      (list (* ass 0.86) (* -ass 0.5))
      col
      (list (* ass 0.86) (* -ass 0.5))
      (list (* ass 0.5) (* -ass 0.86))
      col
      (list (* ass 0.5) (* -ass 0.86))
      (list 0. -ass)
      col
      (list 0. -ass)
      (list (* -ass 0.5) (* -ass 0.86))
      col
      (list (* -ass 0.5) (* -ass 0.86))
      (list (* -ass 0.86) (* -ass 0.5))
      col
      (list (* -ass 0.86) (* -ass 0.5))
      (list -ass 0.)
    ) ;_  list
    (list
      "_per"
      col
      (list -ass -ass)
      (list -ass ass)
      col
      (list (1- -ass) (1- -ass))
      (list (1- -ass) (1+ ass))
      col
      (list ass -ass)
      (list -ass -ass)
      col
      (list (1+ ass) (1- -ass))
      (list (1- -ass) (1- -ass))
      col
      (list -ass 0.)
      (list 0. 0.)
      col
      (list -ass -1.)
      (list 0. -1.)
      col
      (list 0. 0.)
      (list 0. -ass)
      col
      (list -1. 0.)
      (list -1. -ass)
    ) ;_  list
    (list
      "_nea"
      col
      (list -ass -ass)
      (list ass ass)
      col
      (list -ass ass)
      (list ass ass)
      col
      (list (1- -ass) (1+ ass))
      (list (1+ ass) (1+ ass))
      col
      (list -ass ass)
      (list ass -ass)
      col
      (list ass -ass)
      (list -ass -ass)
      col
      (list (1+ ass) (1- -ass))
      (list (1- -ass) (1- -ass))
    ) ;_  list
    (list
      "_app"
      col
      (list -ass -ass)
      (list ass ass)
      col
      (list ass -ass)
      (list -ass ass)
 
      col
      (list -ass -ass)
      (list -ass ass)
      col
      (list (1- -ass) (1- -ass))
      (list (1- -ass) (1+ ass))
      col
      (list -ass ass)
      (list ass ass)
      col
      (list (1- -ass) (1+ ass))
      (list (1+ ass) (1+ ass))
      col
      (list ass ass)
      (list ass -ass)
      col
      (list (1+ ass) (1+ ass))
      (list (1+ ass) (1- -ass))
      col
      (list ass -ass)
      (list -ass -ass)
      col
      (list (1+ ass) (1- -ass))
      (list (1- -ass) (1- -ass))
    ) ;_  list
    ;; Is not realized
    ;;    (list
    ;;    "_par"
    ;;      col
    ;;      (list (* -ass 0.8) -ass)
    ;;      (list ass (* ass 0.8))
    ;;      col
    ;;      (list -ass (* -ass 0.8))
    ;;      (list (* ass 0.8) ass)
    ;;    )
 
  ) ;_  list
)


(defun _GAS_add_hatch (csp PT / pt adoc ent hatch locked ECHO)
  ; (vla-startundomark
	(if (not adoc) (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
	; ) ;_ end of vla-StartUndoMark
	
	(if (= (type PT) 'list)
		(progn
		  ; (setq locked (vla-get-lock (vla-get-activelayer adoc)))
		  ; (vla-put-lock (vla-get-activelayer adoc) :vlax-false)
			(setq ent
				(vlax-ename->vla-object (_AddLWPoly (_GAS_point_to_BBox PT 500) T))
			)
			(vla-move ent (vlax-3D-point '(0. 0. 0.)) (vlax-3D-point '(500. 500. 0.)))
					(setq ECHO (getvar 'cmdecho))
					(setvar 'cmdecho 0)
			(setq hatch (vla-addhatch
						csp
						achatchpatterntypepredefined
						"SOLID"
						:vlax-false
						; :vlax-true
						) ;_ end of vla-AddHatch
			) ;_ end of setq
		  (vla-appendouterloop
			hatch
			(vlax-make-variant
			  (vlax-safearray-fill
				(vlax-make-safearray
				  vlax-vbobject
				  '(0 . 0)
				  ) ;_ end of vlax-make-safearray
				(list ent)
				) ;_ end of vlax-safearray-fill
			  ) ;_ end of vlax-make-variant
			) ;_ end of vla-AppendOuterLoop
		  (vla-evaluate hatch)
		  (vla-erase ent)
		  (vla-put-color hatch acByBlock)
					(setvar 'cmdecho ECHO)
		  ; (vla-regen adoc acallviewports)
					  ; (if locked
						; (vla-put-lock (vla-get-activelayer adoc) locked)
						; ) ;_ end of if
		) ;_ end of progn
	) ;_ end of if
  ; (vla-endundomark adoc)
	(princ)
	hatch
)

	
;; Превращает список координат POINT (точка) в координаты рамки, отстоящей на INC
(defun _GAS_point_to_BBox (POINT INC / )
	(mapcar
		'(lambda ( x )
			(mapcar
				'(lambda ( y )
					((eval y)
						(mapcar '(lambda ( a o ) (mapcar o a (list INC INC))) (list POINT POINT) '(- +))
					)
				)
				x
			)
		)
		'(   (caar   cadar)
			(caadr  cadar)
			(caadr cadadr)
			(caar  cadadr)
		)
	)
)
	
; Draw lwpolyline in current UCS
; version for pre-visual lisp.
; lst - list of points ((X1 Y1)(X2 Y2) ... (Xn Yn)) in current UCS
; cls - DXF group 70 flag  to indicate closure : nil = open, T = closed
(defun _AddLWPoly (lst cls / exv)
  (setq exv (trans (list 0 0 1) 1 0 T))
  (entmakex
    (append (list (cons 0 "LWPOLYLINE")
		  (cons 38 (caddr (trans (car lst) 1 exv)))
		  (cons 100 "AcDbEntity")
		  (cons 100 "AcDbPolyline")
		  (cons 90 (length lst))
		  (cons	70
			(if cls
			  1
			  0
			)
		  )
		  (cons 210 exv)
	    )
	    (mapcar '(lambda (p) (cons 10 (trans p 1 exv))) lst)
    )
  )
)

;; помещает список объектов LST на задний план
(defun _GAS_ToBottom (csp LST / xdic sorttbl)
	(setq xdic (vla-getextensiondictionary csp))
	(if (vl-catch-all-error-p
			(setq sorttbl
				(vl-catch-all-apply
						'vla-getobject
						(list xdic "ACAD_SORTENTS")
				)
			)
		)
		(setq sorttbl
			(vla-addobject
					xdic
					"ACAD_SORTENTS"
					"AcDbSortentsTable"
			)
		)
	)
	(vla-MovetoBottom
			sorttbl
			(vlax-safearray-fill
				(vlax-make-safearray
						vlax-vbobject
						(cons 0 (1- (length LST)))
				)
				LST
			)
	)
)


(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)
	(setq aobj (vlax-get-acad-object))
	  (setq adoc (vla-get-ActiveDocument aobj))
	  (setq model_space (vla-get-ModelSpace adoc))
	  (setq csp (if (and (zerop (vla-get-activespace adoc))
			   (= :vlax-false (vla-get-mspace adoc))
			  )
			(vla-get-paperspace adoc)
			(vla-get-ModelSpace adoc)
		  )
	  )


; (sssetfirst nil (get_ss_by_win csp))
;;  
(defun get_ss_by_win (csp / ssmode ss	PrevSS locked vlaB TrueColor p1 p2 osm-lst osmode loopExit o masX masY OnError
					)
		; (setq i 0
			  ; p1 (cadr (grread t 1))
			  ; p2 nil
		; )
		; (while (null p2) 
			   ; (setq p2 (getcorner p1 "Противоположный угол: "))
		; )
		; (if (<= (car p2) (car p1))
			; (setq ssmode "_C")
			; (setq ssmode "_W") 
		; )
		; (setq ss (ssget ssmode p1 p2) excluded 0)
		; ss
		
	; (setq p1 (getpoint "\nВыделите объекты: "))
	(setq i 0
		 p1 (cadr (grread t 1))
		 ; PrevSS (cadr (ssgetfirst))
	)
	
	;Запоминаем настройки привязок
	(setq osm-lst (osmode-grvecs-lst)
		osmode (get_osmode)
		locked (vla-get-lock (vla-get-activelayer adoc))
	);end setq
	(vla-put-lock (vla-get-activelayer adoc) :vlax-false)
	
	(setq blockDef (makeBlock (list (_GAS_add_hatch csp p1)) p1))
	(_GAS_ToBottom csp (list (setq vlaB (vla-insertblock csp (vlax-3d-point p1)(vla-get-name blockDef) 1.0 1.0 1.0 0.0))))
	(vla-setRGB (setq TrueColor (vla-get-TrueColor vlaB)) 0 31 63)
	(vla-put-truecolor vlaB TrueColor)
	(vla-update vlaB)	; необязательно
	(redraw)	; необязательно
		(setq OnError T)
		(princ "Противоположный угол: ")
	(while (and
				(or
					; (= (car (setq gr (grread nil 5 0))) 5)
					(= (car (setq gr (grread nil 13 1))) 5)
				   (= (car gr) 11)
				   (= (car gr) 25) ; For right button
					(= (car gr) 2)
				)
				(not loopExit)
			)
			(redraw)
			(cond ((= (car gr) 5)
				(setq o (osmodLoop gr osm-lst osmode))
				;Удаляем прорисованный блок
				 (vla-delete vlaB)
				;Вычисляем новый масштаб
				(setq p2 (if o (osnap (caddr o) (cadr o)) (last gr)))
				(if (not p2)(setq p2 (last gr)))
				(setq masX (abs
							(/
								(- (car p1)(car p2))
									1000
							)
						)
					masX (if (zerop masX) 0.001 masX)
				)
				(setq masY (abs
					(/
						(- (cadr p1)(cadr p2))
							1000
						)
					)
					masY (if (zerop masY) 0.001 masY)
				)
				;Рисуем пунктирную рамку
				(drawRect p1 p2 7)
				(LM:DisplayGrText p2 1.2 (LM:GrText (strcat "Specify opposite corner: " (rtos (car p2)) "  " (rtos (cadr p2)))) 21 15 -30)
				
				(setq vlaB (vla-insertblock csp (vlax-3d-point p1)(vla-get-name blockDef)
											(if (> (car p1)(car p2)) (- masX) masX)
											(if (> (cadr p1)(cadr p2)) (- masY) masY) 1.0 0.0)
				)
				(_GAS_ToBottom csp (list vlaB))
				(vla-setRGB (setq TrueColor (vla-get-TrueColor vlaB)) 0 (if (> (car p1)(car p2)) 63 31) (if (> (car p1)(car p2)) 15 63))
				(vla-put-truecolor vlaB TrueColor)
				(vla-update vlaB)
				
				)
			
				((= (car gr) 2)
					;Включение/выключение привязки по F3
				  (if (= (cadr gr) 6)
					(progn
					  (changeOsmode)
					  (setq osmode (get_osmode))
					);end progn
				  );end if
					; Нажали Enter
				  (if (= (cadr gr) 13)
					(progn
						(drawRect p1 p2 7)
					  (setq p2 (getpoint (strcat "Противоположный угол: ")))
					  (if p2 (setq loopExit t))
					);end progn
				   )
				  
				)
				(	(= (car gr) 3) (setq loopExit t ))
				
				; (	(= (car gr) 25) ... )		; тут можно добавить меню по правой кнопке...
				
			);end cond
	)
		(redraw)
		;Удаляем блок
		(vla-delete vlaB)
		(if locked
			(vla-put-lock (vla-get-activelayer adoc) locked)
		)
	;Выбираем объекты внутри прямоугольника
	(setq sel (ssget (if (>= (car p1) (car p2)) "_C" "_W") p1 p2))

	; (if PrevSS (setq sel (sset1_plus_sset2 PrevSS sel)) sel)
		; (if sel (princ (strcat (itoa (sslength sel)) " найдено\n")))
	
)

(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))
			)
		)
		(if oldOSMODE (setvar "OSMODE" oldOSMODE))
		(if ECHO (setvar "CMDECHO" ECHO))
		; (princ msg)
		; (princ)
		
		  ;Масштабирование отменено
	(if vlaB
		; (progn
			; (princ (strcat "\nОшибка : " msg "\n"))
			; (redraw)
			;Удаляем блок
			(vl-catch-all-apply '(lambda () (vla-delete vlaB)))
		; );end progn
	);end if
	
		(if OnError (princ " *Прервано*\n"))
      ;Объекты не выбраны
      ; (if (not total_ss)
		  ; (progn
			  ; (redraw)
			  ; (princ "\nНичего не выбрано\n")
		   ; );end progn
		; );end if
		(redraw)
		(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 csp))
			(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-ом, люблю, когда ручки видно. И предварительный выбор неплохо бы обрабатывать.

Последний раз редактировалось frostmourn, 05.08.2016 в 09:20.
frostmourn вне форума  
 
Непрочитано 09.09.2016, 12:30
#24
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,286


Цитата:
Сообщение от Do$ Посмотреть сообщение
Так что, "хитрую функцию" проще всего сделать как расширение для LISP, написанное на .NET.
Об этом я догадывался, поскольку помню, Александр Ривилис на форуме говорил, что и средствами ObjectARX это делается элементарно. Тут просто был такой интерес - решить лиспом. Просто до сих пор было очень мало задач, которые лиспом не решались. Эта - можно сказать - одна из них, потому как решение не слишком производительно, далее объясню, почему. Любопытно, почему ты решил перебраться с лиспа на .NET? Имею в виду с чем не справился лисп, когда ты решил написать свою первую строчку на .NET?
Цитата:
Сообщение от frostmourn Посмотреть сообщение
Так или нет, но вот чего получилось.
Получилось интересно, не знал, что такое можно на лиспе исполнить. Мне понравилось. Правда, не понял, а зачем привязки обрабатывать? Их же нет при стандартном выборе рамкой.

А вообще, конечно, направление движения не то, что я имел в виду. Все было куда проще в коде, но, возможно, куда дольше в моих экспериментах и "тыков" в свое время.
Вот код, который визуально повторит полностью действия стандартного выбора:
Код:
[Выделить все]
 	(defun get_ss_by_win ( / pt1 pt2 sign ss)
		(princ "Противоположный угол: ")
		(vl-cmdf "_.scale" "_box"  (setq pt1 (cadr (grread T))) pause "")(vl-cmdf)
		(setq pt2 (cadr (grread T)))
		(if (null (lib:IsPtInView pt1)) (progn (setq sign T)(command "_zoom" "_w" pt1 pt2)))
		(if (<= (car pt2) (car pt1))
			(setq ssmode "_C")
			(setq ssmode "_W") 
		)
		(setq ss (ssget ssmode pt1 pt2))
		(if sign (command "_zoom" "_p"))
		(setq sign nil)
		ss
	)
Третья и четвертая строки тут основные. Команда вместо _.scale тут может быть почти любая из панели Редактирование. Не суть, она все равно обрывается. Тут важна визуализация и получение точек. Да-да, знаю, что она совершает выбор два раза и на большом количестве объектов работает заметно дольше обычного. Но специфика нашей работы такова, что большими объемами примитивов не ворочаем, работаем на подосновах, как правило наших объектов в чертеже не более 2-3-х тысяч, их такой двойной выбор глотает, не замечая. Также для форума функцию я несколько сократил, но кроме самой соли оставил возможность выбора за пределами экрана. Для этого понадобятся функции от VVA
Код:
[Выделить все]
 
(defun DTR (a)(* pi (/ a 180.0)))
;| ! *******************************************************************
;; !                  lib:IsPtInView
;; ! *******************************************************************
;; ! Проверяет находится ли точка в видовом экране
;; ! Auguments: 'pt'  - Точка для анализа в МСК!!!
;; ! Return   : T или nil если 'pt' в видовом экране или нет
;; ! *******************************************************************|;
(defun lib:IsPtInView (pt / VCTR Y_Len SSZ X_Pix Y_Pix X_Len Lc Uc)
  (setq pt (trans pt 0 1))          ;_Транслируем координаты из МСК в ПСК
  (setq	VCTR  (getvar "VIEWCTR")    ;_Центр вида на текущем видовом экране . (в координатах ПСК).
	Y_Len (getvar "VIEWSIZE")   ;_Высота вида на текущем видовом экране, выраженная в единицах рисунка 
	SSZ   (getvar "SCREENSIZE") ;_Размер текущего видового экрана в пикселах (по X и Y).
	X_Pix (car SSZ)             ;_Размер текущего видового экрана в пикселах по X.
	Y_Pix (cadr SSZ)            ;_Размер текущего видового экрана в пикселах по Y.
	X_Len (* (/ X_Pix Y_Pix) Y_Len) ;_Размер по Х вида, выраженный в единицах рисунка
	Lc    (polar VCTR (dtr 180.0) (* 0.5 X_Len))
	Uc    (polar Lc 0.0 X_Len)
	Lc    (polar Lc (dtr 270.0) (* 0.5 Y_Len)) ;_Левый нижний угол видового экрана
	Uc    (polar Uc (dtr 90.0) (* 0.5 Y_Len))  ;_Правый верхний угол видового экрана
  )
  (if (and (> (car pt) (car Lc))  ;_Сама проверка (car pt) - X (cadr pt)-Y
	   (< (car pt) (car Uc))
	   (> (cadr pt) (cadr Lc))
	   (< (cadr pt) (cadr Uc))
      )
    T
    nil
  )
)

Таким образом, если заменим в коде викторины функцию get_ss_by_win на приведенную в этом посте, а также подгрузим функции от VVA, то будем иметь выбор объектов со штатным поведением, но своим приглашением. Поскольку победителей в викторине (читай - заинтересованных в подобном функционале) нет, то и конечный код выкладывать смысла не вижу.
skkkk на форуме  
 
Непрочитано 11.09.2016, 21:47
#25
Do$

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


Цитата:
Сообщение от skkkk Посмотреть сообщение
Любопытно, почему ты решил перебраться с лиспа на .NET?
Желание освоить .NET или ObjectARX зрело давно и долго, но мотивации не хватало. Но тут понадобилось писать приложения под Civil 3D. Материалы были только для .NET API, поэтому, пришлось осваивать.
У лиспа то там то тут постоянно всплывали какие-то ограничения - то с диалогами, то вот с таким выводом сообщений при множественном выборе объектов, то с динамической отрисовкой, то с производительностью...
__________________
Толковый выбор приходит с опытом, а к нему приводит выбор бестолковый. (The Mechanic)
Do$ вне форума  
Ответ
Вернуться   Форум 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