Выбор узловых выносок СПДС (SpdsNoteKnot) по образцу текущей выделенной.

Baldares · 25.11.2008, 13:07

Привет.

Вот эта задачка может стать для меня основой для освоения Лиспа.
Потомучто на VBA до dxf кодов добираться все равно через него. А еще и гемор по пути схватишь.

Прошу накидать пример. Пожалуйста. А я еге изучу )))

Цель. Выделить выноски по образцу выдбранной.

Я представляю себе такие действия:
1. Получить верхнюю стороку текущей выбранной выноски. Т.е. предпологается что перед стартом команды - выделена выноска (по которой и нужно будет выделить все выноски на чертеже в model_space, с таким же текстом).
2. Перебрать модель и занести в набор все выноски с таким же текстом.
3. Подсветить набор.

Вот что у меня есть пока. - Был бред, удалил.

Готовый лисп см. #51

Baldares · 25.11.2008, 22:35

Справочник команд AutoCAD 2008 > Системные переменные > Системные переменные U >
USERS1-5

Цитата:

Обеспечивает хранение и извлечение данных текстовых строк. Существует пять системных переменных: USERS1, USERS2, USERS3, USERS4 и USERS5.

Кулик Алексей aka kpblc · 25.11.2008, 23:12

USERS* - для хранения строковых значений
USERR* - то же, чисел с двойной точностью
USERI* - то же, целых чисел.
Код (как вариант, на лиспе):

Код:

[Выделить все]

(defun spds-node-select-like (lst             /
                              fun_conv-selset-to-ename        fun_get-node
                              fun_get-sheet   fun_get-scale   fun_get-adress
                              obj             obj_layer       obj_node
                              obj_sheet       obj_adress      obj_scale
                              selset          ent             obj_lst
                              res
                              )
                             ;|
*    Выбор "такой же" узловой выноски СПДС GraphiCS по списку критериев.
*    Параметры вызова:
	lst	список вида
	 '("layer"	; наличие слова указывает, что надо учитывать объекты,
	 		; лежащие на таком же слое
	   "node"	; то же, по номеру узла (в терминологии СПДС)
	   "sheet"	; то же, номеру листа
	   "adress"	; то же, адрес
	   "scale"	; фильтровать по масштабу объекта
	   )
*    Формируется набор только по пространству, в котором лежит "определяющий" объект
*    Примеры вызова:
(spds-node-select-like nil)	; выбрать вообще все.
(spds-node-select-like '("layer")) ; выбрать выноски, лежащие на том же
				; слое, что и "родитель"
(spds-node-select-like '("node"))
(spds-node-select-like '("node" "layer"))
|;

  (defun fun_conv-selset-to-ename (selset / tab item)
    (cond
      ((not selset) nil)
      ((= (type selset) 'pickset)
       (repeat (setq tab  nil
                     item (sslength selset)
                     ) ;_ end setq
         (setq tab (cons (ssname selset (setq item (1- item))) tab))
         ) ;_ end repeat
       )
      ((listp selset) selset)
      ) ;_ end of cond
    ) ;_ end of defun

  (defun fun_get-node (ent_lst)
    (cdr (assoc 300 (member '(301 . "Номер узла") ent_lst)))
    ) ;_ end of defun

  (defun fun_get-sheet (ent_lst)
    (cdr (assoc 300 (member '(301 . "Номер листа") ent_lst)))
    ) ;_ end of defun

  (defun fun_get-adress (ent_lst)
    (cdr (assoc 300 (member '(301 . "Адрес узла") ent_lst)))
    ) ;_ end of defun

  (defun fun_get-scale (ent_lst)
    (cdr (assoc 40 (member '(301 . "Scale") ent_lst)))
    ) ;_ end of defun

  (vl-load-com)
  (setq lst (mapcar (function strcase) lst))
  (if (and (= (type (setq obj (vl-catch-all-apply
                                (function
                                  (lambda ()
                                    (ssget "_:E:S")
                                    ) ;_ end of lambda
                                  ) ;_ end of function
                                ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'pickset
              ) ;_ end of =
           (setq obj (ssname obj 0))
           (= (cdr (assoc 0 (entget obj))) "spdsNoteKnot")
           (setq selset (ssget "_X" (list (assoc 410 (entget obj)))))
           ) ;_ end of and
    (progn
      (setq obj_lst    (entget obj)
            obj_layer  (if (member "LAYER" lst)
                         (cdr (assoc 8 obj_lst))
                         ) ;_ end of if
            obj_node   (if (member "NODE" lst)
                         (cdr (assoc 300 (member '(301 . "Номер узла") obj_lst)))
                         ) ;_ end of if
            obj_sheet  (if (member "SHEET" lst)
                         (cdr (assoc 300 (member '(301 . "Номер листа") obj_lst)))
                         ) ;_ end of if
            obj_adress (if (member "ADRESS" lst)
                         (cdr (assoc 300 (member '(301 . "Адрес узла") obj_lst)))
                         ) ;_ end of if
            obj_scale  (if (member "SCALE" lst)
                         (cdr (assoc 40 (member '(301 . "Scale") obj_lst)))
                         ) ;_ end of if
            obj_lst    (vl-remove-if-not
                         (function
                           (lambda (x / _lst)
                             (setq _lst (entget x))
                             (and (if obj_layer
                                    (= (cdr (assoc 8 _lst)) obj_layer)
                                    t
                                    ) ;_ end of if
                                  (if obj_node
                                    (= (fun_get-node _lst) obj_node)
                                    t
                                    ) ;_ end of if
                                  (if obj_sheet
                                    (= (fun_get-sheet _lst) obj_sheet)
                                    t
                                    ) ;_ end of if
                                  (if obj_adress
                                    (= (fun_get-adress _lst) obj_adress)
                                    t
                                    ) ;_ end of if
                                  (if obj_scale
                                    (= (fun_get-scale _lst) obj_scale)
                                    t
                                    ) ;_ end of if
                                  ) ;_ end of and
                             ) ;_ end of lambda
                           ) ;_ end of function
                         (fun_conv-selset-to-ename selset)
                         ) ;_ end of vl-remove-if-not
            res        (ssadd)
            ) ;_ end of setq
      (foreach item obj_lst
        (setq res (ssadd item res))
        ) ;_ end of foreach
      (sssetfirst res res)
      res
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun

---
Добавлено: чуток фантазии и можно добавить практически все что угодно )

Baldares · 25.11.2008, 23:21

Вау. Алексей благодарствую. Ща буду разбиратся.

Baldares · 25.11.2008, 23:27

Офигенско пашет!

Кулик Алексей aka kpblc · 25.11.2008, 23:46

Offtop: Это радует

Baldares · 26.11.2008, 00:03

Ну Алексей нахимичил.
Расскажи что это:

Код:

[Выделить все]

(setq obj (vl-catch-all-apply
                                (function
                                  (lambda ()
                                    (ssget "_:E:S")
                                    ) ;_ end of lambda
                                  ) ;_ end of function
                                ) ;_ end of vl-catch-all-apply
                          )

(ssget "_:E:S") - ето понятно.
(vl-catch-all-apply (function (lambda () ... - не очень. Типа обработка ошибки, при выборе. Но функция lambda без аргумента. Что происходит?

Код:

[Выделить все]

(type (setq obj (vl-catch-all-apply
                                (function
                                  (lambda ()
                                    (ssget "_:E:S")
                                    ) ;_ end of lambda
                                  ) ;_ end of function
                                ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'pickset

Зачем набор проверять на = pickset ?

Код:

[Выделить все]

obj_lst    (vl-remove-if-not
                         (function
                           (lambda (x / _lst)

Что похожее на предыдущее. Тож не очень понятно.

Код:

[Выделить все]

(sssetfirst res res)
      res

С этой подсветкой какаие-то непонятки. Зачем ей два набора?
И что делает отдельностоящий res?

Можешь смальца пояснить, плиз.

Baldares · 26.11.2008, 00:11

Код:

[Выделить все]

(defun fun_conv-selset-to-ename (selset / tab item)
    (cond
      ((not selset) nil)
      ((= (type selset) 'pickset)
       (repeat (setq tab  nil
                     item (sslength selset)
                     ) ;_ end setq
         (setq tab (cons (ssname selset (setq item (1- item))) tab))
         ) ;_ end repeat
       )
      ((listp selset) selset)
      ) ;_ end of cond
    ) ;_ end of defun

???
Чето слабо соображаю уже.
Надо отложить разбор на завтра.

Baldares · 26.11.2008, 09:20

Вот интересно. В справке написаны эквиваленты функций лиспа и vba.
Для entget - AutoCAD.Application.ActiveDocument.collection_object.property properties
И что это значит.

Кулик Алексей aka kpblc · 26.11.2008, 09:46

Чего-чего?

Baldares · 26.11.2008, 10:10

Цитата:

Сообщение от Кулик Алексей aka kpblc

Чего-чего?

ты про #28
А как это понимать.
Вот в этом разделе справки:
ActiveX and VBA Developer's Guide > Visual LISP and ActiveX/VBA Comparison >

Baldares · 26.11.2008, 10:11

Как определить точку вставки выноски?

Кулик Алексей aka kpblc · 26.11.2008, 10:16

Сейчас убегаю. Вернусь - попробую рассказать #26 И дальше....

Baldares · 26.11.2008, 11:54

У тебя при (spds-node-select-like nil) - выбираются все объекты чертежа.
Добавил строчку:

Код:

[Выделить все]

obj_lst    (vl-remove-if-not
                         (function
                           (lambda (x / _lst)
                             (setq _lst (entget x))
                             (and (= (cdr (assoc 0 _lst)) "spdsNoteKnot")

И еще, сам не знаю как изменить.
Долго обрабатывает весь чертеж, около 5-10 секунд.
Потому что у нас в моделе всего порядка 12000 примитивов, из них порядка 2000 узловых выносок. У меня просто-то вся модель выбирается долго.
Так вот, как бы сразу исключить из набора блоки, и .т.д(см рис.), или прям сразу отфильтровать выноски.
Вот тут:

Код:

[Выделить все]

(setq selset (ssget "_X" (list (assoc 410 (entget obj)))))

А?

Кулик Алексей aka kpblc · 26.11.2008, 12:00

Ненадолго (до первого высказывания после меня) подниму тему.
По поводу #26:

vl-catch-all-apply используется для предотвращения "вылета" программы, если пользователь вдруг нажмет Esc на запрос объекта
Сюда же и

Цитата:

Зачем набор проверять на = pickset ?

Если не будет выбрано ничего, то obj будет nil. А если нажат Esc, то <%catch-error%> (ну или что-то типа того)

Цитата:

Код:

[Выделить все]

obj_lst    (vl-remove-if-not
                         (function
                           (lambda (x / _lst)

Что похожее на предыдущее. Тож не очень понятно.

Из сформированного набора удаляются объекты, не удовлетворяющие указанным условиям.

Цитата:

Зачем ей два набора?

Посмотри справку по sssetfirst.
Цитата:

И что делает отдельностоящий res?

При успешном выполнении функция возвращает сформированный набор. Если этого не надо - удаляй. В конце функции можешь поставить (princ) для "тихого" выхода.
Цитата:

Как определить точку вставки выноски?

По-моему, в lisp-представлении объекта выноски этого нет

Baldares · 26.11.2008, 12:16

Этот значек достал уже.
Как от него избавиться?
Типа автокад чтоль занят. Вроде нет.

Кулик Алексей aka kpblc · 26.11.2008, 12:17

К №33:
1. Да, я как-то упустил фильтрацию по 0 группе. Звиняй.
2. "Прям сразу" отфильтровать выноски не удастся. Как вариант (втупую) - замени строку с назначением selset:

Код:

[Выделить все]

(setq
  selset (ssget
           "_X"
           (list
             (assoc 410 (entget obj))
             (cons -4 "<NOT")
             (cons 0
                   "*LINE,*TEXT,*INSERT,CIRCLE,ARC,ELLI*,DIM*,*IM?G*,AEC_*"
                   ) ;_ end of cons
             (cons -4 "NOT>")
             ) ;_ end of list
           ) ;_ end of ssget
  ) ;_ end of setq

Четко понимаю, что это по идее должно делаться одной строкой, но мозгов на сообразить что-то не хватает

Baldares · 26.11.2008, 13:03

Теперь все ваще нормуль.

Но вот тут я так и не понял

Код:

[Выделить все]

obj_lst    (vl-remove-if-not
                         (function
                           (lambda (x / _lst)
                             (setq _lst (entget x))
                             (and (= (cdr (assoc 0 _lst)) "spdsNoteKnot")
										 	 (if obj_layer
                                    (= (cdr (assoc 8 _lst)) obj_layer)
                                    t
                                    ) ;_ end of if
                                  (if obj_node
                                    (= (fun_get-node _lst) obj_node)
                                    t
                                    ) ;_ end of if
                                  (if obj_sheet
                                    (= (fun_get-sheet _lst) obj_sheet)
                                    t
                                    ) ;_ end of if
                                  (if obj_adress
                                    (= (fun_get-adress _lst) obj_adress)
                                    t
                                    ) ;_ end of if
                                  (if obj_scale
                                    (= (fun_get-scale _lst) obj_scale)
                                    t
                                    ) ;_ end of if
                                  ) ;_ end of and
                             ) ;_ end of lambda
                           ) ;_ end of function
                         (fun_conv-selset-to-ename selset)
                         ) ;_ end of vl-remove-if-not

Смысл понятен, в obj_lst заносим объекты выносок удовлетворяющих условиям.
Но куда формируется набор объектов во время выполнения function? Ведь по ходу перебора объектов из (fun_conv-selset-to-ename selset), obj_lst остается не изменным. И только после окончания function туда заносится ее результат.
Ведь перед (function (lambda ()... - должен стоять apply или mapcar!? Получается что и (vl-remove-if-not может стоять

Насчет (sssetfirst gripset[pickset]).
Первый аргумент не нужен вроде - nill.

Кулик Алексей aka kpblc · 26.11.2008, 13:12

Сейчас acad у меня занят (собака, файл обрабатывает уже больше 20 минут), поэтому пишу "насухую":
что означает (vl-remove-if Бла-бла-бла: из списка obj_lst удалить объекты, если в результате выполнения lamdba вернется t.
Ну, например:
(vl-remove-if (function (lamdba (x) (member x '(1 2 3)))) '(10 20 30 1 20 30 2 30 3))
Можешь поставить точку остановки на слове member и последовательно проверять значения х.
--
sssetfirst: первый набор - выделить ручками. Второй - подсветить пунктиром. Или наоборот, уже не помню.

Baldares · 26.11.2008, 13:51

подвох, lambda=lambda )))
Понятно. Тока жалко не видно пошагового формирования итогового списка, возвращаемого после выполнения (vl-remove-if (function (lamdba (x) (member x '(1 2 3)))) '(10 20 30 1 20 30 2 30 3)).

Цитата:

Как определить точку вставки выноски?

По-моему, в lisp-представлении объекта выноски этого нет

Прям никак никак. Ну очень надо.

Baldares · 26.11.2008, 14:03

Цитата:

Сообщение от Кулик Алексей aka kpblc

Код (как вариант, на лиспе):

Код:

[Выделить все]

(defun spds-node-select-like (lst             /
                              fun_conv-selset-to-ename        fun_get-node
                              fun_get-sheet   fun_get-scale   fun_get-adress
                              obj             obj_layer       obj_node
                              obj_sheet       obj_adress      obj_scale
                              selset          ent             obj_lst
                              res
                              )
                             ;|
*    Выбор "такой же" узловой выноски СПДС GraphiCS по списку критериев.
*    Параметры вызова:
	lst	список вида
	 '("layer"	; наличие слова указывает, что надо учитывать объекты,
	 		; лежащие на таком же слое
	   "node"	; то же, по номеру узла (в терминологии СПДС)
	   "sheet"	; то же, номеру листа
	   "adress"	; то же, адрес
	   "scale"	; фильтровать по масштабу объекта
	   )
*    Формируется набор только по пространству, в котором лежит "определяющий" объект
*    Примеры вызова:
(spds-node-select-like nil)	; выбрать вообще все.
(spds-node-select-like '("layer")) ; выбрать выноски, лежащие на том же
				; слое, что и "родитель"
(spds-node-select-like '("node"))
(spds-node-select-like '("node" "layer"))
|;

  (defun fun_conv-selset-to-ename (selset / tab item)
    (cond
      ((not selset) nil)
      ((= (type selset) 'pickset)
       (repeat (setq tab  nil
                     item (sslength selset)
                     ) ;_ end setq
         (setq tab (cons (ssname selset (setq item (1- item))) tab))
         ) ;_ end repeat
       )
      ((listp selset) selset)
      ) ;_ end of cond
    ) ;_ end of defun

  (defun fun_get-node (ent_lst)
    (cdr (assoc 300 (member '(301 . "Номер узла") ent_lst)))
    ) ;_ end of defun

  (defun fun_get-sheet (ent_lst)
    (cdr (assoc 300 (member '(301 . "Номер листа") ent_lst)))
    ) ;_ end of defun

  (defun fun_get-adress (ent_lst)
    (cdr (assoc 300 (member '(301 . "Адрес узла") ent_lst)))
    ) ;_ end of defun

  (defun fun_get-scale (ent_lst)
    (cdr (assoc 40 (member '(301 . "Scale") ent_lst)))
    ) ;_ end of defun

  (vl-load-com)
  (setq lst (mapcar (function strcase) lst))
  (if (and (= (type (setq obj (vl-catch-all-apply
                                (function
                                  (lambda ()
                                    (ssget "_:E:S")
                                    ) ;_ end of lambda
                                  ) ;_ end of function
                                ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'pickset
              ) ;_ end of =
           (setq obj (ssname obj 0))
           (= (cdr (assoc 0 (entget obj))) "spdsNoteKnot")
           (setq selset (ssget "_X" (list (assoc 410 (entget obj)))))
           ) ;_ end of and
    (progn
      (setq obj_lst    (entget obj)
            obj_layer  (if (member "LAYER" lst)
                         (cdr (assoc 8 obj_lst))
                         ) ;_ end of if
            obj_node   (if (member "NODE" lst)
                         (cdr (assoc 300 (member '(301 . "Номер узла") obj_lst)))
                         ) ;_ end of if
            obj_sheet  (if (member "SHEET" lst)
                         (cdr (assoc 300 (member '(301 . "Номер листа") obj_lst)))
                         ) ;_ end of if
            obj_adress (if (member "ADRESS" lst)
                         (cdr (assoc 300 (member '(301 . "Адрес узла") obj_lst)))
                         ) ;_ end of if
            obj_scale  (if (member "SCALE" lst)
                         (cdr (assoc 40 (member '(301 . "Scale") obj_lst)))
                         ) ;_ end of if
            obj_lst    (vl-remove-if-not
                         (function
                           (lambda (x / _lst)
                             (setq _lst (entget x))
                             (and (if obj_layer
                                    (= (cdr (assoc 8 _lst)) obj_layer)
                                    t
                                    ) ;_ end of if
                                  (if obj_node
                                    (= (fun_get-node _lst) obj_node)
                                    t
                                    ) ;_ end of if
                                  (if obj_sheet
                                    (= (fun_get-sheet _lst) obj_sheet)
                                    t
                                    ) ;_ end of if
                                  (if obj_adress
                                    (= (fun_get-adress _lst) obj_adress)
                                    t
                                    ) ;_ end of if
                                  (if obj_scale
                                    (= (fun_get-scale _lst) obj_scale)
                                    t
                                    ) ;_ end of if
                                  ) ;_ end of and
                             ) ;_ end of lambda
                           ) ;_ end of function
                         (fun_conv-selset-to-ename selset)
                         ) ;_ end of vl-remove-if-not
            res        (ssadd)
            ) ;_ end of setq
      (foreach item obj_lst
        (setq res (ssadd item res))
        ) ;_ end of foreach
      (sssetfirst res res)
      res
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun

---
Добавлено: чуток фантазии и можно добавить практически все что угодно )

Чет у меня фигово с фантазией. А что тут нужно еще добавлять?
Единствено, я эту функцию вызываю из vbaшной формы (как бы это противно не звучало), на которой стоят галки для параметров выбора.

Помоему удобней чем spqs, для заданных параметров. Там их конечно больше (все), но выбирать долго.

зы еще бы суметь определять точки вставки выносок.(

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Копирование данных для спецификаций из выносок СПДС в таблицу из мтекстов	Red Nova	Программирование	177	08.12.2008 11:35

25.11.2008, 13:07
Выбор узловых выносок СПДС (SpdsNoteKnot) по образцу текущей выделенной. Baldares Саратов Регистрация: 17.10.2008 Сообщений: 426 Привет. Вот эта задачка может стать для меня основой для освоения Лиспа. Потомучто на VBA до dxf кодов добираться все равно через него. А еще и гемор по пути схватишь. Прошу накидать пример. Пожалуйста. А я еге изучу ))) Цель. Выделить выноски по образцу выдбранной. Я представляю себе такие действия: 1. Получить верхнюю стороку текущей выбранной выноски. Т.е. предпологается что перед стартом команды - выделена выноска (по которой и нужно будет выделить все выноски на чертеже в model_space, с таким же текстом). 2. Перебрать модель и занести в набор все выноски с таким же текстом. 3. Подсветить набор. Вот что у меня есть пока. - Был бред, удалил. Готовый лисп см. #51 Последний раз редактировалось Baldares, 27.11.2008 в 14:37.
Просмотров: 18779

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