[Red Nova]

Со школы не ладится у меня с программированием. Все предметы щелкал, а на экзамене по информатике (Visual foxpro) программку типа суммирования столбцов списал у соседа (это уже в университете).
Не смотря на эте намерен научится писать программы для Автокада на лиспе, скачал книгу Хювенена, несколько примеров создания программ, но после получасового “смотрения” таких книг мое мышление явно притормаживает.
Решил пойти другим путем.
Нашел самый короткий лисп из моей коллекции, и прошу программистов с этого форума пошагово объяснить какой символ что означает. Надеюсь на вашу помощь.

Код:

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

(defun c:make-blocks-explodeable (/ adoc)
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (vlax-for blk_def (vla-get-blocks adoc)
    (if (and (equal (vla-get-isxref blk_def) :vlax-false)
             (equal (vla-get-islayout blk_def) :vlax-false)
             ) ;_ end of and
      (vl-catch-all-apply '(lambda () (vla-put-explodable blk_def :vlax-true)))
      ) ;_ end of if
    ) ;_ end of vlax-for
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

_____________________________________________________________________________________________________________

Прошло много лет и топик теперь представляет из себя площадку для обучения азов программирования для многих начинающих.
Так что начинающие лиспогрызы приветствуются .

[Alan]

Сообщение от Red Nova Со школы не ладится у меня с программированием. Все предметы щелкал, а на экзамене по информатике (Visual foxpro) программку типа суммирования столбцов списал у соседа (это уже в университете). Не смотря на эте намерен научится писать программы для Автокада на лиспе, скачал книгу Хювенена, несколько примеров создания программ, но после получасового “смотрения” таких книг мое мышление явно притормаживает. Решил пойти другим путем. Нашел самый короткий лисп из моей коллекции, и прошу программистов с этого форума пошагово объяснить какой символ что означает. Надеюсь на вашу помощь. Код: [Выделить все] (defun c:make-blocks-explodeable (/ adoc) (vl-load-com) (vla-startundomark ............ ) ;_ end of defun

Нехилый для разбора код. Я лично не понимаю в нём половину...
Вообще-то с точки зрения портного самая лучшая фигура - это половая щетка. Именно на ней он может показать всё своё искусство.
>Red Nova
Все простые примеры ты уже прошел?
Из того же Хювенена, книги "САПР на базе..." и всё понимаешь?
М.б. у автора этого текста (почерк в принципе заметен ) найдётся время на комментарии.
IMHO
Но тут не комментарии нужны, это просто стиль программирования.

[Red Nova]

Alan,

Из того же Хювенена, книги "САПР на базе..." и всё понимаешь?

Да в том то и дело, что ничего не понимаю.
Прочитал пока 1/3 книги, но и элементарного кода написать не смогу.

Нехилый для разбора код. Я лично не понимаю в нём половину...

Извиняюсь, я выбирал по размеру файла.
Тогда давай так. Если есть время и желание поучить, то выложи пожалуйста простой лисп на твой взгляд, но так, чтобы в нем был выбор объекта (объектов), и работа со свойствами.
И напиши к нему пошаговое пояснение (рассчитанное на полного чайника).

[vic153]

Может быть, попробовать другой учебник. Мне, например, понравился вот этот http://www.williamspublishing.com/Bo...59-0931-7.html
Несмотря на то, что там много ошибок в листингах. Но первые шаги очень даже помогает сделать.

[Кулик Алексей aka kpblc]

Я не силен в объяснениях...

Код:

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

(defun ; Функция определения пользовательской функции (команды)
c:make-blocks-explodeable ; Полное имя пользовательской команды. Наличие c: впереди
  ; дает возможность вызывать с ком.строки как make-blocks-explodeable
( ; Входящие параметры. Их нет
/ ; Разделитель параметров и локальных переменных. После этого символа идут объявления
  ; локальных переменных
 adoc ; Имена локальных переменных
 )
  (vl-load-com) ; Загрузка ActiveX-расширения.
  (vla-startundomark ; Объявление начальной метки для "_.undo"
    (setq ; Назначить
	adoc  ; переменной adoc
	(vla-get-activedocument ; указатель на текущий документ
    	(vlax-get-acad-object) ; текущей сессии AutoCAD
		))
    ) ;_ end of vla-startundomark
  (vlax-for ; Пройти по всей коллекции
    blk_def ; Перечислитель элементов коллекции
	(vla-get-blocks  ; Коллекция блоков
	  adoc ; текущего документа
	  )
	  ;|
	  В данный момент blk_def - указатель на описание очередного блока текущего файла.
	  |;
    (if ; Если
	(and ; И
	(equal ; полностью равно
	  (vla-get-isxref blk_def) ; Перечислитель - внешняя ссылка
	  :vlax-false ; Ложь, т.е. блок не внешняя ссылка
	  )
             (equal (vla-get-islayout blk_def) :vlax-false) ; то же, но пространство листа/модели
			  ; то есть Layout
             ) ;_ end of and
      (vl-catch-all-apply ; Не вызывая ошибки
	  '(lambda () 
	  (vla-put-explodable blk_def :vlax-true) ; Назначить свойство Explodeable (Разбиваемый)
	   ; описанию блока в True (Истина).
	  ))
      ) ;_ end of if
    ) ;_ end of vlax-for
  (vla-endundomark adoc) ; Конечная метка для "_.undo"
  (princ) ; Обеспечивает "тихий" выход.
  ) ;_ end of defun

[Кулик Алексей aka kpblc]

Red Nova, #3: лично я начинал с командных методов. Потом - ent*- и vl*-операции. Сейчас смотрю по ситуации. Иногда ent* выгоднее (entmake, entmakex, entmod, entupd), иногда - activex.

[Red Nova]

vic153,
Она платная, а я в другой стране жтиву. Может есть в общем доступе где?

Кулик Алексей aka kpblc,
Спасибо, попытаюсь из этого слепить что-то свое.

лично я начинал с командных методов.

Стыдно признаться, но я не понимаю что это означает.

[Donhuan]

to Red Nova
Не забрасывай Хювенена. Отличная книга, очень подробно излагает основы Лиспа, а без них в программировании на этом языке никуда. Процентов 80 кода можно использовать и в AutoLisp.

[Red Nova]

Donhuan,
Я просто так ничего не понимаю, там ведь нет примеров для самого автокада. Думаю что мне нужны уроки на самом автокаде.

[Кулик Алексей aka kpblc]

Командные методы: это когда рисование (да и не только оно) выполняется через (command <...>) - то есть прямая передача команд в ком.строку.
Настоятельно рекомендую В.Свет "AutoCAD - язык макрокоманд и создание кнопок" и С.А.Зуев, Н.Н.Полещук (при участии П.В.Лоскутова) "САПР на базе AutoCAD - как это делается). Последнюю книжку надо читать вместе с любым руководством по адаптации AutoCAD'a (например, того же Н.Н.Полещука)

[Alan]

Сообщение от Red Nova Donhuan, Я просто так ничего не понимаю, там ведь нет примеров для самого автокада. Думаю что мне нужны уроки на самом автокаде.

Ты посмотри также для начала тему [FONT=Trebuchet MS]Необходимый минимум знаний[/FONT]

В которой любезный kpblc много чего написал для начала работы с ЛИСП

[Red Nova]

Кулик Алексей aka kpblc,

Настоятельно рекомендую В.Свет "AutoCAD - язык макрокоманд и создание кнопок"

Скачал. Ты меня поправь если я ошибаюсь, но на сколько я понял там не про лисп.

Н.Н.Полещук (при участии П.В.Лоскутова) "САПР на базе AutoCAD - как это делается).

А на эту книгу поиском ссылки не нашел.
Alan,

Ты посмотри также для начала тему Необходимый минимум знаний

Это все я уже знаю, там написано как можно использовать уже готовые коды, а про написание новых - ничего нет.

[Кулик Алексей aka kpblc]

Да, в книге В.Света "не совсем" про Lisp. Но снять панику перед программированием поможет.
"САПР на базе AutoCAD" на ozon'e

[Red Nova]

Но снять панику перед программированием поможет.

валерьянка тоже в этих целях хорошо идет

"САПР на базе AutoCAD" на ozon'e

Честное слово денег не пожалел бы, но я в стране другой живу, и купить и переправить ее не легко. Может есть ссылка для свободного скачивания?

[GlebbI4]

"САПР на базе Autocad" с инета вытягивал (только ж там не Полещук-Лоскутов, а ShaddyDoc в соавторстве с Полещуком).
Если вдруг не найдешь - пиши в ЛС сброшу

[Кулик Алексей aka kpblc]

Общая справка: http://www.ozon.ru/context/help/#1687140
http://www.ozon.ru/context/detail/id/1687460/ - о почтовой доставке.
http://www.ozon.ru/context/detail/id/1540982/ - о курьерской доставке.
Способы оплаты: http://www.ozon.ru/context/detail/id/200890/
Честно скажу, цена на озоне не самая низкая, но как-то попривык я к нему...

GlebbI4, ShaggyDoc и Сергей Александрович Зуев - один и тот же человек. И обрати внимание - я ж написал

С.А.Зуев, Н.Н.Полещук (при участии П.В.Лоскутова)

P.S. Честно говоря, предпочитаю подобные вещи иметь "в твердой" копии.

[GlebbI4]

Сообщение от Кулик Алексей aka kpblc GlebbI4, ShaggyDoc и Сергей Александрович Зуев - один и тот же человек. И обрати внимание - я ж написал .

знаю конечно же. Ориентировался на пост

Н.Н.Полещук (при участии П.В.Лоскутова) "САПР на базе AutoCAD - как это делается).

Сообщение от Кулик Алексей aka kpblc P.S. Честно говоря, предпочитаю подобные вещи иметь "в твердой" копии.

аналогично, издания нового нету, а так бы прикупил в твердом переплете.

[Кулик Алексей aka kpblc]

Судя по ссылке на книгу, она у них (на озоне то бишь) есть...

[Red Nova]

Кулик Алексей aka kpblc, Спасибо за ссылку.
GlebbI4, Пишу в личку.

[Red Nova]

Кулик Алексей aka kpblc,
А может на реальном примере поучишь?
Вот к примеру задумка лиспа с выносками спдс.
Для начало нужно выделить все выноски. Если следовать аналогии с твоим лиспом, то предполагаю что выноски можно выделить так.
(Только не смейся)

(defun c:trans-note (/ adoc) (vl-load-com) (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))) ) ;_ end of vla-startundomark (vlax-for spds_def (vla-get-spdsNotePositions adoc)

[Кулик Алексей aka kpblc]

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

Код:

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

(defun c:get-notes-activex (/ adoc lst)
;; Через ActiveX
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-StartUndoMark
  (vlax-for ent (vla-get-modelspace adoc)
    (if (= (vla-get-objectname ent) "mcsDbObjectNotePosition")
      (setq lst (cons ent lst))
      ) ;_ end of if
    ) ;_ end of vlax-for
  ;; Теперь делай со списком чего хотишь
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

(defun c:get-notes-ent (/ adoc lst _dwgru-conv-pickset-to-list)
;; Через ent*

  (defun _dwgru-conv-pickset-to-list (value / tab item)
    (repeat (setq tab  nil
                  item (sslength value)
                  ) ;_ end setq
      (setq tab (cons (ssname value (setq item (1- item))) tab))
      ) ;_ end repeat
    ) ;_ end defun

  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-StartUndoMark
  (setq lst (vl-remove-if-not
              '(lambda (x) (= (cdr (assoc 0 (entget x))) "spdsNotePosition"))
              (_dwgru-conv-pickset-to-list (ssget "_X"))
              ) ;_ end of vl-remove-if-not
        ) ;_ end of setq
  ;; Теперь делай со списком чего хотишь
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

[Red Nova]

Нам Xref не надо, так что через ent*.
Но давай не торопиться.
Попытаюсь переварить.

(defun _dwgru-conv-pickset-to-list (value / tab item)

Тут понятно, dwgru-conv-pickset-to-list - команда вызова (в скобках)
value - Входящие параметры
tab item - локальные переменные

Потом что-то не понятное...

Потом опять что-то понял

(vl-load-com) (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object)))

(vl-load-com)-Загружаем Active-X
(vla-startundomark - Начальная метка для Undo
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
- Назначить переменной adoc чего-то там

Ну и дальше много разных непонятных букв

Можно разжувать?

[Кулик Алексей aka kpblc]

_dwgru-conv-pickset-to-list - функция, преобразовывающая набор примитивов в список, который уже можно обрабатывать через foreach или mapcar. Там все достаточно просто: определяется длина набора (n), и это количество раз повторяется: добавить в список n-ный элемент набора; n уменьшить на 1.
Строки

Код:

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

(setq lst (vl-remove-if-not
              '(lambda (x) (= (cdr (assoc 0 (entget x))) "spdsNotePosition"))
              (_dwgru-conv-pickset-to-list (ssget "_X"))
              ) ;_ end of vl-remove-if-not
        )

можно перевести так:
переменной lst присвоить список, полученный из набора. Предварительно из списка исключить все элементы, у которых тип (хранится в DXF-коде 0) не равен "spdsNotePosition".

[Red Nova]

А можно медленнее?
Я пытался написать свои предположения, но наверное не стоит, там все равно больше вопросов чем понятного.
Когда будет свободное время напиши пожалуйста пояснение как в посте #5.

[VVA]

Red Nova, Не с того конца подходишь. Для тебя пока vl-* и vla-* функции табу. Задание попроще:
1. Название команды - Колонна
2. Запрашивается у пользователя длина A и ширина B
3. Запрашивается точка вставки Pt
4. Точка вставки Pt считается центром прямоугольника AxB
Пиши команду, рисующую колонну. Как минимум на одни грабли наступишь.

[Alaspher]

VVA прав на 100% - нельзя начинать учиться игре в шахматы по партиям профессионалов (а приведённый Алексеем код - как раз этого уровня). Начинать надо с простейших примеров для начинающих, тем более, что почти все приёмы в них можно отработать не хуже, чем в самых замысловатых экзерсисах, но гораздо нагляднее. Предложенное задание с "колонной" - само то. Причём писать надо так, чтобы потом программу легко было дополнить например запросом и обработкой угла поворота "колонны". Для этого надо чётко разделять блок ввода с контролем корректности ввода, блок вычислений и блок рисования. Все блоки можно (и нужно) оформить в отдельные функции. Причём каждый блок может так же быть разделён на ещё более простые отдельные функции... Кажущаяся простота задачи обманчива. Разница между кодом уровня "лишь бы как-то..." и "качественный рабочий" велика чрезвычайно.

[VVA]

Про поворот колонны как раз было у меня в планах дальше

[Alaspher]

Сорри, что спалил!

[Red Nova]

VVA,

Знаешь ведь, что по любому не сумею.
Ну хоть предположу, что на счет запроса ширины надо начать так, а что дальше, это пока для меня не реально.

Код:

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

(defun C:Колонна (/ newstring)
  (setq newstring (getstring T "Введите ширину колонны <Выход>: "))

И то признаюсь, что скопировал с существующего лиспа
Похоже я пока еще ниже уровнем чем даже ты предположил.

[Shoorup]

Red Nova, я такой же "позорник" который до сих пор лиспом не владеет
Мне вот тоже не помешало бы научиться...но то времени нет то желание пропадает то опять появляется...
Книги у меня есть и не одна а толку мало...

Может нам профессионалы тут будут давать практические задания, а мы попробуем учитьсяна них. Просто по голой книге учиться тяжело... А вот с "репетиторами"... Что скажите?

[Shoorup]

Например давайте попробуем написать программу складывающие 2 числа хранящиеся в однострочном тексте а результат поместить в 3й текст.
Какие функции необходимо использовать для такой программы?
ЗЫ. программу нужно не оптимизированную, а максимально простую для понимания. без vl- vla- vlr и пр.
ЗЗЫ. Также мне кажется не нужно писать нам готовую программу а потом ее разбирать. Нужно только показать куда копать и чем, естественно помагая в ошибках.

[Red Nova]

Shoorup,
У меня в последнее время есть и желание и время, только способностей маловато. По книге и я ничего не понимаю, вот и создал тему, с просьбой мастерам показать примеры на практике.

Давай пока разберем пример от VVA (#25), потом приступим к твоему.

[Shoorup]

Red Nova, была тут похожая тема но там уже не совсем чайника учили. И вообще было кучу тем типа с чего начать и помогите и ляляля

[VVA]

Начало правильное.
Ширина колонны - число (будем считать всегда целое). Поэтому надо запросить не строку (getstring), а число. Найди нужное из ряда get* функций.
Давай переменным будем давать осознанные имена. Newstring как-то не вяжится с шириной и числом вообще

[Shoorup]

подскажите мне по задаче из 31го поста.
Необходимые мне функции:
+ складывать чтобы
atof - для преобразования строки в вещественное число
numberp - для проверки. число выбрано или чтото другое
ssget - для того чтобы получить список.
Что еще забыл? и вообще правильно ли выбрал?

[Red Nova]

VVA,

Найди нужное из ряда get* функций.

А где взять перечень этих функций?

[Shoorup]

Red Nova, Купи книгу Полещука AutoLISP и Visual LISP в среде AutoCAD.

[Shoorup]

Сообщение от VVA Начало правильное. Ширина колонны - число (будем считать всегда целое). Поэтому надо запросить не строку (getstring), а число. Найди нужное из ряда get* функций. Давай переменным будем давать осознанные имена. Newstring как-то не вяжится с шириной и числом вообще

VVA, наверно это getint?или getreal...

[Кулик Алексей aka kpblc]

А также getsrting, getpoint
В дополнение к #33: http://dwg.ru/f/showthread.php?t=5650 и http://dwg.ru/f/showthread.php?t=5887

[Post]

В dnl есть книга Финкельштейн "Autocad библия пользователя", так на диске к этой книге есть дополнительные главы про лисп как раз с такого типа примерами как колонна. Я по ней смог что-то для кружочков с цифрами буквами написать (маркеры осей) и еще такого типа. Дальше, к сожалению, не продвинулся. Там доступно и на примерах объясняют основы... Если в dnl нет диска к книге напишите - я выложу.

[Олег К.]

Влезу, пожалуй, немного в обучение.
По задаче из #31.
1. Как будут выбираться тексты: по одному или оптом? Для этого можно использовать разные функции: ssget, entget.
2. Это уже как более опытные порекомендуют, но начинать следовало бы с функций, оперирующих dxf-кодами объектов (примитивов), пока не лезть во всякие vla- .
3. Попробуйте пока сделать программу без проверок на ошибки, используйте тестовый файл с точно известными и правильными объектами. Потом переходите на работу с другими файлами - по мере наступания на грабли будете узнавать как эти грабли отсекать.

Итак получается: ssget, ssname, entget, assoc, atof, +, rtos, cons, subst, entmod ( или entmake). Кажется даже в порядке следования не ошибся. setq добавлять по вкусу.

Насчет numberp: посмотрите внимательнее на работу функции atof.

[Кулик Алексей aka kpblc]

Сообщение от Shoorup Например давайте попробуем написать программу складывающие 2 числа хранящиеся в однострочном тексте а результат поместить в 3й текст. Какие функции необходимо использовать для такой программы? ЗЫ. программу нужно не оптимизированную, а максимально простую для понимания. без vl- vla- vlr и пр. ЗЗЫ. Также мне кажется не нужно писать нам готовую программу а потом ее разбирать. Нужно только показать куда копать и чем, естественно помагая в ошибках.

Из вредности:

Код:

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

(defun c:summtext (/ ent1 ent2 res)
  (if (and (setq ent1 (car (entsel "\nУкажи первый однострочник : ")))
           (setq ent2 (car (entsel "\nУкажи второй однострочник : ")))
           ) ;_ end of and
    (progn
      (setq res (+ (atof (cdr (assoc 1 (entget ent1))))
                   (atof (cdr (assoc 1 (entget ent2))))
                   ) ;_ end of +
            ) ;_ end of setq
      (princ (rtos res 2 4))
      ) ;_ end of progn
    ) ;_ end of if
  (princ)
  ) ;_ end of defun

И вариант немного посложнее для понимания

Код:

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

(defun c:summtext2 (/ ent1 ent2)
  (princ
    (if
      (and (setq ent1 (car (entsel "\nУкажи первый однострочник : ")))
           (setq ent2 (car (entsel "\nУкажи второй однострочник : ")))
           ) ;_ end of and
       (strcat
         "\nSumm = "
         (rtos (apply
                 '+
                 (mapcar '(lambda (x) (atof (cdr (assoc 1 (entget x)))))
                         (list ent1 ent2)
                         ) ;_ end of mapcar
                 ) ;_ end of apply
               2
               4
               ) ;_ end of rtos
         ) ;_ end of strcat
       (strcat "\nNothing")
       ) ;_ end of if
    ) ;_ end of princ
  (princ)
  ) ;_ end of defun

P.S. Код без проверок и отлова ошибок.

[ShaggyDoc]

Дохлый номер - пытаться научиться на форуме, да еще в одной ветке. Научиться-то на форуме можно, но путем самостоятельного изучения литературы, справки и анализа публикуемых на форуме программ. Только хороших (например, от VVA). К тому же набегут другие со своими задачками. Кому сумму сделать, а кому и профиль одной кнопкой построить. Кто выяснять "кто здесь главный" и т.п. Будет "пожар в публичном доме во время наводнения".

Азбуку "побуквенно" разъяснять некому и некогда. Надо учиться работать. Поместил LISP в редактор VLIDE, выделил имя функции, нажал Ctrl-F1 и видишь справку по этой функции. Смотри, изучай аргументы, результаты, и как это использовано в разбираемой программе.

Очень хорошее учебное пособие поставляется прямо с AutoCAD - в папке Tutorial\Visual LISP. Семь уроков - от самого простого до самого сложного. И всё разжевано в справке - раздел AutoLISP Tutorial. Эта справка есть и в русском варианте, kpblc её выкладывал где-то здесь.

И делать свою программу, поначалу не разбрасываясь на другие.

Колонна - очень хороший пример. Для развития.

Сначала просто спросить размеры, направление и нарисовать прямоугольник. Потом догадаться, что размеры не обязательно каждый раз вводить, а можно по умолчанию предлагать. Потом выбор из типовых сочетаний. Потом не просто прямоугольник, а с решеткой, из уголков, из двутавров. Потом в 3D. И так до упора. А по ходу совершенствования этой программы можно научиться делать и сотни других.

Разбить на логические блоки - начало, ввод, контроль данных, черчение, завершение.

Не умеешь делать "хитрые" функции и не можешь пока понять, как они работают? Не страшно. Научись просто использовать готовые, например из библиотеки DwgRuLispLib

И всё получится!

[Shoorup]

Кулик Алексей aka kpblc, спасибо но хотелось эту програмулю самому написать - уж больно простая... Лучше напиши мне прогу по теме с коэффициентом сжатия

[Red Nova]

Люди добрые, подскажите где взять перечень функций лисп, весь Хювенен прошелся (Т1) там только Get, никаких подвариантов.
(Но только так чтобы было в свободном скачивании.)

[Кулик Алексей aka kpblc]

Red Nova, vlide -> F1. Там все (ну или почти все )
Shoorup, веришь - элементарно некогда Догадываюсь, что там надо многострочники переформатировать (снимать \W), но мозги сейчас другим забиты

[Red Nova]

ShaggyDoc,

Очень хорошее учебное пособие поставляется прямо с AutoCAD - в папке Tutorial\Visual LISP. Семь уроков - от самого простого до самого сложного. И всё разжевано в справке - раздел AutoLISP Tutorial. Эта справка есть и в русском варианте, kpblc её выкладывал где-то здесь.

У меня таких папок нет (AutoCAD2008, 2009), дал поиск, файлы тоже не нашел.

[Shoorup]

ну хоть подскажи может я сам смогу ее сделать... не думаю что она ну очень сложная.
Например мне нужно при выборе текста однострочного получить ее коэффициент сжатия. Как это сделать?

[Red Nova]

А что такое Vlide?

[Red Nova]

ShaggyDoc,
Нашел. Это теперь тут
AutoCAD 2009\Help
файлы acad_alg.chm, acad_alr.chm, acad_alt.chm
Почитаю

[VVA]

http://lisp.narod.ru/l1.html
http://aco.ifmo.ru/~nadinet/html/alisp.phtml в частности
http://aco.ifmo.ru/~nadinet/html/lectures/lect_lsp.html и
Глава4
http://www.ssga.ru/metodich/autocad/contents.html - ГЛАВА 12
FAQ по LISP писалось для версий Автокада 12-13, но на 95% справедливо и по сей день

[Alaspher]

Сообщение от Shoorup при выборе текста однострочного получить ее коэффициент сжатия. Как это сделать?

DXF группа 41
(cdr (assoc 41 (entget <имя примитива>)))

Сообщение от Red Nova А что такое Vlide?

Если в комстроке набрать vlide, то откроется встроенный в Автокад редактор, в котором и надо работать с исходиками АвтоЛИСП.

[Кулик Алексей aka kpblc]

Это не форум, это филиал чата местного значения

Сообщение от Red Nova ShaggyDoc, У меня таких папок нет (AutoCAD2008, 2009), дал поиск, файлы тоже не нашел.

Код:

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

c:\Program Files\AutoCAD 2008\Tutorial\VisualLISP\

Сообщение от Shoorup ну хоть подскажи может я сам смогу ее сделать... не думаю что она ну очень сложная. Например мне нужно при выборе текста однострочного получить ее коэффициент сжатия. Как это сделать?

См.DXF Reference, объект TEXT: 41-я группа. Также в DwgRuLispLib - Модификация ename-представлений примитивов У тебя проблема будет не в модификации примитива, а в вычислении. Там не отрезки, а полилинии. Дополнительная аналитика.

Сообщение от Red Nova А что такое Vlide?

Visual Lisp Integrated Developmet Environment (вроде так расшифровывается): интегрированная среда разработки Visual Lisp. Также команда в AutoCAD.
---
Мать моя... Сколько написали, пока я о телефону общался...

[VVA]

Сообщение от ShaggyDoc "пожар в публичном доме во время наводнения".

[Shoorup]

короче мне такое не осилить... может ктонить сможет мне всетаки помочь с прогой с коэффициентом - я ее сам буду год писать

[Red Nova]

VVA, Продолжим пример с колонной. Я нашел в хелпе весь список функций. От туда

Getreal - Pauses for user input of a real number, and returns that real number

Так что она нам и нужна.

Итак.

Код:

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

 (defun C:Колонна (/ columnwidth)
  (setq columnwidth (getreal T "Введите ширину колонны <Выход>: "))

А дальше опять торможу.
К стати, а зачем после getreal ставить “T”?

[Alaspher]

Сообщение от Red Nova К стати, а зачем после getreal ставить “T”?

Не надо при вызове getreal ставить T - работать не будет, это для getstring, чтоб пробелы можно было разрешить или запретить. Для задания размеров колонны в мм (которые не должны быть дробными) можно использовать и другую функцию. Дальше надо запросить следующие значения, которые идут по логике программы.

[Кулик Алексей aka kpblc]

А еще лучше, наверное - в данном конкретном случае - сразу запрашивать прямоугольник )

[Red Nova]

Далее надо задать вторую переменную, полагаю что так.

Код:

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

(defun C:Колонна (/ width thickness)
  (setq width (getreal "Введите ширину колонны <Выход>: "))
  (setq thickness (getreal "Введите толщину колонны <Выход>: "))

[Кулик Алексей aka kpblc]

А если захочется вводить не с клавиатуры, а с экрана?

[Red Nova]

Кулик Алексей aka kpblc, Ну ты хотя бы намеки давай какого типа функцию искать. Это же для меня планета Марс.

[Shoorup]

А почему у меня не получается такой код?

Код:

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

(cdr (assoc 41(entget (entsel))))

[Кулик Алексей aka kpblc]

Red Nova, см. (getcorner)
Shoorup, еще раз внимательно посмотри, что возвращает (entsel).

[VVA]

Red Nova,
Хорошо. Пока будем считать, что пользователь вводит нужные нам данные с клавиатуры.
В ответ на запрос
(setq width (getreal "Введите ширину колонны <Выход>: "))
пользователь может ввести:
1. Пустой ввод (клавиша Enter)
2. 0
3. Положительное число
4. Отрицательное число
Мы должны запретить вводить ему п. №№ 1;2;4. Т.е. только полижительные числа.
Подсказка: см. ф-цию initget

[Shoorup]

Кулик Алексей aka kpblc, entsel выдает имя выбранного объекта и координаты точки которые я указал на этом объекте. Получается мне мешают эти координаты?
т.е мне нужно сделать так

Код:

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

(car(entsel))

[Shoorup]

Получилось!!!
надо так:

Код:

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

(cdr (assoc 41(entget(car(entsel)))))

Теперь хочется внести изменения в однострочный текст в точечную пару. Как?

[Red Nova]

VVA, Из справки

initget Establishes keywords for use by the next user-input function call bits A bit-coded integer that allows or disallows certain types of user input. The bits can be added together in any combination to form a value between 0 and 255. If no bits argument is supplied, zero (no conditions) is assumed. The bit values are as follows: 1 (bit 0) Prevents the user from responding to the request by entering only ENTER. 2 (bit 1) Prevents the user from responding to the request by entering zero. 4 (bit 2) Prevents the user from responding to the request by entering a negative value. 8 (bit 3) Allows the user to enter a point outside the current drawing limits. This condition applies to the next user-input function even if the AutoCAD system variable LIMCHECK is currently set.

Следовательно нам нужно значение 1+2+4=7
То есть где-то мы должны написать

Код:

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

(initget 7)

Но где не пойму.

[VVA]

Red Nova, #67
1. Initget действует на 1 запрос get* (getint, getreal и т.п. в helpe есть табличка)
2. Вытекает из п.1 перед каждым getreal.
Запусти эти 2 строчки в VLIDE на выполнение и попробуй ввести что-нибудь недопустимое (кроме ESC)

[Red Nova]

VVA,
Тогда наверное лисп должен выглядеть так

Код:

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

(defun C:Колонна (/ width thickness)
  (setq width ((initget 7) (getreal "Введите ширину колонны <Выход>: ")))
  (setq thickness ((initget 7) (getreal "Введите толщину колонны <Выход>: ")))

Подозреваю что в вопросе скобок я могу ошибиться.

Запусти эти 2 строчки в VLIDE на выполнение и попробуй ввести что-нибудь недопустимое (кроме ESC)

Вот что получилось, наверное это хороший знак

Введите ширину колонны <Выход>: -100 Value must be positive and nonzero.

[VVA]

Так

Код:

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

(defun C:Колонна (/ width thickness)
  (initget 7)
  (setq width (getreal "Введите ширину колонны <Выход>: "))
  (initget 7)
  (setq thickness (getreal "Введите толщину колонны <Выход>: "))
  ;... Здесь будет продолжение
  )

Теперь у тебя есть команда Колонна, которая запрашивает размеры.
Дальше нужно запросить точку отрисовки и отрисовать колонну

[ShaggyDoc]

Молодец, Red Nova. Вопросы всё более разумные.

Совет: Сделай VLIDE своим постоянным инструментом. Может быть даже кнопочкой.

Создай в редакторе пустой файл и вставляй в него фрагменты кода. Сохрани файл в папочку, созданную в "подходящем месте" под именем, например, "эксперименты.lsp". В дальнейшем все свои Лиспы сохраняй во всякие подпапки этой папки.

Выделенные фрагменты кода из "экспериментов" отправляй на выполнение в AutoCAD кнопочкой "загрузить выделенный фрагмент". В окно "Консоль" будут возвращаться результаты. Их можно выделить и скопировать в окно программы и спрятать за комментариями. Чтоб наглядно видеть результат.

Для начала можно и код более наглядно писать. Например, вводить переменные:

Так пишет профи:

Код:

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

 
(cdr (assoc 41(entget(car(entsel)))))

А можно:

Код:

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

 
(if (setq результат_выбора (entsel "Выбери примитив:"))
(progn
(setq имя_примитива (car результат_выбора))
(print имя_примитива)
(setq данные_примитива (entget имя_примитива))
(print данные_примитива)
;;; И так далее
)
)

Потом, когда появится внутреннее понимание, такой код нужно оптимизировать - убрать все лишнее.

Успехов!

[Shoorup]

Сообщение от ShaggyDoc ...Так пишет профи: Код: [Выделить все] (cdr (assoc 41(entget(car(entsel)))))

Да ну брось ты я еще только начинаю

[Red Nova]

VVA,
Думаю как-то так

Код:

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

(defun C:Колонна (/ width thickness base)
  (initget 7)
  (setq width (getreal "Введите ширину колонны <Выход>: "))
  (initget 7)
  (setq thickness (getreal "Введите толщину колонны <Выход>: "))
(setq base (getpoint "Введите точку вставки колонны <Выход>: ")) 
  ;продолжение
)

Далее надо начать строить полилинию вокруг этой точки, пока этого я не могу, пороюсь в лиспах...

ShaggyDoc,
Постараюсь работать с VLIDE, хотя пока совсем не понял что там к чему.

Так пишет профи: Код: (cdr (assoc 41(entget(car(entsel))))) А можно: Код: (if (setq результат_выбора (entsel "Выбери примитив:")) (progn (setq имя_примитива (car результат_выбора)) (print имя_примитива) (setq данные_примитива (entget имя_примитива)) (print данные_примитива) ;;; И так далее ) ) Потом, когда появится внутреннее понимание, такой код нужно оптимизировать - убрать все лишнее.

Пока не понимаю не того не другого (правда хелп не смотрел). Но надеюсь это вопрос времени.

[ShaggyDoc]

А вообще-то надо начинать не с кодирования, а с постановки задачи. То есть с составления "плана". Его можно сразу писать в иде комментариев, а потом постепенно реализовывать. Грамотная постановка - половина дела.

Например, для колонны сразу надо решать:

1. Одна ли это колонна, или целый ряд (одна как частный случай)? Как потом одну размножать, если ряд под каким-то углом?

2. Что это за точка вставки по отношению к самой колонне? Центр? Но центр не всегда известен, может быть и колонна с нулевой привязкой к оси. Тогда центр придется как-то еще вычислять.

3. Что это за "ширина" и "толщина"? У колонны есть два размера, но их надо как-то правильно назвать. Например "размер вдоль ряда", "размер поперек ряда".

и т.д.

Пиши сначала постановку, пусть примитивно. Например:

Код:

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

 
 
;; 1. Запрос продольного размера с возможностью выхода
;; 2. Если размер введен, запрос второго размера без возможности прерывания, иначе выход из программы.
;; 3. В цикле, до пустого ввода, запрос точки центра колонны
 
;; если точка указана, переход к 4, иначе выход из программы.
 
;; 4. Запрос направления ряда в виде запроса точки с привязкой от заданной центральной точки
 
;; 5. рисование одной колонны

И т.д. В том числе с возможностью задать количество колонн и пролет.

[Red Nova]

ShaggyDoc,
Ну этому тоже надо еще поучиться.
Получается три из пяти пунктов уже реализованы.

[Shoorup]

Сообщение от Red Nova Пока не понимаю не того не другого (правда хелп не смотрел). Но надеюсь это вопрос времени.

(cdr (assoc 41(entget(car(entsel)))))

Да тут особо понимать то нечего... готовый код гораздо проще разобрать что и зачем нежели самому написать... во всяком случае мне...
Ну попробую обьяснить что называется "от чайника чайнику"
1. Нужна книга Полещука которая упоминалась выше. Там по каждой функции мало того что можно почитать но и увидеть вполне толковый пример.
2. Лично я разбираю с внутренних функций, т.е. то что будет выполняться первым.
А первым будет выполняться (entsel). Как я писал выше этим мы получим уникальное имя и координаты туда где ткнули при выборе текста.
Для профилактики вводи в комстроке по функционально и смотри что возвращает функция.
(entget(car(entsel)))
тут entget выведет нам все "свойства" выбранного объекта, но в качестве аргумента ему нужно имя выбранного объекта. А так как у нас (entsel) дает по мимо имени еще и координаты (которые мешают - слишком много аргументов)то их можно "отсечь" вот так: (car(entsel)) - тоже попробуй ввести с carи без и посмотри что возвращается.
assoc 41эта функция вытянет нам необходимое свойство в виде точечной пары - в данном случае коэффициент сжатия.
(assoc 41(entget(car(entsel)))) - вводишь это и тебе вернется (41 . 0.8) например - это точечная пара, про точечные пары читай Полещука там все очень понятно.
Ну а так как нам нужно лишь получить коэфициент сжатия то нужно "отсечь" то что впереди. Делаем это с помощью cdr в итоге получим 0.8
Вот и всё! проще некуда Но лично я "досямкал" только с подачи Алексея так что по сути я разобрался только в том что мне написали

[Shoorup]

Сообщение от Кулик Алексей aka kpblc Из вредности: Код: [Выделить все] (defun c:summtext (/ ent1 ent2 res) (if (and (setq ent1 (car (entsel "\nУкажи первый однострочник : "))) (setq ent2 (car (entsel "\nУкажи второй однострочник : "))) ) ;_ end of and (progn (setq res (+ (atof (cdr (assoc 1 (entget ent1)))) (atof (cdr (assoc 1 (entget ent2)))) ) ;_ end of + ) ;_ end of setq (princ (rtos res 2 4)) ) ;_ end of progn ) ;_ end of if (princ) ) ;_ end of defun

Алексей, все понятно кроме одной строчки: (princ (rtos res 2 4))
Поясни пожалуйста чайнику

[Donhuan]

rtos - конвертирует число в строку
res - число
2 - режим ("десятичный")
4 - точность (число знаков после запятой)

[Кулик Алексей aka kpblc]

В дополнение к #74: раскрою "секрет", как я пишу свои лиспы. Сначала defun и придуманное имя функции. Потом в комментарии прописываю, что функция делает, какие параметры принимает, что возвращает. А там уже и код можно делать. В любой момент возвращаюсь в начало файла и смотрю - а то ли я делаю?

[Shoorup]

Кулик Алексей aka kpblc, ShaggyDoc, VVA, а пользуетесь ли вы блок схемами при написании программ на лиспе?

[Кулик Алексей aka kpblc]

Я - не пользуюсь.

[ShaggyDoc]

Зачем блок-схемы? Это для первоклассников - чтоб на доске рисовать. Места много, толку мало. И не все выразишь. Алексей правильно делает - заготовка пустой функции, план в комментариях, потом реализация.

Получается три из пяти пунктов уже реализованы.

Ничего не реализовано. Читать надо внимательно. На первом этапе важен контроль ввода, обработка ситуаций нажатия ESC, пустого ввода. Да еще и надо предотвращение ошибок делать. Это можно оставить на усовершенствование, но забывать нельзя.

[Кулик Алексей aka kpblc]

Позволю себе высказаться о последовательности разработки "сложения значений из 2 или более однострочных текстов или атрибутов":
1. Разработать или спереть функцию отлова ошибок (_ru-error-catch, _dwgru-error-catch)
2. Разработать или спереть функцию безошибочного указания примитива, возможно, с контролем возвращаемого типа. Сделать универсальной (т.е. дать возможность использовать и nentsel, при необходимости).
3. Решить раз и навсегда - функция будет обрабатывать 2 примитива? Или их надо указывать набором? В зависимости от этого будет немного меняться решение.
4. После п.3 написать часть получения текстовой строки (однострочного текста / атрибута) и перевода его в числовое значение. Ну и сложить. Сделать результат вычисления возвращаемым значением.
5. Написать общую функцию, которая загрузит все служебные функции и покажет результат.
5.1. Если результат надо выводить в однострочный текст, то потребуется функция создания однострочного текста. Подробности - самостоятельно (слишком много нюансов).
5.2. Если результат выводить в ком.строку или в alert - то все просто, но и это надо учитывать
---
6. Решить вопрос с предоставлением функции сторонним пользователям. Да и про себя, любимого, тоже забывать не след Возможно, разработать меню.
===
"Зачем так сложно!?" Затем, что функция безошибочного указания примитива, скорее всего, понадобится еще не одну сотню раз. И функция отлова ошибок.
Короче, "САПР на базе" в руки и вперед

[Red Nova]

ShaggyDoc,

Ничего не реализовано. Читать надо внимательно. На первом этапе важен контроль ввода, обработка ситуаций нажатия ESC, пустого ввода. Да еще и надо предотвращение ошибок делать. Это можно оставить на усовершенствование, но забывать нельзя.

Ну дай сперва хотя бы что-то самое простое разработать, а это все пока для меня слишком.
Пока мне хотелось бы понять как задачку от VVA дописать в самом простом виде. Полистал я хелп и лиспики разные тоже, но пока не понял какие функции надо использовать, чтобы построить полилинию по координатам относительно центра вставки.
Shoorup,

Да тут особо понимать то нечего... готовый код гораздо проще разобрать что и зачем нежели самому написать... во всяком случае мне... Ну попробую объяснить что называется "от чайника чайнику"

Спасибо, я имел ввиду что не все эти функции пока знаю.

[Олег К.]

>> Red Nova
Постройка полилинии по координатам:
- команда _.PLINE ;
- функция entmake ;
- vla-функции.
Выбирай.

[Кулик Алексей aka kpblc]

Red Nova, а ты как собираешься эту полилинию строить? Командой? entmake? vla?
Сильно подозреваю, что командой Поэтому - сначала получаешь центр, потом вычисление точек, потом не забыть osmode, команда _.pline, передать параметры, вернуть обратно osmode. Простейшая функция готова.
Переменные перевести в локальные обязательно! Потом можешь посмотреть на *error* и почти универсальный обработчик ошибок.
---
Не, это точно чат!

[Red Nova]

Олег К.,
Мне VVA пока запретил vla-функции .
Про команду _.PLINE не очень понял, разве в программу аутолисп можно вписать обычную команду?
Остается функция entmake. Почитаю про нее.

[Red Nova]

Кулик Алексей aka kpblc,

Red Nova, а ты как собираешься эту полилинию строить? Командой? entmake? vla? Сильно подозреваю, что командой Поэтому - сначала получаешь центр, потом вычисление точек, потом не забыть osmode, команда _.pline, передать параметры, вернуть обратно osmode. Простейшая функция готова. Переменные перевести в локальные обязательно! Потом можешь посмотреть на *error* и почти универсальный обработчик ошибок.

Напиши пожалуйста список функций, которые надо для этого применять, чтобы знать где копать.

[Кулик Алексей aka kpblc]

getpoint, getdist (для указания ширины и высоты), getvar, setvar, command
Для вычисления точек пока используй напрямую setq и результат подставляй в command.
Как вариант, без учета поворота:

Код:

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

(defun red:command (/               center          osmode
                    width           height          low_left_point
                    low_right_point up_right_point  up_left_point
                    )
  (if (and (setq center (getpoint "\nЦентр колонны "))
           (setq width (getdist "\nШирина сечения колонны "))
           (setq height (getdist "\nВысота сечения колонны "))
           ) ;_ end of and
    (progn
      (setq osmode          (getvar "osmode")
            low_left_point  (list (- (car center) (* width 0.5))
                                  (- (cadr center) (* height 0.5))
                                  ) ;_ end of list
            low_right_point (list (+ (car low_left_point) width)
                                  (cadr low_left_point)
                                  ) ;_ end of list
            up_right_point  (list (car low_right_point)
                                  (+ (cadr low_right_point) height)
                                  ) ;_ end of list
            up_left_point   (list (- (car up_right_point) width)
                                  (cadr up_right_point)
                                  ) ;_ end of list
            ) ;_ end of setq
      (setvar "osmode" 0)
      (command "_.pline"          low_left_point     low_right_point
               up_right_point     up_left_point      "_c"
               ) ;_ end of command
      (setvar "osmode" osmode)
      ) ;_ end of progn
    ) ;_ end of if
  (princ)
  ) ;_ end of defun

[Red Nova]

Кулик Алексей aka kpblc, Если честно, ты мне обломал урок, Не буду смотреть пока твой код, я ведь хочу сам. Притворюсь, что ты ничего не выкладывал.

getpoint, getdist (для указания ширины и высоты), getvar, setvar, command

А вот это посмотрю.

[Кулик Алексей aka kpblc]

Код сделал прежде всего для анализа

[VVA]

Red Nova, Продолжим. Сейчас мы имеем такой код

Код:

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

(defun C:Колонна (/ width thickness base)
  (initget 7)
  (setq width (getreal "Введите ширину колонны <Выход>: "))
  (initget 7)
  (setq thickness (getreal "Введите толщину колонны <Выход>: "))
(setq base (getpoint "Введите точку вставки колонны <Выход>: ")) 
  ;продолжение
)

и
1. Мы не знаем vla-* функций (не можем обработать ESC)
2. Мы даже пока не знаем, что такое dxf коды (А ведь не знаем, правда?) Поэтому до того как

Остается функция entmake. Почитаю про нее.

нужно разобраться что такое dxf коды.
Остается пока

Про команду _.PLINE не очень понял, разве в программу аутолисп можно вписать обычную команду?

Можно! И именно так пока будем строить колонну.
Пару критических замечаний по существующему коду:
1. Мы ф-цией (initget 7) запрещаем пустой ввод. Поэтому здесь
"Введите ширину колонны <Выход>: " - <выход> не уместен.
А вот в getpointe мы пустой ввод не запрещаем, запрещать не будем, а выход заменим на 0,0.
Т.е. задача такая:
В случае нажатия ENTER на запрос getpoint присвоить переменной base точку с координатами 0,0

[ShaggyDoc]

Анализ показал, что колонна всегда будет смотреть в одну сторону.

...разве в программу аутолисп можно вписать обычную команду

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

Попробуйте-ка что-нибудь нарисовать на другом языке высокого уровня, и даже на LISP, но вне Автокада.

[Red Nova]

VVA,
Ты хороший педагог.

. Мы даже пока не знаем, что такое dxf коды (А ведь не знаем, правда?)

Само собой не знаем.

Т.е. задача такая: В случае нажатия ENTER на запрос getpoint присвоить переменной base точку с координатами 0,0

В программе построения графиков от по внешнему файлу Кулик Алексей aka kpblc, нашел функцию cond
Из справки

Cond As shown, cond can be used as a case type function. It is common to use T as the last (default) test expression. Here's another simple example. Given a user response string in the variable s, this function tests the response and returns 1 if it is Y or y, 0 if it is N or n; otherwise nil. (cond ((= s "Y") 1) ((= s "y") 1) ((= s "N") 0) ((= s "n") 0) (t nil) )

Думаю это означает, что Cond нам и нужен.
Думаю надо так

Код:

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

(cond
(getpoint "\Введите точку вставки колонны <0,0,0> :")
(t '(0. 0. 0.)))

То есть, учитывая еще твои замечания, а так же рекомендации от ShaggyDoc, лисп будет такой.

Код:

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

(defun C:Колонна (/ dimensionX dimensionY base)
(initget 7)
(setq dimensionX (getreal "Введите ширину колонны: "))
(initget 7)
(setq dimensionY (getreal "Введите толщину колонны: "))
(setq base 
            (cond
(getpoint "\Введите точку вставки колонны <0,0,0> :")
(t '(0. 0. 0.)))
) 
  ;продолжение
)

[Alaspher]

если использовать cond, то надо немного подкорректировать:

Код:

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

(setq base 
            (cond
((getpoint "\Введите точку вставки колонны <0,0,0> :"))
(t '(0. 0. 0.)))
)

[Red Nova]

А в чем смысл сдвоенной скобки?
И зачем тут

(0. 0. 0.)

после последнего нуля ставят точку?

[Alaspher]

Функция cond обрабатывает аргументы, как списки. Если список, возвращает nil, переходит к следующему спску, если возвращено не nil, то полученное значение возвращается без обработки следующий списков. Список обрабатывается следующим образом - вычисляется первый элемент списка, если он не nil, то вычисляются все последующие элементы списка, последний вычисленный элемент возвращается. В случае:

Код:

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

(getpoint "\Введите точку вставки колонны <0,0,0> :")

первый элемент getpoint - он невычисляем и будет ошибка, в случае:

Код:

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

((getpoint "\Введите точку вставки колонны <0,0,0> :"))

первый элемент: (getpoint "\Введите точку вставки колонны <0,0,0> :") - его результат и будет возвращён (поскольку других нет).

[ShaggyDoc]

Все-таки советую больше внимания уделить продумыванию алгоритма. Например, само рисование колонны. Вроде бы прямоугольник. Но из чего? Можно из отрезков, а можно полилинией. Можно и залитый, а можно и прозрачный. У колонны могут еще и свои "осики" быть. Двухветвевой она может быть или сплошной.

Приведу пример, как колонны в ruCAD рисуются в 2D. Сначала выбор из иллюстрированного меню (прилагаю скриншот). Там сразу выбирается типоразмер и вид колонны. Не обязательно самому именно такое меню делать, можно и просто в AutoCAD-овское встроить.

А вот протокол работы после выбора типа:

AutoCAD спрашивает:

Пролет=6000, Количество=1. Точка начала ряда [Пролет/Количество]<Выход>:К

То есть можем нарисовать и одну, и целый ряд с заданным пролетом. Можем сразу указать точку, а можем выбрать опции Пролет или Количество или просто нажать Enter и закончить работу.

Допустим, ввели опцию К (можно из автоматически сформированного контекстного меню, можно с клавиатуры).

Тогда спросит:
Количество [Указать]<1>:5

После ввода количества возобновляется допрос:

Пролет=6000, Количество=5. Точка начала ряда [Пролет/Количество]<Выход>:

Укажем точку. Тогда вопрос:

Направление ряда:

Здесь надо указать точку. После того рисуется целый ряд колонн (см. рис), и снова вопросы:

Пролет=6000, Количество=5. Точка начала ряда [Пролет/Количество]<Выход>:

То есть можно и еще несколько рядов указать. Или сделать пустой ввод и закончить программу.

Вот это как бы постановка задачи - что надо получить и как должно работать. Разумеется, могут быть и другие варианты.

А вот и программирование:

Всего одна строчка, вписываемая в меню.

Код:

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

 
(ru-draw-column "common\\ru-lib-column" "ru_column_2" 500 1000))

Всё делает одна функция, которой передаются аргументы, в частности размеры колонны.

Такой вызов легко модернизирует любая "тетка". Меняй 500 и 1000 на другие значения и будешь иметь кучу "команд".

Если же надо сплошную колонну 600х600, вызов немного другой:

Код:

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

 
(ru-draw-column "common\\ru-lib-column" "ru_column_1" 600 600))

И здесь возможны множество вариантов. Вся хитрость только в знании аргументов функции. И, разумеется, в обеспечении загрузки какой-то библиотеки, где эта функция определена. Но и для программирования мы также должны позаботиться о загрузке "кое-чего" стандартного. Например, (vl-load-com) сделать.

И вообще это совсем не обязательно для колонн, а для чего угодно подходит, где надо любое изображение с заданными габаритными размерами нарисовать сколько-то раз с заданным шагом. Картошку, например, рассадить.

Само же кодирование дело более техническое. Конечно, там нужны и знания и мастерство, но это всё-таки труд для "Microservs". Хорошую постановку задачи потом легче и реализовать в коде.

[Red Nova]

ShaggyDoc,

Все-таки советую больше внимания уделить продумыванию алгоритма

Ты прав конечно же, VVA как раз по ходу дела и постановку задачи раскрывает, а-то я сразу не понял бы что к чему. Поэтапно понятнее.

[Red Nova]

VVA
Почитал немного про command
Из хелпа

The following example sets two variables pt1 and pt2 equal to two point values 1,1 and 1,5. It then uses the command function to issue the LINE command in the Command Reference and pass the two point values. Command: (setq pt1 '(1 1) pt2 '(1 5)) (1 5) Command: (command "line" pt1 pt2 "") line From point: To point: To point: Command: nil

Но прежде чем строить полилинию надо определить точки. Для этого надо ввести переменные pt1 pt2 pt3 pt4. Затем дать им значения, которые в математическом виде выглядят так:
Х pt1 =Х base – (dimensionX/2)
Y pt1 =Y base – (dimensionY/2)
И так далее для всех точек.
Теперь попробую это представить как лисп выражение

Код:

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

( setq pt1
            ( list ( 
                     ( - ( car base ) ( : dimensionX  2 ) )
                     ( - (cadr base ) ( : dimensionY  2 ) )
                   )
            )
 )

Ну и по тому же принципу для остальных точек.
Затем

Код:

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

 (command "pline" pt1 pt2 pt3 pt4)

Я прав?

[Олег К.]

знак деления только другой
и скобка одна лишняя после list

[VVA]

Ты с cond разобрался? Еще можно было использовать оператор if
По поводу точек. В общем все правильно, за исключением ошибок, на которые указал Олег К.,
Мой вопрос красным

Код:

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

  ( setq pt1
            ( list ( ;<= Что ты имел ввиду ставя эту скобку
                     ( - ( car base ) (/ dimensionX  2 ) )
                     ( - (cadr base ) (/ dimensionY  2 ) )
                   ) ;<= Что ты имел ввиду ставя эту скобку
            )
 )

*** Вдогонку
Здесь нужно учитывать особенности лисп при приведении типов
Выполни у себя в редакторе и сделай выводы

Код:

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

(/ 1 2)
(/ 1 2.0)

[Red Nova]

VVA,
Про вопрос красным.
Я ошибочно полагал, что содержимое List должно находится в скобках.

Выполни у себя в редакторе и сделай выводы Код: (/ 1 2) (/ 1 2.0)

Пока не понял. В редакторе на первое ответ 0, на второе 0,5. Почему так происходит не понимаю. Может все цифры надо записывать с десятичными? Но в таком случае почему 1 не записывается как 1,0

[VVA]

Здесь я дал задание. Оно относится и к тебе. Внимательно почитай про функции.
"Красный" вопрос пока остается. Почитай (с разбором каждой главы в vlide) и попробуй еще раз ответить.
По поводу (/ 1 2) и (/ 1 2.0) - здесь вопрос приведения типов.
1. Если ЦЕЛОЕ делится (умножается) на ЦЕЛОЕ, то получается ЦЕЛОЕ (целое от 0.5 - 0)
2. Если ЦЕЛОЕ делится (умножается) на ВЕЩЕСТВЕННОЕ, то получается ВЕЩЕСТВЕННОЕ (это то, которое real)
Это я к тому, что в этом месте

Код:

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

(/ dimensionX  2 )

программист (то есть ты) должен быть абсолютно уверен, что dimensionX всегда должно быть вещественным (real). В данном случае так и есть. См.

Код:

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

(setq dimensionX (getreal "Введите ширину колонны: "))

Но если ты не уверен, то можно явно привести к типу REAL

Код:

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

(/ dimensionX  2.0 )
(* dimensionX  0.5 )
(/ dimensionX  2 1.0 )

Те же куриные продукты, только сбоку.

[Shoorup]

С делением и я разобрался а с этими чертовыми списками чтото туплю...

[ShaggyDoc]

И вообще для колонн размер надо задавать сразу REAL. Мало ли что чаще всего они выражаются в целом количестве миллиметров. А если понадобится работать в единицах "метры"? Если на плане сетей надо будет колонну поставить? Да и вводить данные удобнее - можно getdist использовать.

[Олег К.]

>> Shoorup
Выполни в редакторе вот такие выражения:
(list ((* 5 2) (/ 8 4)))
(list (* 5 2) (/ 8 4))
(list '(* 5 2) '(/ 8 4))
и посмотри чем отличаются результаты.
При вычислениях лучше перебдеть (ведь пока нет отлова ошибок?) и делать явно задаваемые числа вещественными.
Не помню, говорили ли здесь, в vlisp'e есть хорошие возможности проверки кода на ошибки. Самые простые на панельке "Tools" (в стандартном виде - третья слева во второй строке). На код из #100 точно бы 2 раза ругнулся.

[andery]

Добрый день, полезная тема, тоже как раз начал изучать лисп.
Прделагаю начать с самого простого а потом усложнять.
А то для начинающих сложно освоить все сразу.
Давайте вернемся к простой задаче

Сообщение от VVA Red Nova, Не с того конца подходишь. Для тебя пока vl-* и vla-* функции табу. Задание попроще: 1. Название команды - Колонна 2. Запрашивается у пользователя длина A и ширина B 3. Запрашивается точка вставки Pt 4. Точка вставки Pt считается центром прямоугольника AxB Пиши команду, рисующую колонну. Как минимум на одни грабли наступишь.

Вот мое решение:

Код:

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

(defun c:колонна (/ a b p x1 y1 x2 y2)

	(setq a (getreal"\nВведите ширину колонны:"))
	(setq b (getreal"\nВведите высоту колонны:"))
	(setq p (getpoint"\nУкажите центр колоны:"))
	(setq x1 (- (car p) (/ a 2))) 
	(setq y1 (- (car (cdr p)) (/ b 2)))
	(setq x2 (+ (car p) (/ a 2)))
	(setq y2 (+ (car (cdr p)) (/ b 2)))
	(command "._pline"
		(list x1 y1)
		(list x1 y2)
		(list x2 y2)
		(list X2 y1)
		"_close"
	)
)

Понимаю что можна было - бы обойтись без переменных х1,х2,у1,у2 - но для начала можна и использовать.
Теперь можна усложнять.
Постепенно.

[VVA]

Нужно подождать пока Red Nova и Co подтянуться. А тебе пока нужно
1. На запрос ширины и длинны запретить пустой ввод,ввод отрицательных чисел и 0
2. На запрос точки на ввод по умолчанию принять координату 0,0,0.

[andery]

Сообщение от VVA Нужно подождать пока Red Nova и Co подтянуться. А тебе пока нужно 1. На запрос ширины и длинны запретить пустой ввод,ввод отрицательных чисел и 0 2. На запрос точки на ввод по умолчанию принять координату 0,0,0.

Может криво, но вроде работает
+заментил getreal на getdist, чтоб ширину и высоту можна было на экране указать, нормально будет?

Код:

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

(defun c:колонна (/ a b x1 y1 x2 y2)
	(initget (+ 1 2 4))
	(setq a (getdist"\nВведите ширину колонны:"))
	(initget (+ 1 2 4))
	(setq b (getdist"\nВведите высоту колонны:"))
	(setq p (getpoint "\nУкажите центр колоны:<по умолчанию (0,0)>"))
	(if (= p nil) (setq p (quote (0 0 0)))
	)
	(setq x1 (- (car p) (/ a 2))) 
	(setq y1 (- (car (cdr p)) (/ b 2)))
	(setq x2 (+ (car p) (/ a 2)))
	(setq y2 (+ (car (cdr p)) (/ b 2)))
	(command "._pline"
		(list x1 y1)
		(list x1 y2)
		(list x2 y2)
		(list X2 y1)
		"_close"
	)
)

[VVA]

andery, Нормально.
Для проверки на пусто (nil) есть функция null
т.е.
(if (= p nil) ... можно еще записать как (if (null p) ...
Ну и еще наиболее частые связки car и cdr уже есть ввиде отдельных функций
(car (cdr p)) = (cadr p)
Читать нужно с конца: к списку p применить cdr потом car
(cADDARr p ) = (cAr (cDr (cDr (cAr p))))

Код:

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

(caddar '((1 2 3)(4 5 6))) ;_Вернет 3

А так весьма неплохо.
Теперь давай запросим угол поворота и повернем колонну относительно точки P на этот угол.
PS P не объявлена в локальных переменных

[Олег К.]

Выполняется указание точек в чертеже. Наверное, в функции initget стоит использовать и bit 8.

VVA, вопрос.
Если использовать (if (null (setq p (getpoint "\nУкажите центр колоны:<по умолчанию (0,0)>"))) (setq p '(0 0 0)))
всегда ли в условии при пустом вводе будет nil? Что-то сомнения иногда бывают.

[Red Nova]

VVA И так на данный момент код у меня такой

Код:

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

(defun C:Колонна (/ dimensionX dimensionY base)
(initget 7)
(setq dimensionX (getreal "Введите ширину колонны: "))
(initget 7)
(setq dimensionY (getreal "Введите толщину колонны: "))
(setq base 
    (cond
         (getpoint "\Введите точку вставки колонны <0,0,0> :")
         (t '(0. 0. 0.)))
     ) 
(setq pt1
     ( list ( - ( car base ) ( / dimensionX  2.0 ) )
            ( - (cadr base ) ( / dimensionY  2.0 ) )
     )
)
(setq pt2
     ( list ( - ( car base ) ( / dimensionX  2.0 ) )
            ( + (cadr base ) ( / dimensionY  2.0 ) )
     )
)
(setq pt3
     ( list ( + ( car base ) ( / dimensionX  2.0 ) )
            ( + (cadr base ) ( / dimensionY  2.0 ) )
     )
)
(setq pt4
     ( list ( + ( car base ) ( / dimensionX  2.0 ) )
            ( - (cadr base ) ( / dimensionY  2.0 ) )
     )
)
(command "pline" pt1 pt2 pt3 pt4)
  ;продолжение
)

Можешь давать очередное задание но колонне. Хювенена буду изучать по ходу дела. А-то остальным долго ждать.
Про вопрос красным я понял. Про реальные и вещественные вроде тоже.

P.S. А учеников у тебя все больше.

------------------------
Опоздал, уже дал задание про поворот.
Про P не понял.

PS P не объявлена в локальных переменных

Это значит ввести переменную P или не вводить ее?

[Red Nova]

Ну повернуть можно командой rotate, а как выбрать то что мы будем крутить не знаю. Поищу в книгах.

[VVA]

Олег К., Не вижу причин чтобы не работала. Хотя я предпочитаю такие конструкции (для меня нагляднее)

Код:

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

(or
  (setq p (getpoint "\nУкажите центр колоны:<по умолчанию (0,0)>"))
  (setq p '(0 0 0))
  )

[VVA]

Red Nova, У тебя код не рабочий. Читай замечания Олег К. #101,
Локальные переменные описываются после слэша при определении функции. Выделил корасным

Код:

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

(defun C:Колонна (/ dimensionX dimensionY base)

Время их жизни ограничено временем жизни (исполнения) функции. Если переменная используется в коде, но не объявлена как локальная - то она становится глобальной, время ее жизни - пока открыт документ в Автокаде
Кстати проверить значение переменной можно, набрав в командной строке Автокада ! (восклицательный знак) и имя. Если загрузить команду Колонна, то

Команда: !c:колонна #<USUBR @120c2294 C:КОЛОННА>

Демонстрация локальной и глобальной переменной
В команде TEST2 переменная rez не объявлена локальной

Код:

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

(defun C:TEST1 ( / A B rez )
  (initget 7)
  (setq a (getreal "\nПервое число A: "))
  (initget 7)
  (setq b (getreal "\nВторое число B: "))
  (setq rez (+ A B))
  (princ "\nСумма A + B = ")(princ rez)
  (princ)
  )

(defun C:TEST2 ( / A B)
  (initget 7)
  (setq a (getreal "\nПервое число A: "))
  (initget 7)
  (setq b (getreal "\nВторое число B: "))
  (setq rez (+ A B))
  (princ "\nСумма A + B = ")(princ rez)
  (princ)
  )

1. Загружаем команды
2. Выполняем TEST1
3. Набираем в командной строке !rez
4. Выполняем TEST2
5. Набираем в командной строке !rez
6. Смотрим на разницу и делаем выводы

Команда: test1 Первое число A: 1 Второе число B: 3 Сумма A + B = 4.0 Команда: Команда: !rez nil Команда: test2 Первое число A: 1 Второе число B: 3 Сумма A + B = 4.0 Команда: Команда: !rez 4.0

[VVA]

как выбрать то что мы будем крутить не знаю

А как бы ты выбрал последний отрисованный элемент в команде _Rotate при условии, что нельзя пользоваться мышкой?

[Red Nova]

Red Nova, У тебя код не рабочий. Читай замечания Олег К. #101,

Ой тьфю, забыл совсем. Исправил.

А как бы ты выбрал последний отрисованный элемент в команде _Rotate при условии, что нельзя пользоваться мышкой?

набрал бы P в ком строке. Так пойдет?
----------------------
Пробую в автокаде, рисую что-то, потом команда rotate, затем ввожу p, результата нет.

[andery]

Да я тож застрял на Ротате.
Мне не понятен синтаксис вызова команды
Например
(command "_rotate _L
или
(command "_rotate "_L"
где об этом почитать можна
прочитал что _L последний нарисованный обьект....
Подскажите в каом русле двигаться....

[VVA]

Мы ее (колонны) только что отрисовали и ни одна команда редактирования с ней не работала. Предыдущего (текущего, последнего) набора нет. Так что P (Previous), он же текущий-предыдущий-последний не пойдет. Штудируйте командную строку.

[andery]

(command "_rotate" "_L") работает и выделяет

[VVA]

ПРАВИЛО

1. В функциях command использовать АНГЛИЙСКИЕ команды с ПОДЧЕРКИВАНИЕМ Пример: (command "_PLINE" ...)
2. Для ссылок на ОПЦИИ команд использовать АНГЛИЙСКИЕ с ПОДЧЕРКИВАНИЕМ Пример: (command "_-LAYER" "_Make" ...)
3. Подробнее читаем тут вначале

[VVA]

andery,
При передаче параметров ф-ции command нужно соблюдать последовательность запросов вызванной команды, причем

1. Оции задаются как строки (в кавычках "") с учетом #122
2. Если нужно нажать клавишу ENTER, то пишем пустые кавычки ""
3. если нужно подождать действия пользователя, то пишем pause

[VVA]

Сообщение от andery (command "_rotate" "_L") работает и выделяет

Ручками что ты дальше делаешь? Нажимаешь или ENTER или ПКМ. Так и скажи об этом command'у чтобы он нажал тоже

[Олег К.]

>> VVA. Offtop: Может заодно про точку и дефис в командах объяснить. Или потом дать задание колонну заштриховать?

[andery]

Запутался в этой конструкции
(command "_rotate" "_L" "" "(car p),(cadr p)")
)
как ни пробывал никак не получается

[VVA]

andery,
1. getpoint у тебя что запрашивает? - ТОЧКУ
2. В какую переменную ты ее запоминаешь? - в P
Если у тебя в переменной P находится ТОЧКА и _rotate запрашивает "Базовая ТОЧКУ" какого ляда вы занимаетесь мазохизмом?

Код:

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

(command "_rotate" "_L" "" p)

ТОЧКА в Автокаде это список в общем случае их 3-x (для 2d можно из 2-x) чисел, где 1-e трактуется как X, 2-e как Y и 3-e как Z
(setq p (list 1 2 3)) - точка с X=1 Y=2 Z=3
(setq p '(5 3 0)) - точка с координатами X=5 Y=3 Z=0

(command "_Rotate" "_L" "" '(2 3)) - начнет поворачивать последний отрисованный объект относительно точки X=2 Y=3
ТО же самое
(setq p (list 2 3))
(command "_Rotate" "_L" "" p)

[Олег К.]

Offtop: удалил, больше мешать не буду.

[VVA]

Ты совсем не мешаешь. Не могу же я один всех учить. Тем более скоро возьму оставшуюся часть отпуска

[Post]

Red Nova
Вот те примеры и текст, что обещал

[Post]

Вторая часть

[Post]

И последняя, саму книгу можно взять в DOWNLOAD

[andery]

Cпасибо, получилось, в результате код получился такой:

Код:

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

(defun c:колонна (/ a b x1 y1 x2 y2)
	(initget (+ 1 2 4))
	(setq a (getdist"\nВведите ширину колонны:"))
	(initget (+ 1 2 4))
	(setq b (getdist"\nВведите высоту колонны:"))
	(setq p (getpoint "\nУкажите центр колоны:<по умолчанию (0,0)>"))
	(if (null p) (setq p (quote (0 0 0)))
	)
	(setq x1 (- (car p) (/ a 2))) 
	(setq y1 (- (car (cdr p)) (/ b 2)))
	(setq x2 (+ (car p) (/ a 2)))
	(setq y2 (+ (car (cdr p)) (/ b 2)))
	(command "._pline"
		(list x1 y1)
		(list x1 y2)
		(list x2 y2)
		(list X2 y1)
		"_close"
	(command "_rotate" "_L" "" p pause)
	)
)

[VVA]

andery, Молодца. Quote и ' равнозначны (а набирать быстрее)
(setq p (quote (0 0 0)) = (setq p '(0 0 0))
Усложним задачу.
1. Рисуем колонну
2. В центре колонны рисеум круг радиусом=ширине колонны
3. Поворачиваем колонну

PS По прежнему переменная P у тебя глобальная

[Red Nova]

VVA, Извиняюсь за отсутствие, дома телефон зарубили, а инет на нем.
Наверстываем упущенное.
Итак командой _L можно выбрать только что созданный объект (к стати а что означает L?)
Попытаюсь без подглядывания.
Пока не учитывая #134

Код:

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

(defun C:Колонна (/ dimensionX dimensionY base)
(initget 7)
(setq dimensionX (getreal "Введите ширину колонны: "))
(initget 7)
(setq dimensionY (getreal "Введите толщину колонны: "))
(setq base 
    (cond
         (getpoint "\Введите точку вставки колонны <0,0,0> :")
         (t '(0. 0. 0.)))
     ) 
(setq pt1
     ( list ( - ( car base ) ( / dimensionX  2.0 ) )
            ( - (cadr base ) ( / dimensionY  2.0 ) )
     )
)
(setq pt2
     ( list ( - ( car base ) ( / dimensionX  2.0 ) )
            ( + (cadr base ) ( / dimensionY  2.0 ) )
     )
)
(setq pt3
     ( list ( + ( car base ) ( / dimensionX  2.0 ) )
            ( + (cadr base ) ( / dimensionY  2.0 ) )
     )
)
(setq pt4
     ( list ( + ( car base ) ( / dimensionX  2.0 ) )
            ( - (cadr base ) ( / dimensionY  2.0 ) )
     )
)
(command "_pline" pt1 pt2 pt3 pt4 "_c")
(command "_rotate" "_L" "" base)
  
;продолжение
)

Post, Спасибо, пока еще не успел посмотреть, но уже скачал.

[Red Nova]

VVA,

1. Рисуем колонну 2. В центре колонны рисеум круг радиусом=ширине колонны 3. Поворачиваем колонну

В такой последовательности не смогу. Пока могу выбрать только объект созданный последним. В такой последовательности это не колонна а круг.
Но могу так. (сперва добавив локальную переменную R)

Код:

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

(Setq  R  ( / dimensionX  2.0 ))
(command "_circle" R)
(command "_pline" pt1 pt2 pt3 pt4 "_c")
(command "_rotate" "_L" "" base)

[VVA]

Red Nova,

(к стати а что означает L?

Command: _move Select objects: I_don't_know_as *Invalid selection* Expects a point or Window/Last/Crossing/BOX/ALL/Fence/WPolygon/CPolygon/Group/Add/Remove/Multiple/P revious/Undo/AUto/SIngle

С учетом п.2 #122 получаем _L

[VVA]

В такой последовательности не смогу. Пока могу выбрать только объект созданный последним. В такой последовательности это не колонна а круг.

Я специально так и задал. Наша задача научится другим способом запоминать необходимые для дальнейшего использования примитивы и ссылаться на них в command.
Подсказка: entlast

[Red Nova]

Почитал хелп, не скажу что понял, но вроде как можно присвоить переменной обозначение только что введенного объекта.
Может так? (предварительно объявив локальную переменную object)

Код:

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

(Setq  R  ( / dimensionX  2.0 ))
(command "_pline" pt1 pt2 pt3 pt4 "_c")
(Setq object (entlast))
(command "_circle" R)
(command "_rotate" object "" base)

P.S. А есть перечень команд аутолисп с пояснением на русском. Я хоть с инглишем в ладах, но все же хелп лучше иметь не русском.

[VVA]

Может так?

А проверить?
У тебя rotate не завершена. Нужно ввести или угол или подождать действия пользователя п.3 #123

[Кулик Алексей aka kpblc]

Н.Н.Полещук - любая книга по AutoLISP и VisualLISP.

[Red Nova]

VVA
Проверку не прошел. Загрузил такой лисп

Код:

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

(defun C:Колонна (/ dimensionX dimensionY base R object)
(initget 7)
(setq dimensionX (getreal "Введите ширину колонны: "))
(initget 7)
(setq dimensionY (getreal "Введите толщину колонны: "))
(setq base 
    (cond
         (getpoint "\Введите точку вставки колонны <0,0,0> :")
         (t '(0. 0. 0.)))
     ) 
(setq pt1
     ( list ( - ( car base ) ( / dimensionX  2.0 ) )
            ( - (cadr base ) ( / dimensionY  2.0 ) )
     )
)
(setq pt2
     ( list ( - ( car base ) ( / dimensionX  2.0 ) )
            ( + (cadr base ) ( / dimensionY  2.0 ) )
     )
)
(setq pt3
     ( list ( + ( car base ) ( / dimensionX  2.0 ) )
            ( + (cadr base ) ( / dimensionY  2.0 ) )
     )
)
(setq pt4
     ( list ( + ( car base ) ( / dimensionX  2.0 ) )
            ( - (cadr base ) ( / dimensionY  2.0 ) )
     )
)
(Setq  R  ( / dimensionX  2.0 ))
(command "_pline" pt1 pt2 pt3 pt4 "_c")
(Setq object (entlast))
(command "_circle" R)
(command "_rotate" object "" base pause)
;продолжение
)

Результат

Command: КОЛОННА Введите ширину колонны: 200 Введите толщину колонны: 200 ; error: bad argument type: consp "Введите точку вставки колонны <0,0,0> :" Command:

[Red Nova]

Кулик Алексей aka kpblc,
Ты про

САПР на базе AutoCAD - как это делается

?

[Кулик Алексей aka kpblc]

Нет, я про Visual LISP и секреты адаптации AutoCAD и AutoLISP и Visual LISP в среде AutoCAD (+ CD-ROM)

[VVA]

Сообщение от Red Nova P.S. А есть перечень команд аутолисп с пояснением на русском. Я хоть с инглишем в ладах, но все же хелп лучше иметь не русском.

А #51 я для кого выкладывал?
2-я ссылка сверху. Скачать все. Оттуда можно попасть сюда:
entlast в главе 5

[Олег К.]

>> Red Nova
А скобки кто проверять будет? У тебя же в COND два условия используются, так почему второе в скобках, а первое без?

Код:

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

(setq base 
    (cond
         ((getpoint "\Введите точку вставки колонны <0,0,0> :"))
         (t '(0. 0. 0.))
    )
)

И сразу учись правильно расставлять скобки: если "(" и соответствующая ей ")" расположены на разных строках, то должны быть строго друг под другом - самому же потом легче разбираться будет.

>> VVA
Все ждал когда ученики сообразят с выделением колонны, наверное уже можно отвечать?
Пока нашел только три способа: командой создать именованный набор, использовать ssget с несколькими фильтрами, запомнить имя функцией entlast.
Entlast'ом проще и надежнее, но с ssget'ом тоже интересно повозиться.
Получилось такое: (ssget "W" (list (- x1 1) (- y1 1)) (list (+ x3 1) (+ y3 1)) '((0 . "lwpolyline")))
но это только для данного случая и предварительно отключив привязки.

PS: самому иногда интересно решить поставленные задачи, можно узнать что-нибудь новое.

[Red Nova]

VVA,
Проглядел.
От туда

5. 3. 2.(entlast) Эта функция возвращает имя последнего неудаленного главного примитива в базе данных. Эта функция часто применяется , чтобы дать имя новому примитиву, который только что был прибавлен через функцию COMMAND. Примитив не нужно выводить на экран, и также не нужно выбирать уровень.

Но я все равно не понемаю что я делаю не так.

[VVA]

Проверку не прошел. Загрузил такой лисп

На лиспе из #142 будем учиться искать ошибки.
Делаем следующее

1. Набираем в командной строке VLIDE. (Открывается Visual LISP редактор)
2. File->New File (открывается новый файл). В него копируем код из #142
3. Если он сохранен как lsp файл, то File->Open
4. Меню Debug (Отладка)->Stop once (Останов) Должна остаться птичка
5. Дальше Tools (Сервис) -> Load text in editor (Загрузить текст в редактор) (или Ctrl+Alt+E)
6. Возвращаемся в Автокад. Набираем в командной строке Колонна
7. После этого автоматом вернемся в Visual LISP редактор. Текст будет подсвечен синим.
8. После этого открываем окно контрольных значений (там можно смотреть состояние переменных) Меню View (Вид)->Watch window (Окно контрольных значений) или Ctrl+Shift+W. Должно открыться окно Watch с значением *LAST-VALUE* В нем будут отражаться последние вычисленные значения
9. Меню Debug (Отладка)->Step into (Шаг с заходом) или F8
10. Пошагово выполняя код ищем ошибку и исправляем ее.

[VVA]

Red Nova, Там же открываешь Главу 4 и смотришь как правильно писать cond

[ShaggyDoc]

В процесс обучения не вмешиваюсь, но

Пока нашел только три способа: командой создать именованный набор, использовать ssget с несколькими фильтрами, запомнить имя функцией entlast. Entlast'ом проще и надежнее, но с ssget'ом тоже интересно повозиться. Получилось такое: (ssget "W" (list (- x1 1) (- y1 1)) (list (+ x3 1) (+ y3 1)) '((0 . "lwpolyline"))) но это только для данного случая и предварительно отключив привязки.

Когда все рисование нескольких примитивов выполняется твоей программой, то самое надежное - до рисования создать пустой набор, а потом, при каждом добавлении примитива, добавлять в него последний через (entlast).

При неконтролируемом рисовании можно до него запомнить последний примитив в переменной через (entlast) а потом использовать функцию наподобие

Код:

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

 
(defun ru-ss-select-after-ent (ent_name / selection)
  (setq selection (ssadd))
  (while (and ent_name (setq ent_name (entnext ent_name)))
    (ssadd ent_name selection)
  ) ;_ end of while
  (if (zerop (sslength selection))
    nil
    selection
  ) 
)

Например где-то в программе:

Код:

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

 
(setq ent (entlast))
;;;Что-то долго рисуем
(setq ss (ru-ss-select-after-ent ent))
;;; теперь что-то делаем с этим набором

Использование выбора рамкой ненадежно. Тут глюк в том, что все, входящее в рамку, должно быть видимым. Да и отсеивать всякую нечисть надо. Там ведь может и всяких левых lwpolyline полно оказаться.

[Олег К.]

ShaggyDoc, не скромничайте, Ваши замечания всегда полезны начинающим (и не только).
Кажется, я малость ошибся, в первом случае имелись в виду группы (command "group"), постоянно путаю их с наборами (ssget). Нечто вот такое:

Код:

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

Command: l LINE Specify first point:
Specify next point or [Undo]:
Specify next point or [Undo]:
Command: -group
Enter a group option [?/Order/Add/Remove/Explode/REName/Selectable/Create] <Create>: c
Enter a group name or [?]: 12
Enter a group description:
Select objects: (entlast)
<Entity name: 7ef6c6e0>
1 found
Select objects:
Command:

А Вы заодно показали четвертый способ, хотя они в общем-то похожи.
Про выбор рамкой я не зря сказал "только для данного случая", когда на чертеже только квадрат полилинией и круг. Сам всегда долго думаю как составить фильтр, чтобы отсеять все ненужное.

[Red Nova]

Олег К.,
Внес твою поправку. Ты и раньше говорил, а я забыл...
VVA,
По поводу отслеживания ошибок, спасибо за пояснения. Принцип ясен. Но понять почему радиус не принимается равным переменной R это не помогло. Я исправил cond, но как уже сказал с радиусом неполадка. А квадрат рисуется нормально.

Код:

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

(defun C:Колонна (/ dimensionX dimensionY base R object)
(initget 7)
(setq dimensionX (getreal "Введите ширину колонны: "))
(initget 7)
(setq dimensionY (getreal "Введите толщину колонны: "))
(setq base 
    (cond
         ((getpoint "\Введите точку вставки колонны <0,0,0> :"))
         (t '(0. 0. 0.)))
     ) 
(setq pt1
     ( list ( - ( car base ) ( / dimensionX  2.0 ) )
            ( - (cadr base ) ( / dimensionY  2.0 ) )
     )
)
(setq pt2
     ( list ( - ( car base ) ( / dimensionX  2.0 ) )
            ( + (cadr base ) ( / dimensionY  2.0 ) )
     )
)
(setq pt3
     ( list ( + ( car base ) ( / dimensionX  2.0 ) )
            ( + (cadr base ) ( / dimensionY  2.0 ) )
     )
)
(setq pt4
     ( list ( + ( car base ) ( / dimensionX  2.0 ) )
            ( - (cadr base ) ( / dimensionY  2.0 ) )
     )
)
(Setq  R  ( / dimensionX  2.0 ))
(command "_pline" pt1 pt2 pt3 pt4 "_c")
(Setq object (entlast))
(command "_circle" base "" R "")
(command "_rotate" object "" base pause)
;продолжение
)

P.S. А с entlast я правлиьно делаю?

[Кулик Алексей aka kpblc]

А osmode кто отслеживать будет?

[Red Nova]

Кулик Алексей aka kpblc,

А osmode кто отслеживать будет?

Ну пока наверное тебя попрошу за мена отслеживать А вот как объяснишь как это делать, то уже я буду.

[Кулик Алексей aka kpblc]

http://www.caduser.ru/cgi-bin/f1/board.cgi?t=43426Wu

[Олег К.]

Red Nova, это из командной строки:

Код:

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

Command: ci CIRCLE
Specify center point for circle or [3P/2P/Ttr (tan tan radius)]: 0,0,0
Specify radius of circle or [Diameter] <96.20>: 20
Command:

а теперь смотрим, что у тебя в программе написано и думаем (или хотя бы сравниваем)

[Red Nova]

Кулик Алексей aka kpblc,
Может там и описывается нужная операция, но слова osmode там нету, я пока в ауте. Что вообще означает отследить osmode?
Олег К., Неа, не понимаю.

[Олег К.]

Ну ладно, тогда по буквам:
(command "_circle" base "" R "")
1. сначала говорим какую команду используем ["_circle"], это равнозначно Command: ci CIRCLE
2. далее нужно указать точку центра или выбрать опцию [base] = Specify center point for circle or [3P/2P/Ttr (tan tan radius)]: 0,0,0
3. потом следует ввести радиус [Specify radius of circle or [Diameter] <96.20>: 20], а у нас в программе зачем-то пустой ввод [""]
4-5. все, запросы команды закончились, а мы задаем еще R и "".
Энтер или пробел нужно нажимать только если вводишь данные с клавиатуры. При программном вводе подтверждение ввода совсем не нужно.

В рабочем варианте: (command "_circle" base R).
Еще есть такая функция vl-cmdf, почитай о ней, посмотри чем отличается от command.

[Vova]

По-моему, при такой интенсивности обучения у RED Nova не остается времени на домашнюю аналитическую работу. Он бы и сам допер до некоторых вещей, что было-бы более ценно. Предложение такое: класс по программированию работает, например, по пятницам. Или дважды в неделю. И все-учителя и ученики - ждали бы с нетерпением

[Кулик Алексей aka kpblc]

Red Nova, а я зря дал ссылку в #155, что ли? Пост Alan'a прочти.

[Red Nova]

Олег К.,
Теперь понял. А я все пытался enter всунуть.
Наконец заработало.

Код:

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

 (defun C:Колонна (/ dimensionX dimensionY base R object)
(initget 7)
(setq dimensionX (getreal "Введите ширину колонны: "))
(initget 7)
(setq dimensionY (getreal "Введите толщину колонны: "))
(setq base 
    (cond
         ((getpoint "\Введите точку вставки колонны <0,0,0> :"))
         (t '(0. 0. 0.)))
     ) 
(setq pt1
     ( list ( - ( car base ) ( / dimensionX  2.0 ) )
            ( - (cadr base ) ( / dimensionY  2.0 ) )
     )
)
(setq pt2
     ( list ( - ( car base ) ( / dimensionX  2.0 ) )
            ( + (cadr base ) ( / dimensionY  2.0 ) )
     )
)
(setq pt3
     ( list ( + ( car base ) ( / dimensionX  2.0 ) )
            ( + (cadr base ) ( / dimensionY  2.0 ) )
     )
)
(setq pt4
     ( list ( + ( car base ) ( / dimensionX  2.0 ) )
            ( - (cadr base ) ( / dimensionY  2.0 ) )
     )
)
(Setq  R  ( / dimensionX  2.0 ))
(command "_pline" pt1 pt2 pt3 pt4 "_c")
(Setq object (entlast))
(command "_circle" base R)
(command "_rotate" object "" base pause)
;продолжение
)

Еще есть такая функция vl-cmdf,

Я пока функций начинающихся на vl боюсь.

Vova,

Он бы и сам допер до некоторых вещей, что было-бы более ценно.

Сильно льстишь. Не допер бы.

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

(defun с:cсс (/ tl) ;;; запомнили ;;; и так для всех изменяемых (setq tl (getvar "CELTYPE")) ;;; Назначили тип (setvar "CELTYPE" "bylayer") ;;; делаем что-то............ (vl-cmdf "_pline") ;;; делаем что-то............ ;;; вернули (setvar "CELTYPE" tl) ) ;_ конец defun

В чем связь между Osmode и Celtype?

[Red Nova]

Пора усложнить лисп. Научится вводить размеры колонны с экрана, Запоминать значение введенное последним. Дайте список функций, которые нужно для этого изучить. Постараюсь сам навоять.

[Кулик Алексей aka kpblc]

> #161 : лично я стараюсь не давать русских наименований ни переменным, ни функциям. Возможно, это тянется еще с VB3.0 и его ограничений.
Вся разница между (command) и (vl-cmdf) в том, что (command) всегда возвращает nil (независимо ни от чего), а vl-cmdf при успешном (или корректном) завершении команды вернет T. Это утверждение гарантированно работает только для полного AutoCAD, для LT и IntelliCAD'a это уже не факт.

Вот сообщение от Alan Цитата: (defun с:cсс (/ tl) ;;; запомнили ;;; и так для всех изменяемых (setq tl (getvar "CELTYPE")) ;;; Назначили тип (setvar "CELTYPE" "bylayer") ;;; делаем что-то............ (vl-cmdf "_pline") ;;; делаем что-то............ ;;; вернули (setvar "CELTYPE" tl) ) ;_ конец defun В чем связь между Osmode и Celtype?

А в том, что и osmode, и celtype есть системные переменные. Посмотри еще раз на код Alan'a, там же все написано:

Код:

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

(defun с:cсс (/ tl)
;;; запомнили
;;; и так для всех изменяемых
(setq tl (getvar "CELTYPE"))
;;; Назначили <...>
(setvar <...>)
;;; делаем что-то............
;;; вернули
(setvar <...>)
) ;_ конец defun

То есть - сначала запоминаешь старое значение системной переменной, потом его устанавливаешь, после этого работаешь как хочется. В последнюю очередь - восстановить старые значения. Попробуй абстрагироваться от конкретного кода, ищи в нем логику и обобщай ее. Без этого научиться, по-моему, невозможно.
> #162 : Я б на твоем месте сначала с *error* разобрался. А экранный ввод уже потом. Хотя как знаешь. Для ввода с экрана см. getdist и (или) getcorner. Для всего остального функции lisp'a уже не требуются.

[Red Nova]

А что на счет error? Что означает "Разобраться с ним", в каких целях это вообще делать?

[Alan]

Сообщение от Red Nova А что на счет error? Что означает "Разобраться с ним", в каких целях это вообще делать?

Для простоты объяснения...
Лучше всего посмотреть уже упоминавшуюся книгу "САПР на базе..." стр.286

[Кулик Алексей aka kpblc]

В дополнение: http://www.arcada.com.ua/forum/viewtopic.php?t=445

[VVA]

Ну что ж. Начнем наступать на ГРАБЛИ №1 (OSMODE)

1. За основу берем лисп #161.
2. Скачиваем файл Грабли N1.dwg
3. Загружаем команду Колонна из #161
4. Устанавливаем переменную OSMODE = 33 (равносильно включенной привязке "Конточка" и "Пересечение"
   Устанавливаем переменную OSNAPCOORD = 0
5. Ширина и высота колонны = 400
6. Точка вставки колонны - точка пересечения красных отрехков
7. Выполняем команду, смотрим результат, делаем выводы.

[Red Nova]

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

[VVA]

Сообщение от Red Nova VVA, Подозреваю, что ты имел в виду необходимость отключить привязки на момент действия лиспа, так как при запросе угла поворота они могут помешать.

Ну положим мешать они начинают значительно раньше: как только какой-либо команде Автокада начинаешь передавать точки. В твоем случае здесь

Код:

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

(command "_pline" pt1 pt2 pt3 pt4 "_c")

То, что может получиться ты должен был видеть на примере.
Отсюда еще пару мельких наводящих заданий:

1. Узнать в какой системной переменной хранятся привязки
2. Описать эту переменную в Справочнике команд
3. Как можно влиять на включение / отключение привязки при отрисовке, например, отрезков если нельзя:

• нажимать мышкой на кнопку "Привязка" ("OSNAP")
• нажимать на F3
• набирать Ctrl+F
• во время указания точки держать нажатым комбинацию Shift+D

[Red Nova]

VVA,

Ну положим мешать они начинают значительно раньше: как только какой-либо команде Автокада начинаешь передавать точки. В твоем случае здесь Код: (command "_pline" pt1 pt2 pt3 pt4 "_c") То, что может получиться ты должен был видеть на примере.

А у меня казусов не было. Все прошло довольно гладко.

Узнать в какой системной переменной хранятся привязки

Ну это легко - OSMODE

Описать эту переменную в Справочнике команд

Это тоже можно.
http://dwg.ru/f/showthread.php?p=271243

[VVA]

Red Nova, Ты хочешь сказать, что из поста #167 открыв файл "Грабли N1", установив OSMODE=33, задав ширину и высоту колонны = 400 и точку вставки- пересение красных отрезков получил колонну прямоугольную ?
Еще остался вопрос N3 из #169

[Red Nova]

Ты хочешь сказать, что из поста #167 открыв файл "Грабли N1", установив OSMODE=33, задав ширину и высоту колонны = 400 и точку вставки- пересение красных отрезков получил колонну прямоугольную ?

Смотри файл.

Еще остался вопрос N3 из #169

Запомнить Osmode, обнулить, потом вернуть.

[andery]

Я так подозреваю должена быть в коде такая конструкция:

Код:

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

(setq old_osmode (getvar "osmode"))
(setvar "osmode" 33)
; программа
(setvar "osmode" old_osmode)

А как указать точку вставки - пока без понятия....

[Red Nova]

andery,
Скорее всего "osmode" 0

Код:

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

(setq old_osmode (getvar "osmode"))
(setvar "osmode" 0)
; программа
(setvar "osmode" old_osmode)

А как указать точку вставки - пока без понятия....

Посмотри справку про getpoint

[andery]

Точка вставки колонны - точка пересечения красных отрехков

Вот как эту точку указать?

[VVA]

Red Nova,

А у меня казусов не было. Все прошло довольно гладко.

Отредактировал условия в #167. Попробуй снова
andery,
Это все надо делать руками. См. #167. Это просто пимер того, что может произойти, если не обрабатывать OSMODE
Red Nova,

Запомнить Osmode, обнулить, потом вернуть.

Хочу увидеть это лиспом, а не словами
И это один вариант.
Я хочу услышать ответ как без ЛИСПА, F3 и проч. при черчении отменить
действие установленных объектных привязок. (Подсказка: временная объектная привязка или SHIFT + Правая кнопка мыши)

[andery]

Может профи подскажут в каком направлении надо искать на чертеже пересечение всех красных линий, или я неправильно понял задачу?

[VVA]

andery, Ты не правильно понял задачу. Это не задача вовсе, а попытка показать пример, что может быть, если не обрабатывать OSMODE
Отредактировал условия в #167. Это все нужно просто выполнить на своем компьютере и посмотреть на результат.

[Red Nova]

VVA,

Отредактировал условия в #167. Попробуй снова

Теперь понятно.

Я хочу услышать ответ как без ЛИСПА, F3 и проч. при черчении отменить действие установленных объектных привязок

SHIFT + Правая кнопка мыши, а дальше none

[andery]

Выполнил #167
Получилось вот что:
Код такой:

Код:

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

(defun c:колонна (/)
  	(setq old_osmode (getvar "osmode"))
	(setvar "osmode" 33)
  	(setq old_osnapcoord (getvar "osnapcoord"))
  	(setvar "osnapcoord" 0)
	;(initget (+ 1 2 4))
	(setq a 400) ;(getdist"\nВведите ширину колонны:"))
	;(initget (+ 1 2 4))
	(setq b 400) ;(getdist"\nВведите высоту колонны:"))
	(setq p (getpoint "\nУкажите центр колоны:<по умолчанию (0,0)>"))
	;(if (null p) (setq p (quote (0 0 0)))
	;)
	(setq x1 (- (car p) (/ a 2))) 
	(setq y1 (- (car (cdr p)) (/ b 2)))
	(setq x2 (+ (car p) (/ a 2)))
	(setq y2 (+ (car (cdr p)) (/ b 2)))

  	(command "._pline"
		(list x1 y1)
		(list x1 y2)
		(list x2 y2)
		(list X2 y1)
		"_close"
	)
  
  	;(Setq object (entlast))
  	(command "_circle" p (/ a 2))
	;(command "_rotate" object "" p pause) 	)

  	(setvar "osmode" old_osmode)
	(setvar "osnapcoord" old_osnapcoord)
  )

[VVA]

andery, Да, это правильный результат. Вот эти грабли мы и будеи преодолевать. (Только пересохрани в формате 2004 Автокада, а то не все смогут открыть)

SHIFT + Правая кнопка мыши, а дальше none

Правильно, только по нашим условиям "_non", так как сам писал здесь

0 NONe

А я постом ниже жирным выделил необходимое.
Т.е. получается, что в ответ на запрос командой точки (будь то _line, _circle или _pline) можно вводить выделенные жирным опции, как то _endp, _non и т.д.
Раз мы можем вводить это руками, значит мы можем это передать и в command. Т.е. вырисовывается 2 способа борьбы с "OSMODE"
1. Сохранить в переменную, обнулить (или отключить), а потом восстановить
2. Перед вводом каждой точки в command временно отключать привязку с помощью опции "_non"
Хочу увидеть оба варианта в лиспе

[Red Nova]

VVA,
Первый вариант ты уже видел

Код:

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

(setq old_osmode (getvar "osmode"))
(setvar "osmode" 0)
; программа
(setvar "osmode" old_osmode)

И второй вариант.

Код:

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

(command "_pline" "_non" pt1 pt2 pt3 pt4 "_c")
(Setq object (entlast))
(command "_circle" "_non" base "_non" R)
(command "_rotate" "_non" object "" "_non" base "_non" pause)

Думаю второй вариант менее проблематичный (не связываемся с функцией error)

[Кулик Алексей aka kpblc]

И не совсем верный второй вариант. Надо:

Код:

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

(command "_pline" "_non" pt1 "_non" pt2 "_non" pt3 "_non" pt4  "_c")

[Red Nova]

Кулик Алексей aka kpblc,

[andery]

(command "_circle" "_non" base "_non" R)

Зачем перед R ставить _non ?
Это ведь не точка....

[VVA]

Red Nova, Алексей уже подсказал. Я нужное слово выделил в #181 поярче.
Давай остановимся на 1-м варианте. Покажи код целиком, чтобы идти дальше.

*** Добавлено
andery, В принципе не обязательно, если в переменной R - число. Но в Автокаде радиус можно "показать" 2-мя точками. Просто нужно отдавать себе отчет, что у тебя в переменной R.

[andery]

У меня такое получилось с использованием 1-го варианта:

Код:

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

(defun c:колонна (/)
  	(setq old_osmode (getvar "osmode"))
	(setvar "osmode" 0)
  	(setq old_osnapcoord (getvar "osnapcoord"))
  	(setvar "osnapcoord" 0)
	(initget (+ 1 2 4))
	(setq a (getdist"\nВведите ширину колонны:"))
	(initget (+ 1 2 4))
	(setq b (getdist"\nВведите высоту колонны:"))
	(setq p (getpoint "\nУкажите центр колоны:<по умолчанию (0,0)>"))
	(if (null p) (setq p '(0 0 0))
	)
	(setq x1 (- (car p) (/ a 2))) 
	(setq y1 (- (car (cdr p)) (/ b 2)))
	(setq x2 (+ (car p) (/ a 2)))
	(setq y2 (+ (car (cdr p)) (/ b 2)))

  	(command "._pline"
		(list x1 y1)
		(list x1 y2)
		(list x2 y2)
		(list X2 y1)
		"_close"
	)
  
  	(Setq object (entlast))
  	(command "_circle" p (/ a 2))
	(command "_rotate" object "" p pause) 	)

  	(setvar "osmode" old_osmode)
	(setvar "osnapcoord" old_osnapcoord)
  )

[Red Nova]

VVA, Учитывая отслежку Osmode

Код:

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

 (defun C:Колонна (/ dimensionX dimensionY base R object old_osmode )
(setq old_osmode (getvar "osmode"))
(setvar "osmode" 0)
(initget 7)
(setq dimensionX (getreal "Введите ширину колонны: "))
(initget 7)
(setq dimensionY (getreal "Введите толщину колонны: "))
(setq base 
    (cond
         ((getpoint "\Введите точку вставки колонны <0,0,0> :"))
         (t '(0. 0. 0.)))
     ) 
(setq pt1
     ( list ( - ( car base ) ( / dimensionX  2.0 ) )
            ( - (cadr base ) ( / dimensionY  2.0 ) )
     )
)
(setq pt2
     ( list ( - ( car base ) ( / dimensionX  2.0 ) )
            ( + (cadr base ) ( / dimensionY  2.0 ) )
     )
)
(setq pt3
     ( list ( + ( car base ) ( / dimensionX  2.0 ) )
            ( + (cadr base ) ( / dimensionY  2.0 ) )
     )
)
(setq pt4
     ( list ( + ( car base ) ( / dimensionX  2.0 ) )
            ( - (cadr base ) ( / dimensionY  2.0 ) )
     )
)
(Setq  R  ( / dimensionX  2.0 ))
(command "_pline" pt1 pt2 pt3 pt4 "_c")
(Setq object (entlast))
(command "_circle" base R)
(command "_rotate" object "" base pause)
(setvar "osmode" old_osmode)
)

[andery]

Кстати при таком варианте, при прерывании команды "колонна" эскейпом
osmode=0, ИМХО как-то неправильно...

[Red Nova]

andery,
Подозреваю что далее у нас урок обработки ошибок методом переопределения функции error

[Кулик Алексей aka kpblc]

Ссылка на пример переопределенного обработчика уже была

[VVA]

Сообщение от Red Nova andery, Подозреваю что далее у нас урок обработки ошибок методом переопределения функции error

Ну положим не error, а *error*. А так в общем правильно. Если мы будем использовать 1-й вариант (сохранение OSMODE в переменной и восстановление), то мы не застрахованы, что при повороте колонны пользователь нажмет ESC и програма прекратит свою работу. Но OSMODE мы вначале установили равным 0, а назад не восстановили, так как програма прекратила работу. Пользователь недоволен и высказывает СПРАВЕДЛИВО нам свое фи.

Кстати при таком варианте, при прерывании команды "колонна" эскейпом osmode=0, ИМХО как-то неправильно...

В Автолиспе существует специально объявленная функция *error*, которой передается один аргумент- сообщение об ошибке.
Есть 2 варианта:
1-й как показал Алексей здесь можно ГЛОБАЛЬНО переназначить обработчик ошибок:
создать свою функцию с 1-м аргументом (см. (defun kpblc-error (message) ... по ссылке
присвоить стандартному обработчику указатель на свой обработчик ошибок. Пример ф-ции приведу здесь
;|

Код:

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

============================================================================= 
*    Переназначение обработки ошибок. 
*    Переназначен или нет обработчик проверяется по значению 
* переменной *kpblc-error* 
=============================================================================|; 
(defun kpblc-error-init () 
  (if (not *kpblc-error*) 
    (setq *kpblc-error* *error* ;;;_Сохраняем в ГЛОБАЛЬНОЙ переменной *kpblc-error* указатель на *error*
     *error* kpblc-error  ;;; Присваиваем переменной *error* указатель на нашу ф-цию kpblc-error
     ) ;_ end of setq 
    (setq *error*     *kpblc-error* 
     *kpblc-error* nil 
     ) ;_ end of setq 
    ) ;_if 
  (princ) 
  ) ;_defun

2-й тоже описан несколькими постами ниже (см пост от Ср 21 Июн , 2006 10:50)
Суть его в том, что мы не сохраняем и восстанавливаем глобально ф-цию
*error*, а объявляем ее ЛОКАЛЬНОЙ переменной и в теле самой ф-ции объявляем ф-цию *error*. Т.е конструкция принимает вид

Код:

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

(defun c:myfunc_witherror( / *error* oldOSM base) 
(defun *error*(msg) 
;; Определяем действия, которые надо выполнить 
;; в случае ошибки выполнения основного кода 
) 
;; Чего-то там делаем в c:myfunc_witherror
) ;_ end of defun

Т.е. получается, что время жизни ф-ции *error* - пока существует ф-ция c:myfunc_witherror.
Здесь есть еще один нюанс: Всем КРАСНЫМ ф-циям, объявленным внутри СИНИХ функций доступны ЛОКАЛЬНЫЕ переменные СИНИХ функций как ГЛОБАЛЬНЫЕ. Я могу спокойно проверять значение переменной, объявленной как локальная в ф-ции верхнего уровня (СИНЕЙ)

Код:

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

(defun c:myfunc_witherror( / *error* oldOSM base) 
(defun *error*(msg) 
(princ msg) ;_ печатаем сообщение
(if oldOSM (setvar "OSMODE" oldOSM)) ;_Если oldOSM задано, то присваиваем переменной OLDOSM значение oldOSM
) 
;; Чего-то там делаем в c:myfunc_witherror
) ;_ end of defun

В случае ошибки в ф-ции c:myfunc_witherror (как то нажатие ESC пользователем) управление передастся ф-ции *error* и мы восстановим переменную OSMODE в сохраненное ранее значение в переменной oldOSM
Ну вот попытался в картинках объяснить как это работает. Хотелось бы увидеть команду КОЛОННА с *error* по 2-му варианту

[Кулик Алексей aka kpblc]

Следующим шагом рекомендовал бы заняться метками отмены

[Red Nova]

Понять бы еще что значит (msg)

Код:

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

(defun C:Колонна (/ dimensionX dimensionY base R object oldOSM)
 (defun *error*(msg) 
 (princ msg) ; Отменено пользователем
 (if oldOSM (setvar "OSMODE" oldOSM)) 
 ) 
 (setq oldOSM (getvar "osmode"))
 (setvar "osmode" 0)
 (initget 7)
 (setq dimensionX (getreal "Введите ширину колонны: "))
 (initget 7)
 (setq dimensionY (getreal "Введите толщину колонны: "))
 (setq base 
    (cond
         ((getpoint "\Введите точку вставки колонны <0,0,0> :"))
         (t '(0. 0. 0.)))
     ) 
 (setq pt1
     ( list ( - ( car base ) ( / dimensionX  2.0 ) )
            ( - (cadr base ) ( / dimensionY  2.0 ) )
     )
 )
 (setq pt2
     ( list ( - ( car base ) ( / dimensionX  2.0 ) )
            ( + (cadr base ) ( / dimensionY  2.0 ) )
     )
 )
 (setq pt3
     ( list ( + ( car base ) ( / dimensionX  2.0 ) )
            ( + (cadr base ) ( / dimensionY  2.0 ) )
     )
 )
 (setq pt4
     ( list ( + ( car base ) ( / dimensionX  2.0 ) )
            ( - (cadr base ) ( / dimensionY  2.0 ) )
     )
 )
 (Setq  R  ( / dimensionX  2.0 ))
 (command "_pline" pt1 pt2 pt3 pt4 "_c")
 (Setq object (entlast))
 (command "_circle" base R)
 (command "_rotate" object "" base pause)
 (setvar "osmode" oldOSM)
)

[Кулик Алексей aka kpblc]

поставь точку останова и выполняй пошагово

[VVA]

Понять бы еще что значит (msg)

msg - это тоже переменная, только она расположена перед слэшем, значит это АГРУМЕНТ функции. Почитай Команда или функция?, defun, и 1.4 Соглашения по обозначениям
Мы добились главного. Если пользователь прервет ф-цию, то восстановятся объектные привязки до вызова команды Колонна.
Для иллюстрации примера делаем следующее:

1. В командной строке набираем OSMODE и задаем значение 33 (Конточка+ Пересечение)
2. Грузим лисп из #188 и в момент запроса угла поворота нажимаем ESC.
3. Проверяем значение OSMODE

И так

1. В командной строке набираем OSMODE и задаем значение 33 (Конточка+ Пересечение)
2. Грузим лисп из #194 и в момент запроса угла поворота нажимаем ESC.
3. Проверяем значение OSMODE

У меня еще задание. Все знают, что привязку (OSMODE) можно ОТКЛЮЧАТЬ, т.е. сохраняется перечень установленных режимов, а потом ВКЛЮЧАТЬ.
Задание для самостоятельной работы: Написать функции
disable_osmode - Функция отключения режима(ов) объектной привязки
enable_osmode - Функция включения режима(ов) объектной привязки
В справке про OSMODE об этом написано.

[andery]

У меня такие вопросы по поводу Граблей№1,
1.Зачем делать osnapcoord=0 ? Ведь "наступаем" на грабли тока при этом значении.
2.Не лучше ли делать osnapcoord=1 (1 - Ввод с клавиатуры пере регулирует установки объектной привязки., ведь при этом у нас никогда "не убежит" точка, т.к. мы ее вводим "вручную")? А потом возращать прошлое значение.
3. Если делаем колонну, зачем osmode делать 0 ?
А если пользователь при вставке колонны хочет пользоваться привязками?

[Кулик Алексей aka kpblc]

"А если пользователь хочет пользоваться привязками" - то надо либо отключать их только на момент рисования, либо вообще использовать некомандные методы.

[andery]

Переформулирую вопрос:
В нашей функции "колонна" ,если мы выставляем osnapcoord=1, в каком случае мы наступим на грабли? (в каком случае точка может "убежать")

[VVA]

1,2. Это дело вкуса. Можно делать и так. Это просто пример. Можно вообще использовать некомандные методы и забыть про привязку. Плюс еще OSNAPCOORD появилась в 13-й версии Автокада, а я эти проблемы решал в 10-й версии. Привычка.
3. А никто не застявляет обнулять OSMODE сразу как запомнили значение. Можно обнулить перед вызовом _PLINE. Это так Red Nova захотел, а пользователь andery указал ему на этот СУЩЕСТВЕННЫЙ недостаток. Неудобно пользоваться командой Колонна, так как невозможно привязаться к существующему пересечению осей. Ну и наконец привязку можно ОТКЛЮЧАТЬ

[andery]

disable_osmode - Функция отключения режима(ов) объектной привязки enable_osmode - Функция включения режима(ов) объектной привязки

Код:

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

(defun disable_osmode ()
(setvar "osmode" (+ (getvar "osmode") 16384))
)
(defun enable_osmode ()
(setvar "osmode" (- (getvar "osmode") 16384))
)

Проверил с командной строки - прошло.

[Alaspher]

Сообщение от andery Переформулирую вопрос: В нашей функции "колонна" ,если мы выставляем osnapcoord=1, в каком случае мы наступим на грабли? (в каком случае точка может "убежать")

Скорее всего, ни в каком (не проверял), но... есть ещё момент - при написании любых программ, одним из важнейших правил является минимизация вемешательства в среду исполнения, т.е. по окончании работы нашей программы, то место, где она работала (в случае АвтоЛИСПов, это Автокад) должно функционировать ровно так же, как и до запуска. В принципе, манипуляция с переменными osmode и osnapcoord вполне сопоставима - в любом случае менять их надо только на момент программного рисования и сразу по его окончании восстанавливать в первоначальное состояние, но опять же есть нюанс - традиционно для таких манипуляций используется именно osmode, в том числе потому, что управлять привязками умеет любой пользователь, а вот о osnapcoord и её действии большинство пользователей даже и не подозревает. Соответственно, если чтото пойдёт наперекосяк, а рано или поздно таки случится чтото такое, от чего не спасут самые изощрённые меры предосторожности, то пользователю гораздо проще восстановить привязки, чем управление приоритетом ввода.

[Alaspher]

Сообщение от andery Проверил с командной строки - прошло.

А если привязка уже отключена/включена юзером?

[ShaggyDoc]

Можно обнулить перед вызовом _PLINE

Я бы сказал так: Нужно обнулять перед любой командой рисования, в которой отсутствует интерактив наподобие pause. И восстанавливать перед любым интерактивным действием. То есть, когда пользователь может указать точку интерактивно, он должен иметь возможность воспользоваться своим любимим набором объектных привязок. И не только при указании точки, но и в других get-функциях, потому что там также можно вводить, например, число указанием точек.

А до некомандных методов обучение еще дойдет. Там и с *error* решать иначе нужно.

[VVA]

andery, #201 Незачтено. Причина: читай #203

[Red Nova]

VVA,

У меня еще задание. Все знают, что привязку (OSMODE) можно ОТКЛЮЧАТЬ, т.е. сохраняется перечень установленных режимов, а потом ВКЛЮЧАТЬ. Задание для самостоятельной работы: Написать функции disable_osmode - Функция отключения режима(ов) объектной привязки enable_osmode - Функция включения режима(ов) объектной привязки

Это можно

Код:

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

(defun C:disable_osmode (/ oldOSM)
 (setq oldOSM (getvar "osmode"))
 (setvar "osmode" (+ oldOSM 16384))
)

Код:

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

(defun C: enable_osmode (/ oldOSM)
 (setq oldOSM (getvar "osmode"))
 (setvar "osmode" (- oldOSM 16384))
)

Было бы интересно совместить эти две функции. Алгоритм я представляю, но руки пока кривые.
Нужно функцией IF создать две ветки программы. Проверяется значение osmode, если оно меньше 16384, то выполняется первая функция, иначе вторая. Но вот как проверить это условие?

msg - это тоже переменная, только она расположена перед слэшем, значит это АГРУМЕНТ функции. Почитай Команда или функция?, defun, и 1.4 Соглашения по обозначениям

А вот этого понять не могу, хотя ссылки смотрел. Вижу, что msg позволяет вывести сообщение на экран, но что такое аргумент, и чем он отличен от функции не понимаю.

andery,
Главный смысл научится это все делать, лично мне тоже здесь не нужно возится с Osmode, но знать надо. Кто знает какая переменная в будущем может помешать.

[VVA]

Red Nova, #206 Незачет
1. Я просил фукции, а не команды
2. Уж если и команда, то enable_osmode определена неправильно.
3.

Проверяется значение osmode, если оно меньше 16384, то выполняется первая функция, иначе вторая

Нет. В самой ф-ции проверяется значение OSMODE и если оно устраивает, то выполняются ее действия или не выполняются.

msg - это тоже переменная, только она расположена перед слэшем, значит это АГРУМЕНТ функции А вот этого понять не могу, хотя ссылки смотрел

В метро есть турникет, чтобы через него пройти нужно бросить жетон.
Так вот жетон - это АРГУМЕНТ функции ТУРНИКЕТ. Т.е. АРГУМЕНТ - ОБЯЗАТЕЛЬНО ПЕРЕДАВАЕМЫЙ ПАРАМЕТР функции.
(турникет жетон) - вошли в метро
(турникет) - ошибка, мало передано параметров
(турникет жетон сумка) -ошибка, много передано параметров. Нужен только жетон

[andery]

Red Nova,
У Вас при вызове этих функций привязка включиться и выключится внутри функции а результат фунции будет такойже как и до ее вызова.
И действительно надо проверить на включение привязку.

[Red Nova]

VVA,

Уж если и команда, то enable_osmode определена неправильно.

Поправил кое что

Я просил функции, а не команды

А разве мы до сих пор писали функции? Вроде как только команды писали. А функции писать я не умею. (Или умею?)

[Red Nova]

andery,

результат фунции будет такойже как и до ее вызова.

Как раз заметил.

[VVA]

А разве мы до сих пор писали функции? Вроде как только команды писали. А функции писать я не умею. (Или умею?)

Я в #196 просил тебя почитать Команда или фукция?. Прочти и ответь на свой вопрос сам.

[andery]

Щас напишем..........

[VVA]

andery, Это условие (= (getvar "osmode") (- (getvar "osmode") 16384)) ВСЕГДА будет ложь (nil). Поэтому рисать if не имеет смысла.
Этот вариант будет всегда делать то же, что и твой

Код:

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

(defun c:disable_osmode ()
"Привязка уже выключена"
)

PS
1. Если хочешь напечатать в командную строчку - используй ф-цию princ
2. Господа, я просил ФУНКЦИЮ, а не КОМАНДУ
PPS
Напишите мне словами алгоритм работы функции disable_osmode.

[andery]

VVA,
Так я сразу удалил
Вот окончательный вариант:

Код:

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

(defun c:disable_osmode ()
(if (<= (- (getvar "osmode") 1684) 0)
  (setvar "osmode" (+ (getvar "osmode") 16384))
  "Привязка уже выключена"
)
)
  
(defun c:enable_osmode ()
(if (> (- (getvar "osmode") 1684) 0)
  (setvar "osmode" (- (getvar "osmode") 16384))
  "Привязка уже включена"
)
)

[VVA]

andery, Это уже кое-что
Только нужно учесть PS №1 и 2 из #213

[andery]

Вроде так тогда:

Код:

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

(defun disable_osmode ()
(if (<= (- (getvar "osmode") 1684) 0)
  (setvar "osmode" (+ (getvar "osmode") 16384))
  (prompt "Привязка уже выключена")
)
)
(defun enable_osmode ()
(if (> (- (getvar "osmode") 1684) 0)
  (setvar "osmode" (- (getvar "osmode") 16384))
  (prompt "Привязка уже включена")
)
)

тока с princ чтот не могу разобраться....
код поправил решивши использовать prompt

[Red Nova]

VVA,
Можно попробовать и без переменных.

Код:

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

(defun disable_osmode ()
    (if (< (getvar "osmode") 16384) 
      (setvar "osmode" (+ getvar "osmode" 16384)) 
    )
)
(defun enable_osmode ()
    (if (> (getvar "osmode") 16383) 
      (setvar "osmode" (- getvar "osmode" 16384)) 
    )
)

[Кулик Алексей aka kpblc]

Ага. А теперь еще сюда же добавить clayer, celtscale, celtype и до кучи еще пару-тройку переменных. И подумать, как нарисовать код покороче.

[Red Nova]

Кулик Алексей aka kpblc, Расшифруй.

[VVA]

Red Nova, Синтаксис Пушкин должен соблюдать?
Если внимательно посмотреть на коды режимов объектной привязки, то можно заметить, что там идет степень двойки. Т.е. устанавливается в 0 или 1 соответвующий бит. Тогда ф-ции можно записать так

Код:

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

(defun disable_osmode ()
  (setvar "osmode" (logior (getvar "OSMODE") 16384)))
(defun enable_osmode ()
  (setvar "osmode"(boole 2 (getvar "OSMODE") 16384)))

Но это так, лирическое отступление

[Red Nova]

Синтаксис Пушкин должен соблюдать

Пушкин так же как и я не знает что это такое. Мы с ним просим пояснить.

[Red Nova]

Пытаюсь понять что это значит

4.71 (logior <число> <число> ...) Эта функция возвращает результат действия побитового ИЛИ над списком <чисел>. <Числа> должны быть целые и результат так же целое число. Например: (logior 1 2 4) возвращает 7 (logior 9 3) возвращает 11

[andery]

Вернемся к нашему коду,
Используя созданные функции (без лирических отступлений) его можна записать так:

Код:

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

(defun disable_osmode ()
(if (<= (- (getvar "osmode") 1684) 0)
  (setvar "osmode" (+ (getvar "osmode") 16384))
)
)
  
(defun enable_osmode ()
(if (> (- (getvar "osmode") 1684) 0)
  (setvar "osmode" (- (getvar "osmode") 16384))
)
)

(defun c:колонна (/)
      	(initget (+ 1 2 4))
	(setq a (getdist"\nВведите ширину колонны:"))
	(initget (+ 1 2 4))
	(setq b (getdist"\nВведите высоту колонны:"))
	(setq p (getpoint "\nУкажите центр колоны:<по умолчанию (0,0)>"))
	(if (null p) (setq p '(0 0 0))
	)
	(setq x1 (- (car p) (/ a 2))) 
	(setq y1 (- (car (cdr p)) (/ b 2)))
	(setq x2 (+ (car p) (/ a 2)))
	(setq y2 (+ (car (cdr p)) (/ b 2)))
	(disable_osmode)
  
  	(command "._pline"
		(list x1 y1)
		(list x1 y2)
		(list x2 y2)
		(list X2 y1)
		"_close"
	)
  
  	(Setq object (entlast))
  	(command "_circle" p (/ a 2))
  	(enable_osmode)
	(command "_rotate" object "" p pause) 
  )

Все ли верно?
Давайте дальше усложнять....

[Олег К.]

То ли я чего-то пропустил, но:

disable_osmode - Функция отключения режима(ов) объектной привязки enable_osmode - Функция включения режима(ов) объектной привязки

Из последнего примера:

Код:

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

(defun enable_osmode ()
    (if (> (getvar "osmode") 16383) 
      (setvar "osmode" (- getvar "osmode" 16384)) 
    )
)

т.е. словами: функция включения привязок - если "osmode" больше 16384 (привязки включены), то вычесть из "osmode" 16384 (отключить привязки). Что-то не сходится.

И еще. Red Nova и andery внимательнее к цифрам, что означают "1684" и "16383"? Привязки с битом =0 нет (есть "отсутствие" привязки), так что больше или меньше 16384.

[Red Nova]

Олег К.,

если "osmode" больше 16384 (привязки включены), то вычесть из "osmode" 16384 (отключить привязки).

По моему на оборот если "osmode" больше 16384 (привязки выключены), то вычесть из "osmode" 16384 (включить привязки)

что означают "16383"?

Так если там будет 16384, то нужно и знак равенства ставить, а так и без него пойдет.

[Red Nova]

VVA
Я застрял.
Сразу куча непонятного.
1. Что значит следить за синтаксисом. (где я ошибся?)
2. Что делают ф-ии logior и boole ? Мое “не программистское” мышление не может понять логики в цитатах из хелпа по этим ф-иям.

[andery]

Я так понял что
osmode = 0 и
osmode = 16384
равнозначный выражения и означает, что все привязки выключены.
Тогда значит данный код

Код:

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

(defun enable_osmode ()
    (if (> (getvar "osmode") 16383) 
      (setvar "osmode" (- getvar "osmode" 16384)) 
    )
)

даст сбой при значении osmode=16384, т.к. приведет к значению равному 0, т.е. не включит привязки.

[Олег К.]

Да, действительно, при выключении привязок прибавляется 16384. Был не прав, извиняюсь.

>> andery. Вот об этом и говорил: внимательнее к цифрам. Ноль тоже меньше 16384, в системе этого значения нет, но его можно выставить вручную.
Получается, когда osmode=0 или >= 16384 привязки выключены, от 1 до 16383 - включены.

Добавлю еще.
Когда все привязки выключены вручную (Drafting settings -> Object Snap) то osmode=0 а не 16384. Именно это число (16384) нигде не показывается, оно служит лишь добавкой.

[VVA]

Сообщение от Red Nova VVA Я застрял. Сразу куча непонятного. 1. Что значит следить за синтаксисом. (где я ошибся?) 2. Что делают ф-ии logior и boole ? Мое “не программистское” мышление не может понять логики в цитатах из хелпа по этим ф-иям.

1. Попробуй скопируй функции из поста #217 в Visual LISP и выполни
2. Вкратце каждое число представляется в двоичной системе счисления и сравнивается каждый бит. В общем забудь. Понятней с if - используй его.

[VVA]

Давайте дальше усложнять.

А теперь хочу чтобы колонна рисовалась на слое "Колонны".
Цвет слоя - красный. Тип линии - Continuous. После завершения команды AutoCAD должен вернуться на начальный слой.

[Кулик Алексей aka kpblc]

Тип линии - Continuous. После завершения команды AutoCAD должен вернуться на начальный слой.

[Red Nova]

VVA, Кулик Алексей aka kpblc,
А функции подсказать? Через command вроде как не пройдет.

Попробуй скопируй функции из поста #217 в Visual LISP и выполни

При попытке поменять переменную пишет

Command: (disable_osmode) ; error: bad argument type: numberp: #<SUBR @0c9b66f4 GETVAR>

[andery]

Я чтот запутался...
что должна делать функция enable_osmode при
osmode=16384 ?

[VVA]

Red Nova, Пишет правильно

Код:

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

(defun disable_osmode ()
    (if (< (getvar "osmode") 16384) 
      (setvar "osmode" (+ (getvar "osmode") 16384)) 
    )
)
(defun enable_osmode ()
    (if (> (getvar "osmode") 16383) 
      (setvar "osmode" (- (getvar "osmode") 16384)) 
    )
)

Кто красные скобки ставить будет? Пушкин? Синтаксис - правильность написания

[VVA]

andery, Ничего не делать. Оставить как есть.

А функции подсказать? Через command вроде как не пройдет.

Почему не пройдет?
Команда _-LAYER, переменная CLAYER

[Red Nova]

Понял.

[Red Nova]

VVA,
Вот вариант команды одновременно и отключающей и включающей привязки. Работает.

Код:

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

(defun c:disable_enable_osmode ()
    (if (< (getvar "osmode") 16384) 
      (setvar "osmode" (+ (getvar "osmode") 16384)) 
      (setvar "osmode" (- (getvar "osmode") 16384))
    )
)

Над новым заданием пока думаю. Пока что-то нашел про entmake.

[Red Nova]

Из хелпа

The following code fragment creates a circle on the MYLAYER layer: (entmake '((0 . "CIRCLE") ; Object type (8 . "MYLAYER") ; Layer (10 5.0 7.0 0.0) ; Center point (40 . 1.0) ; Radius ) )

Я так понял, что в скобках пишется код операции, затем ее параметры. То есть
(0 . "CIRCLE") тут 0 Значит, что создается объект, далее поясняется, что это круг.
(8 . "MYLAYER") тут 8 означает, что создается слой, далее его имя.
(10 5.0 7.0 0.0) 10 означает что далее идут координаты центра объекта.
(40 . 1.0) 40 означает, что далее идет радиус объекта.

Если я прав, то где найти коды для других операций?

[Кулик Алексей aka kpblc]

DXF Reference. По ходу дела разберись с разницей между ', list, cond.

[Олег К.]

А не рано? VVA хотел, чтоб пока командами научились работать.

dxf-коды можно посмотреть в хелпе редактора лиспа, раздел "DXF Reference".
Не создается, а "это объект такой-то" и "находится на слое таком-то".
Если в создаваемом объекте указан отсутствующий слой, то он (слой) будет создан, но с умолчальными настройками.

[Alaspher]

Сообщение от Red Nova VVA, Вот вариант команды одновременно и отключающей и включающей привязки. Работает. Код: [Выделить все] (defun c:disable_enable_osmode () (if (< (getvar "osmode") 16384) (setvar "osmode" (+ (getvar "osmode") 16384)) (setvar "osmode" (- (getvar "osmode") 16384)) ) )

Тогоже результата можно добиться без предварительной проверки значения:

Код:

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

(defun demo ()
      (setvar "osmode" (boole 6 16384 (getvar "osmode")))
)

но полезность такого решения весьма сомнительна - лично я ни разу не сталкивался с ситуацией, когда наличие привязки надо было бы изменить на пртивоположное. Как правило, надо бывает выключить привязку в нужное время и вернуть в первоначальное состояние, по окончании. В редких случаях бывает надо включить конкретную привязку, но опять же вне зависимости от её состояния ДО начала выполнения программы.

[Red Nova]

Олег К.,
А как командами это сделат? Хоть намекни что надо использовать.

[VVA]

Сообщение от Red Nova Олег К., А как командами это сделат? Хоть намекни что надо использовать.

Если хочешь обучаться, тщательно штудируй оставленные тебе сообщения.
#235 для кого писалось?

[Олег К.]

А как командами это сделат? Хоть намекни что надо использовать.

А как ты полилинию и окружность делал? Набираешь в командной строке и смотришь, какие запросы идут. Потом пробуешь повторить это лиспом. Что набирать уже сказано в #235.
Вас тут двое обучающихся, но даже если сообщение адресуется одному, другому тоже рекомендуется читать.

[andery]

Если с полилинией, кругом понятно, т.к. запросы идут в командной строке, более менее догататься можна.
А вот _layer вызывает диалоговое окно....
Где можна найти подробной описание команд ?

[VVA]

andery, Разве в #235 написано _layer? Там написано _-layer
Найди разницу и почитай предпоследний пост здесь.

[andery]

Протупил...не читаем предыдущий пост

[Red Nova]

VVA,

Если хочешь обучаться, тщательно штудируй оставленные тебе сообщения. #235 для кого писалось?

Дык #235 было адресовано andery, вот я и пропустил.

[andery]

Получилось вот такое:

Код:

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

(defun c:колонна (/)
      	(initget (+ 1 2 4))
	(setq a (getdist"\nВведите ширину колонны:"))
	(initget (+ 1 2 4))
	(setq b (getdist"\nВведите высоту колонны:"))
	(setq p (getpoint "\nУкажите центр колоны:<по умолчанию (0,0)>"))
	(if (null p) (setq p '(0 0 0))
	)
	(setq x1 (- (car p) (/ a 2))) 
	(setq y1 (- (car (cdr p)) (/ b 2)))
	(setq x2 (+ (car p) (/ a 2)))
	(setq y2 (+ (car (cdr p)) (/ b 2)))

  

	(setq oldOsnapcoord (getvar "osnapcoord"))
	(setq oldLayer (getvar "clayer"))
	(setvar "osnapcoord" 1)       
  	(command "_.-layer" "_make" "колонна" "_color" "_red" "" "_L" "continuous" "" "")  

    	(command "._pline"
		(list x1 y1)
		(list x1 y2)
		(list x2 y2)
		(list X2 y1)
		"_close"
	)
    	(Setq object (entlast))
  	(command "_circle" p (/ a 2))
 	(command "_rotate" object "" p pause)
  	(setvar "clayer" oldLayer)
	(setvar "osnapcoord" oldOsnapcoord)  
  )

[VVA]

andery, В общем хорошо кроме одного: если при запросе угла поворота нажать ESC, то не восстановится ни слой, ни osnapcoord
Прочитай пост #192 , пример #194 и 196. Хочу чтобы кодга нажму ESC все осталось как было.

*** Добавлено
Еще хочу чтобы круг был синим. См. команды _CHANGE и _CHPROP

[andery]

VVA,
Спасибо, я пока сознательно не применяю *error*
Вот так можна пока в нашем случае пока обойтись без эррора (я так думаю).
Круг синий.

Код:

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

 
(defun c:колонна (/)
      	(initget (+ 1 2 4))
	(setq a (getdist"\nВведите ширину колонны:"))
	(initget (+ 1 2 4))
	(setq b (getdist"\nВведите высоту колонны:"))
	(setq p (getpoint "\nУкажите центр колоны:<по умолчанию (0,0)>"))
	(if (null p) (setq p '(0 0 0))
	)
	(setq x1 (- (car p) (/ a 2))) 
	(setq y1 (- (car (cdr p)) (/ b 2)))
	(setq x2 (+ (car p) (/ a 2)))
	(setq y2 (+ (car (cdr p)) (/ b 2)))

	(setq oldOsnapcoord (getvar "osnapcoord"))
	(setq oldLayer (getvar "clayer"))
	(setvar "osnapcoord" 1)       
  	(command "_.-layer" "_make" "колонна" "_color" "_red" "" "_L" "continuous" "" "")  

    	(command "._pline"
		(list x1 y1)
		(list x1 y2)
		(list x2 y2)
		(list X2 y1)
		"_close"
	)
    	(Setq object (entlast))
  	(command "_circle" p (/ a 2))
  	(command "_change" (entlast) "" "_P" "_C" "_blue" "")
  	(setvar "clayer" oldLayer)
	(setvar "osnapcoord" oldOsnapcoord)  
 	(command "_rotate" object "" p pause)
  
  )

[VVA]

andery, Зачтено.
Теперь синим пусть будут и полилиния и круг. Будем учиться работать с наборами. Наборы - это коробочка с именами примитивов (типа entlast), которую тоже можно указывать в ответ на запрос "Выберите объекты". Туда можно по мере отрисовки примитивов их складывать, чтобы скормить какой-либо команде за один раз.
В общем с наборами работают следующие ф-ции лиспа:
ssadd , ssdel ,sslength, ssname
Нам здесь понадобится ssadd

Код:

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

(setq ss (ssadd)) ;_ Создаем пустой набор
(ssadd (entlast) ss) ;_Помещаем в ss последний отрисованный примитив

[andery]

Вроде так:

Код:

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

(defun c:колонна (/)
      	(initget (+ 1 2 4))
	(setq a (getdist"\nВведите ширину колонны:"))
	(initget (+ 1 2 4))
	(setq b (getdist"\nВведите высоту колонны:"))
	(setq p (getpoint "\nУкажите центр колоны:<по умолчанию (0,0)>"))
	(if (null p) (setq p '(0 0 0))
	)
	(setq x1 (- (car p) (/ a 2))) 
	(setq y1 (- (car (cdr p)) (/ b 2)))
	(setq x2 (+ (car p) (/ a 2)))
	(setq y2 (+ (car (cdr p)) (/ b 2)))

	(setq oldOsnapcoord (getvar "osnapcoord"))
	(setq oldLayer (getvar "clayer"))
	(setvar "osnapcoord" 1)       
  	(command "_.-layer" "_make" "колонна" "_color" "_red" "" "_L" "continuous" "" "")
  	(setq nabor (ssadd)) 
	(command "_circle" p (/ a 2))
  	(ssadd (entlast) nabor)
    	(command "._pline"
		(list x1 y1)
		(list x1 y2)
		(list x2 y2)
		(list X2 y1)
		"_close"
	)
    	
  	(ssadd (entlast) nabor)
  	(command "_change" nabor "" "_P" "_C" "_blue" "")
  	(setvar "clayer" oldLayer)
	(setvar "osnapcoord" oldOsnapcoord)  
 	(command "_rotate" (entlast) "" p pause)
  
  )

[Red Nova]

Пока я справлял день рождения вы ушли вперед. Будем догонять.

[Рyslan]

учиться, учиться и учиться!

[andery]

Вот эту строчку
(command "_rotate" (entlast) "" p pause)
можна заменить вот этой.
(command "_rotate" (ssname nabor 1) "" p pause)

[Red Nova]

VVA,
Вот код по заданию с #230

Код:

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

(defun C:Колонна (/ dimensionX dimensionY base R object oldOSM OldLAY)

 (defun *error*(msg) 
 (princ msg) ; Отменено пользователем
 (if oldOSM (setvar "OSMODE" oldOSM)) 
 ) 

 (setq OldLAY (getvar "clayer"))

 (setq oldOSM (getvar "osmode"))

 (setvar "osmode" 0)

 (initget 7)
 (setq dimensionX (getreal "Введите ширину колонны: "))
 (initget 7)
 (setq dimensionY (getreal "Введите толщину колонны: "))
 (setq base 
    (cond
         ((getpoint "\Введите точку вставки колонны <0,0,0> :"))
         (t '(0. 0. 0.)))
     ) 
 (setq pt1
     ( list ( - ( car base ) ( / dimensionX  2.0 ) )
            ( - (cadr base ) ( / dimensionY  2.0 ) )
     )
 )
 (setq pt2
     ( list ( - ( car base ) ( / dimensionX  2.0 ) )
            ( + (cadr base ) ( / dimensionY  2.0 ) )
     )
 )
 (setq pt3
     ( list ( + ( car base ) ( / dimensionX  2.0 ) )
            ( + (cadr base ) ( / dimensionY  2.0 ) )
     )
 )
 (setq pt4
     ( list ( + ( car base ) ( / dimensionX  2.0 ) )
            ( - (cadr base ) ( / dimensionY  2.0 ) )
     )
 )

 (Setq  R  ( / dimensionX  2.0 ))

 (command "_-LAYER" "_make" "Колонны" "_color" "red" "" "ltype" "" "" "_set" "Колонны" "")

 (command "_pline" pt1 pt2 pt3 pt4 "_c")

 (Setq object (entlast))

 (command "_circle" base R)

 (command "_rotate" object "" base pause)

 (setvar "clayer" OldLAY)

 (setvar "osmode" oldOSM)
)

Тут меня смущает только undo. После выполнения команды, если нажать undo, то действия отменяются пошагово. Видел как это сделать при помощи vla команд, но Autolisp - ом не умею.

[Red Nova]

Догоняю дальше. Вот с заданием кругу синего цвета.

Код:

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

(defun C:Колонна (/ dimensionX dimensionY base R object oldOSM OldLAY)

 (defun *error*(msg) 
 (princ msg) ; Отменено пользователем
 (if oldOSM (setvar "OSMODE" oldOSM)) 
 ) 

 (setq OldLAY (getvar "clayer"))

 (setq oldOSM (getvar "osmode"))

 (setvar "osmode" 0)

 (initget 7)
 (setq dimensionX (getreal "Введите ширину колонны: "))
 (initget 7)
 (setq dimensionY (getreal "Введите толщину колонны: "))
 (setq base 
    (cond
         ((getpoint "\Введите точку вставки колонны <0,0,0> :"))
         (t '(0. 0. 0.)))
     ) 
 (setq pt1
     ( list ( - ( car base ) ( / dimensionX  2.0 ) )
            ( - (cadr base ) ( / dimensionY  2.0 ) )
     )
 )
 (setq pt2
     ( list ( - ( car base ) ( / dimensionX  2.0 ) )
            ( + (cadr base ) ( / dimensionY  2.0 ) )
     )
 )
 (setq pt3
     ( list ( + ( car base ) ( / dimensionX  2.0 ) )
            ( + (cadr base ) ( / dimensionY  2.0 ) )
     )
 )
 (setq pt4
     ( list ( + ( car base ) ( / dimensionX  2.0 ) )
            ( - (cadr base ) ( / dimensionY  2.0 ) )
     )
 )

 (Setq  R  ( / dimensionX  2.0 ))

 (command "_-layer" "_make" "Колонны" "_color" "red" "" "ltype" "" "" "_set" "Колонны" "")

 (command "_pline" pt1 pt2 pt3 pt4 "_c")

 (Setq object (entlast))

 (command "_circle" base R)

 (command "_chprop" "_l" "" "_color" "blue" "")

 (command "_rotate" object "" base pause)

 (setvar "clayer" OldLAY)

 (setvar "osmode" oldOSM)
)

[VVA]

До undo еще дойдем. В этой строке (пост #257)

Код:

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

(command "_-LAYER" "_make" "Колонны" "_color" "red" "" "ltype" "" "" "_set" "Колонны" "")

ты ДВАЖДЫ нарушил п.2 правил В локализованной версии работать не будет.
И еще:
1. Опция _make команды _-LAYER создает слой и делает его текущим. Позтому _set можно не применять
2. Тип линии слою мы не задаем. Тогда зачем вызывать опцию ltype да еще с нарушением п.2 правил

[andery]

2. Тип линии слою мы не задаем.

Почему? Если у нас уже существовал слой "колонна" с другим типом линии, а нам надо тип линии "continuous", то если не задавать тип линии - тип будет такой как был у существовавшего слоя колонна.

....
Можна усложнять дальше...

[ShaggyDoc]

Пока я справлял день рождения вы ушли вперед. Будем догонять

Так не пойдет. Забудь про ДР пока. Хотя, при желании и приложении собственных усилий можно и за месяц во всем разобраться.

[Red Nova]

VVA

ты ДВАЖДЫ нарушил п.2 правил В локализованной версии работать не будет.

С "red" я думал что так и надо. Не знал что и на цвета распространяется. А вот с "ltype" проглядел.

Тип линии слою мы не задаем

Это kpblc добавил к заданию.

[Red Nova]

ShaggyDoc,
К примеру с bool мне точно самому не разобраться.

[Red Nova]

VVA,
Вот вариант с ssadd

Код:

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

(defun C:Колонна (/ dimensionX dimensionY base R rotated_object selection1 oldOSM OldLAY)

 (defun *error*(msg) 
 (princ msg) ; Отменено пользователем
 (if oldOSM (setvar "OSMODE" oldOSM)) 
 ) 

 (setq OldLAY (getvar "clayer"))

 (setq oldOSM (getvar "osmode"))

 (setvar "osmode" 0)

 (initget 7)
 (setq dimensionX (getreal "Введите ширину колонны: "))
 (initget 7)
 (setq dimensionY (getreal "Введите толщину колонны: "))
 (setq base 
    (cond
         ((getpoint "\Введите точку вставки колонны <0,0,0> :"))
         (t '(0. 0. 0.)))
     ) 
 (setq pt1
     ( list ( - ( car base ) ( / dimensionX  2.0 ) )
            ( - (cadr base ) ( / dimensionY  2.0 ) )
     )
 )
 (setq pt2
     ( list ( - ( car base ) ( / dimensionX  2.0 ) )
            ( + (cadr base ) ( / dimensionY  2.0 ) )
     )
 )
 (setq pt3
     ( list ( + ( car base ) ( / dimensionX  2.0 ) )
            ( + (cadr base ) ( / dimensionY  2.0 ) )
     )
 )
 (setq pt4
     ( list ( + ( car base ) ( / dimensionX  2.0 ) )
            ( - (cadr base ) ( / dimensionY  2.0 ) )
     )
 )

 (Setq  R  ( / dimensionX  2.0 ))

 (setq selection1 (ssadd)) 

 (command "_-layer" "_make" "Колонны" "_color" "_red" "" "")

 (command "_pline" pt1 pt2 pt3 pt4 "_c")

 (Setq rotated_object (entlast))

 (ssadd (entlast) selection1)

 (command "_circle" base R)

 (ssadd (entlast) selection1)

 (command "_chprop" selection1 "" "_color" "blue" "")

 (command "_rotate" rotated_object "" base pause)

 (setvar "clayer" OldLAY)

 (setvar "osmode" oldOSM)
)

Догнал таки

[VVA]

Сообщение от andery Почему? Если у нас уже существовал слой "колонна" с другим типом линии, а нам надо тип линии "continuous", то если не задавать тип линии - тип будет такой как был у существовавшего слоя колонна.

В принците это зависит от ТЗ.

Можна усложнять дальше...

Будем разбираться с блоками.
Задание:
1.Колонну (круг исключаем) создадим ввиде блока и вставлять будем блоком.
2.Блок Колонна будет размером 1x1, при вставке длину и ширину будем задавать ввиде масштабных коэффициентов по X и Y.
3. Все элементы блока создаются цветом, типом, весом линии "ПОБЛОКУ" на слое "0"
4. Сам блок вставляется на слой "Колонна"
Алгоритм
1. Проверить существование блока "Колонна"
(функия tblsearch таблица "BLOCK", Перечень всех таблиц см. tblnext)
2. Если блока нет, то отрисовать блок в точке 0,0 с учетом п.2 и п.3 и создать определение блока (команда _-BLOCK
3. Запросить длину и ширину колонны
4. Создать слой "Колонна"
5. Вставить блок Колонна с маштабами X=Длина Y=Ширина. Запросить точку и угол поворота у пользователя. (Команда _-INSERT)
Обращаю внимание: Точку вставки запрашиваем не getpoint, а командой _insert. При этом блок с указанными размерами должен "висеть" на курсоре и ждать своей дальнейшей участи.
6. Восстановить все по как было

[Red Nova]

VVA,
Я правильно понял, это уже DXF Reference?

[Red Nova]

Пока понял только что можно искать так

Код:

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

 (tblsearch "block" "Колонна")

Вернет либо nil либо что-то запутанное.
Как на if повесить возвращенный nil не знаю.
И что вернет если не nil.
Из хелпа

Например: (tblsearch "style" "standard") устанавливает стиль текста может вернуть: ((0 . "STYLE") тип символа (2 . "STANDARD") имя символа (70 . 0) флажки (40 . 0.000000) фиксирование высоты (41 . 1.000000) фактор ширины (50 . 0.000000) угол (71 . 0) генерирование флажков (3 . "txt") самый первый font file (4 . "") большой font file ) Порядок вводов восстановлен из TBLNEXT без воздействия функции TBLSEARCH.

Что значет тут высказывание "может вернуть"? От чего зависит это "Может"? Что если мне нужно только одна строка из выше приведенных, или вовсе если нужно только два варианта T и nil.

[Alaspher]

Сообщение от Red Nova Я правильно понял, это уже DXF Reference?

Полагаю, что пока задача оперирования DXF не ставилась - по крайней мере, описанное задание вполне решается в рамках командного стиля.

Сообщение от Red Nova Пока понял только что можно искать так Код: [Выделить все] (tblsearch "block" "Колонна") Вернет либо nil либо что-то запутанное. Как на if повесить возвращенный nil не знаю. И что вернет если не nil.

Собственно тебе и надо выяснить nil вернётся или нет. В АвтоЛИСПе if любое не nil значение трактует, как тру, т.е.:

Код:

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

(if (tblsearch "block" "Колонна")
  (действие1)
  (действие2)
)

выполнит (действие1) при наличии блока "Колонна" и (действие2) в его отсутствие.

Если tblsearch возвращает не nil, то как раз это и есть DXF описание искомого объекта. Правда описание неполное и пригодное не для всего, но в данном случае это не существенно.

[Red Nova]

Alaspher, Спасибо.

Застрял на задании типа линии по блоку. В диалоге -layer не принимает ввод byblock.

[Кулик Алексей aka kpblc]

Создать слой с типом линии "ByBlock" или "ByLayer" можно (чисто программно), но устойчивость AutoCAD'a в таком случае оставляет желать лучшего

[Red Nova]

Как же быть тогда с заданием от VVA?

Все элементы блока создаются цветом, типом, весом линии "ПОБЛОКУ" на "0"

[Alaspher]

Придётся воспользоваться командой "_chprop" или _-linetype (если для типа линий) алгоритм, при использовании этих команд, будет разный, но результат может быть одинаковым.

[Red Nova]

Ну тогда так. (может и не совсем в том порядке, что просил VVA, но работает)

Код:

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

(defun C:Колонна (/ dimensionX dimensionY base oldOSM OldLAY)

 (defun *error*(msg) 
 (princ msg) ; Отменено пользователем
 (if oldOSM (setvar "OSMODE" oldOSM)) 
 ) 

 (setq OldLAY (getvar "clayer"))

 (setq oldOSM (getvar "osmode"))

 (setvar "osmode" 0)

 (initget 7)
 (setq dimensionX (getreal "Введите ширину колонны: "))
 (initget 7)
 (setq dimensionY (getreal "Введите толщину колонны: "))
 (setq base 
    (cond
         ((getpoint "\Введите точку вставки колонны <0,0,0> :"))
         (t '(0. 0. 0.)))
     ) 

 (if (tblsearch "block" "Колонна")
 
   ((command "_-insert" "Колонна" base dimensionX dimensionY pause))

   ( (command "_-layer" "_set" "0" "")
     (command "_rectang" "-0.5,-0.5" "0.5,0.5")
     (command "_chprop" "_last" "" "_color" "_byblock" "_ltype" "_byblock" "_lweight" "_byblock" "")
     (command "_-block" "Колонна" "0,0" "_last" "")
     (command "_-insert" "Колонна" base dimensionX dimensionY pause)
   )
 )

 (setvar "clayer" OldLAY)

 (setvar "osmode" oldOSM)
)

[Кулик Алексей aka kpblc]

А еще лучше воспользоваться системными переменными clayer, celtype, cecolor...

[Red Nova]

Кулик Алексей aka kpblc,
А как тогда быть с lweight?

[Alaspher]

Есть ошибки в коде

Сообщение от Red Nova Код: [Выделить все] (if (tblsearch "block" "Колонна") ((command "_-insert" "Колонна" base dimensionX dimensionY pause)) (progn (command "_-layer" "_set" "0" "") (command "_rectang" "-0.5,-0.5" "0.5,0.5") (command "_chprop" "_last" "" "_color" "_byblock" "_ltype" "_byblock" "_lweight" "_byblock" "") (command "_-block" "Колонна" "0,0" "_last" "") (command "_-insert" "Колонна" base dimensionX dimensionY pause) ) )

Красные скобки лишние, зелёная функция пропущена.

[Red Nova]

Alaspher,

((command "_-insert" "Колонна" base dimensionX dimensionY pause))

Тут и я сомневался, но работает и так.

(progn (command "_-layer" "_set" "0" "") (command "_rectang" "-0.5,-0.5" "0.5,0.5") (command "_chprop" "_last" "" "_color" "_byblock" "_ltype" "_byblock" "_lweight" "_byblock" "") (command "_-block" "Колонна" "0,0" "_last" "") (command "_-insert" "Колонна" base dimensionX dimensionY pause) )

А тут я не знаю что сказать. вроде по логике ты прав. Но ведь и без progn работает.

[Alaspher]

Ну вообще - не должно работать так как было. Проверил - у меня не работает.

[VVA]

Сообщение от Red Nova VVA, Я правильно понял, это уже DXF Reference?

Нет. В DXF ме не лезем. Все это можно сделать командами.

Застрял на задании типа линии по блоку. В диалоге -layer не принимает ввод byblock

Нигде не говорилось,что нужно задавать слою тип byblock. Но никто не запрещает сделать его (цвет, тип линии) текущим до отрисовки полилинии или изменить через _change или _chprop после.

А как тогда быть с lweight?

А посмотреть не CE*?

Команда: _setvar Имя переменной или [?]: ? Список переменных для вывода <*>: CE* CECOLOR "ПОСЛОЮ" CELTSCALE 1.0000 CELTYPE "ПОСЛОЮ" CELWEIGHT -1 CENTERMT 0

А тут я не знаю что сказать. вроде по логике ты прав. Но ведь и без progn работает.

Не работает.

Код:

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

(if ПРОВЕРКА
(ПРОВЕРКА=ИСТИНА)
(ПРОВЕРКА=ЛОЖЬ)
)

Так вот (ПРОВЕРКА=ИСТИНА) и (ПРОВЕРКА=ЛОЖЬ) это ОДНО действие. И назначение оператора PROGN как раз для того, чтобы куча твоих commnad трактовались как ОДНО действие и попадали соответственно в ветку ИСТИНА или ЛОЖЬ

[VVA]

Red Nova, Твоя команда нарушает п.5 задания. Я даже специяльно обратил на это внимание.

[Red Nova]

VVA,

Но ведь и без progn работает. Не работает.

А у меня работает, но раз надо, то поправлю.

Твоя команда нарушает п.5 задания. Я даже специяльно обратил на это внимание.

Меня это предложение смутило

При этом блок с указанными размерами должен "висеть" на курсоре и ждать своей дальнейшей участи.

[VVA]

Сообщение от Red Nova Меня это предложение смутило При этом блок с указанными размерами должен "висеть" на курсоре и ждать своей дальнейшей участи.

А что тут такого. Куда повел курсор - туда и блок полетел, причет с указанными ранее размерами.
(подсказа: команда _-INSERT опции _X и _Y)

[Red Nova]

Вот что-то подобное. Смущает то, что блок сперва в исходном масштабе висит на курсоре, и только в конце принимает нужный масштаб. А еще не знаю как сюда впихнуть координату вставки по умолчанию 0.0.

Код:

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

(defun C:Колонна (/ dimensionX dimensionY base oldOSM OldLAY)

 (defun *error*(msg) 
 (princ msg) ; Отменено пользователем
 (if oldOSM (setvar "OSMODE" oldOSM)) 
 ) 

 (setq OldLAY (getvar "clayer"))

 (setq oldOSM (getvar "osmode"))

 (setvar "osmode" 0)

 (initget 7)
 (setq dimensionX (getreal "Введите ширину колонны: "))
 (initget 7)
 (setq dimensionY (getreal "Введите толщину колонны: "))


 (if (tblsearch "block" "Колонна")
 
   (command "_-insert" "Колонна" pause dimensionX dimensionY pause)

   ( progn (command "_-layer" "_set" "0" "")
           (command "_rectang" "-0.5,-0.5" "0.5,0.5")
           (command "_chprop" "_last" "" "_color" "_byblock" "_ltype" "_byblock" "_lweight" "_byblock" "")
           (command "_-block" "Колонна" "0,0" "_last" "")
           (command "_-insert" "Колонна" pause dimensionX dimensionY pause)
   )
 )

 (setvar "clayer" OldLAY)

 (setvar "osmode" oldOSM)
)

[VVA]

Red Nova,

Смущает то, что блок сперва в исходном масштабе висит на курсоре,

См. подсказку в #282

*** Добавлено
И логика хромает. Получается если блока нет, то он создается. Но чтобы его вставить нужно повторно выполнить команду.
Нужно так

Код:

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

(if БЛОКА НЕТ?
 (progn
  ДА БЛОКА НЕТ. СОЗДАЕМ БЛОК
 );_конец progn
  );_<- ЗАКОНЧИЛИ IF
INSERT блок в ЛЮБОМ случае

[Red Nova]

VVA,
На сколько я понял у -insert есть определенная последовательность.
Сначала запрашивается имя блока, после его ввода блок и до указания мышкой точки вставки блок будет висеть на курсоре в исходном масштабе, потом уже запрашиваются параметры X и Y. Может можно сделать так, чтобы параметры X и Y запрашивались до вставки блока?

[VVA]

На сколько я понял у -insert есть определенная последовательность.

Если сомневаешься проверь на практике. Тем более вроде как ученый и научный метод (метод тыка) должен быть известен. Создай блок (например с именем 1 из круга).
В командной строке введи _-insert, затем 1 (имя блока) и не указывая точку вставки введи _X, затем 2 и посмотри что будет висеть на курсоре.
А так же там есть опции _PX, _PY

[Red Nova]

Тогда так

Код:

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

(defun C:Колонна (/ dimensionX dimensionY base oldOSM OldLAY)

 (defun *error*(msg) 
 (princ msg) ; Отменено пользователем
 (if oldOSM (setvar "OSMODE" oldOSM)) 
 ) 

 (setq OldLAY (getvar "clayer"))

 (setq oldOSM (getvar "osmode"))

 (setvar "osmode" 0)

 (initget 7)
 (setq dimensionX (getreal "Введите ширину колонны: "))
 (initget 7)
 (setq dimensionY (getreal "Введите толщину колонны: "))


 (if (tblsearch "block" "Колонна")
 
   (command "_-insert" "Колонна" "_x" dimensionX "_y" dimensionY pause)

   ( progn (command "_-layer" "_set" "0" "")
           (command "_rectang" "-0.5,-0.5" "0.5,0.5")
           (command "_chprop" "_last" "" "_color" "_byblock" "_ltype" "_byblock" "_lweight" "_byblock" "")
           (command "_-block" "Колонна" "0,0" "_last" "")
           (command "_-insert" "Колонна" "_x" dimensionX "_y" dimensionY pause)
   )
 )

 (setvar "clayer" OldLAY)

 (setvar "osmode" oldOSM)
)

[VVA]

Прочитай ***Добавлено в # 284 + ты не закончил команду _-INSERT: у тебя пауза на точку вставки, а там есть еще запрос угла поворота

[Red Nova]

VVA,

у тебя пауза на точку вставки, а там есть еще запрос угла поворота

Может ты имеешь в виду что pause надо два раза писать? У меня и так все работает нормально.

Получается если блока нет, то он создается. Но чтобы его вставить нужно повторно выполнить команду.

Можно и так

Код:

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

(defun C:Колонна (/ dimensionX dimensionY base oldOSM OldLAY)

 (defun *error*(msg) 
 (princ msg) ; Отменено пользователем
 (if oldOSM (setvar "OSMODE" oldOSM)) 
 ) 

 (setq OldLAY (getvar "clayer"))

 (setq oldOSM (getvar "osmode"))

 (setvar "osmode" 0)

 (initget 7)
 (setq dimensionX (getreal "Введите ширину колонны: "))
 (initget 7)
 (setq dimensionY (getreal "Введите толщину колонны: "))


 (if (tblsearch "block" "Колонна")
 
   ()

   ( progn (command "_-layer" "_set" "0" "")
           (command "_rectang" "-0.5,-0.5" "0.5,0.5")
           (command "_chprop" "_last" "" "_color" "_byblock" "_ltype" "_byblock" "_lweight" "_byblock" "")
           (command "_-block" "Колонна" "0,0" "_last" "")
   )
 )

 (command "_-insert" "Колонна" "_x" dimensionX "_y" dimensionY pause)

 (setvar "clayer" OldLAY)

 (setvar "osmode" oldOSM)
)

[VVA]

Может ты имеешь в виду что pause надо два раза писать? У меня и так все работает нормально.

Это пока.
Восстанавливаем круг.
После вставки блока "Колонна" нужно отрисовать круг с цетром в точке вставки колонны и радиусом = размер по X
(Подстазка - переменная LASTPOINT)

[Red Nova]

VVA,

Может ты имеешь в виду что pause надо два раза писать? У меня и так все работает нормально. Это пока.

Понял в чем подвох.

Код:

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

(defun C:Колонна (/ dimensionX dimensionY base oldOSM OldLAY)

 (defun *error*(msg) 
 (princ msg) ; Отменено пользователем
 (if oldOSM (setvar "osmode" oldOSM)) 
 ) 

 (setq OldLAY (getvar "clayer"))

 (setq oldOSM (getvar "osmode"))

 (setvar "osmode" 0)

 (initget 7)
 (setq dimensionX (getreal "Введите ширину колонны: "))
 (initget 7)
 (setq dimensionY (getreal "Введите толщину колонны: "))


 (if (tblsearch "block" "Колонна")
 
   ()

   ( progn (command "_-layer" "_set" "0" "")
           (command "_rectang" "-0.5,-0.5" "0.5,0.5")
           (command "_chprop" "_last" "" "_color" "_byblock" "_ltype" "_byblock" "_lweight" "_byblock" "")
           (command "_-block" "Колонна" "0,0" "_last" "")
   )
 )

 (command "_-insert" "Колонна" "_x" dimensionX "_y" dimensionY pause pause)

 (command "_circle" (getvar "lastpoint") (/ dimensionX 2) "")

 (setvar "clayer" OldLAY)

 (setvar "osmode" oldOSM)
)

[Alaspher]

Подобная конструкция

Сообщение от Red Nova Код: [Выделить все] (if (tblsearch "block" "Колонна") () ( progn (command "_-layer" "_set" "0" "") (command "_rectang" "-0.5,-0.5" "0.5,0.5") (command "_chprop" "_last" "" "_color" "_byblock" "_ltype" "_byblock" "_lweight" "_byblock" "") (command "_-block" "Колонна" "0,0" "_last" "") ) )

в ЛИСПе не принята.

Если единственным условием для отработки участка кода является отсутствие искомого значения, лучше использовать такую запись:

Код:

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

(if (not (tblsearch "block" "Колонна"))
  (progn
    (command "_-layer" "_set" "0" "")
    (command "_rectang" "-0.5,-0.5" "0.5,0.5")
    (command "_chprop" "_last" "" "_color" "_byblock" "_ltype" "_byblock" "_lweight" "_byblock" "")
    (command "_-block" "Колонна" "0,0" "_last" "")
  )
)

[Red Nova]

Я и не знал про not

[Кулик Алексей aka kpblc]

Стандартная функция "отрицания"

[VVA]

Red Nova В #284 Когда писал это

Сообщение от VVA Red Nova, *** Добавлено И логика хромает. Получается если блока нет, то он создается. Но чтобы его вставить нужно повторно выполнить команду. Нужно так Код: [Выделить все] (if БЛОКА НЕТ? (progn ДА БЛОКА НЕТ. СОЗДАЕМ БЛОК );_конец progn );_<- ЗАКОНЧИЛИ IF INSERT блок в ЛЮБОМ случае

И имел ввиду, что
БЛОКА НЕТ? = (not (tblsearch "block" "Колонна"))
В остальном гораздо лучше чем в начале темы, но

1. Блок не вставляется на слой Колонна
2. В конце и при ошибке предыдущий слой не сосстанавливается
3. При отрисовке колонны не восстанавливаются предыдущие слой, цвет и тип линии. В результате круг рисуется со свойствами "Поблоку"

*** Добавлено
Когда я начинал изучать Лисп (это был или 1991 или 1992 год) то интернета не было, но у нас был официально куплен Автокад R10, был справочник по AutoLISP и никто его не знал . Я ставил перед собой маленькую задачу типа: "Нужно запросить у пользователя точку", брал справочник и читая описание каждой ф-ции искал подходящую, найдя - пробывал.
Это я про

Я и не знал про not

[Red Nova]

VVA,
Тогда так

Код:

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

(defun C:Колонна (/ dimensionX dimensionY oldOSM OldLAY)

 (defun *error*(msg) 
 (princ msg) ; Отменено пользователем
 (if oldOSM (setvar "osmode" oldOSM)) 
 (if OldLAY (setvar "clayer" OldLAY)) 
 ) 

 (setq OldLAY (getvar "clayer"))

 (setq oldOSM (getvar "osmode"))

 (setvar "osmode" 0)

 (initget 7)
 (setq dimensionX (getreal "Введите ширину колонны: "))
 (initget 7)
 (setq dimensionY (getreal "Введите толщину колонны: "))

 (if (not (tblsearch "block" "Колонна"))
   (progn
     (command "_-layer" "_set" "0" "")
     (command "_rectang" "-0.5,-0.5" "0.5,0.5")
     (command "_chprop" "_last" "" "_color" "_byblock" "_ltype" "_byblock" "_lweight" "_byblock" "")
     (command "_-block" "Колонна" "0,0" "_last" "")
   )
 )

 (command "_-layer" "_make" "Колонна" "")

 (command "_-insert" "Колонна" "_x" dimensionX "_y" dimensionY pause pause)

 (setvar "clayer" OldLAY)

 (command "_circle" (getvar "lastpoint") (/ dimensionX 2) "")

 (setvar "osmode" oldOSM)
)

[Red Nova]

Хочу новое задание

[VVA]

Ну тогда так:
Хочу задать длину и ширину и вставлять колонны-БЛОКИ пока не посинею или мышь не задымится

[Red Nova]

А подсказки не будет?

[Кулик Алексей aka kpblc]

Еще задача - подсчитать количество колонн, с сортировкой по габаритам. Типа "400х600 - 20 шт; 200х800 - 1 шт."

[VVA]

Общее для всех методов:
Сначала блок _insert'ом вставляем в укромное место, а затем из этого укромного места что-то с ним делаем

По возрастанию предпочтения и сложности
1.вставить блок в точку 0,0 и вызвать copy, затем блок в точке 0,0 удалить (предварительно запомнив)
2.Вставить блок в 0,0. Copyclip, удалить блок и в цикле pasteclip.
3. В цикле
Вставить блок в 0,0.
И использовать _CHANGE режим точка изменения
(Пояснение Команда _CHANGE (режим точка изменения. Т.е.
_change
выбрать блок
на запрос "очка изменения или [Свойства]" нажать enter и посмотреть на запросы дальше
)
Общее для всех вариантов условие выхода из цикла:
не изменилась LASTPOINT (пользователь не указал точку, а нажал ввод)

*** Добавлено
Здесь можно посмотреть пример
http://dwg.ru/f/showpost.php?p=91119&postcount=41

[Red Nova]

VVA,
Хотел пойти по третьему пути. Понял что нужно использовать while, а внутрь его всунуть if, но как получить nil в результате ввода enter ?

[VVA]

Сообщение от Red Nova VVA, Хотел пойти по третьему пути. Понял что нужно использовать while, а внутрь его всунуть if, но как получить nil в результате ввода enter ?

Если использовать Change, то команда просто завершится. Нужно анализировать изменилать ли после _change LASTPOINT. Если да, то пользователь ткнул точку и цикл нужно продолжать, если нет - нажал ENTER и цикл нужно прекратить
Посмотри как это сделано во 2-м лиспе по ссылке с поста #301

[Red Nova]

VVA, Попытался понять твой лисп #301. По возможности изучил новые функции оттуда. Не совсем все понял, но вроде как надумал один вариант на основе твоего.
Принцип такой.
Создаю цикл при помощи while. В нем вставляется колонна (в 0.0), затем применяется change, запоминаются точка 0.0 и вставленный последним блок. Затем lastpoint присваивается новой переменной, и мы начинаем вставлять блок в разные точки. функцией If проверяем равенство двух переменных отвечающих за последнюю и первую точку вставки, как только нажимаем энтер, то блок вставляется в начальную точку, и две переменные уравниваются. Как только ловится это условие, то последний блок удаляется, цикл прекращается. Написать это так чтобы заработало само собой не получилось. Да и задумка наверное не верная. Вот код.

Код:

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

 (while get_nil 
      (progn (princ "\Укажите ТОЧКУ (ENTER-Хватит):")
             (command "_-insert" "Колонна" "_x" dimensionX "_y" dimensionY "0,0" "")
             (setq pt0 (getvar "lastpoint"))
             (setq blk entlast)
             (command "_change" blk "" "" pause pause)
      )
 )

 (setq pt1 (getvar "lastpoint"))

 (if (equal pt0 pt1 0.000001)
     (progn (entdel blk)
            (setq get_nil nil))
 )

А твою задумку до конца не понял
Почему в цикле while только princ?
Зачем тебе в If вторая часть?

(setq pt (getvar "LASTPOINT") tt t)

зачем тут после [](setq pt (getvar "LASTPOINT") ] идет [tt t)]?
Почему не сравнить последнюю точку "LASTPOINT" с точкой 0,0? Зачем при этом две переменные, ведь можно и одной. Типа повторяем цикл, как только переменная с "LASTPOINT" попадает в 0,0, то цикл завершен.

[VVA]

Задумка верная. Только

1. entlast нужно писать так (entlast)
2. Цикл while завершать в конце.
3. При таком подходе если пользователь нажмет ввод, то вынужден будет еще ответить на угол поворота

Вот модифицированный вариант с коментариями

Код:

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

(setq get_nil t) ;_Устанавливаем флаг
(while get_nil   ;_ Проверяем состояние флага
  (princ "\Укажите ТОЧКУ (ENTER-Хватит):")
  (command "_-insert" "Колонна"	"_x" dimensionX	"_y" dimensionY	"0,0" "") ;_ end of command
  (setq pt0 (getvar "lastpoint"))
  (setq blk (entlast))
  (command "_change" blk "" "" pause) ;_В команде Change ждем указания точки
  (setq pt1 (getvar "lastpoint")) ;_Запоминаем
                                  ;_Команда CHANGE активна!!! Запрашивает угол поворота

  (if (equal pt0 pt1 0.000001) ;_Сравниваем точки
    (progn ;_Точка не изменилась - нажат Enter
      (command "") ;_Завершаем команду Change нажатием Enter
      (entdel blk) ;_Удаляем блок
      (setq get_nil nil) ;_Сбрасываем флаг
    ) ;_ end of progn
    (progn ;_Иначе. Точка изменилась
      (command pause) ;_Завершаем команду Change. Ждем от пользователя указания угла поворота
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of while

А так

Правильным курсом идете, товарищи! (c) Диктор ЦТ во время демонстрации 1-го мая

[Red Nova]

VVA, Пока не заработало.

Код:

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

(defun C:колонна (/ dimensionX dimensionY oldOSM OldLAY)

 (defun *error*(msg) 
 (princ msg) ; Отменено пользователем
 (if oldOSM (setvar "osmode" oldOSM)) 
 (if OldLAY (setvar "clayer" OldLAY)) 
 ) 

 (setq OldLAY (getvar "clayer"))

 (setq oldOSM (getvar "osmode"))

 (setvar "osmode" 0)

 (initget 7)
 (setq dimensionX (getreal "Введите ширину колонны: "))
 (initget 7)
 (setq dimensionY (getreal "Введите толщину колонны: "))

 (if (not (tblsearch "block" "Колонна"))
   (progn
     (command "_-layer" "_set" "0" "")
     (command "_rectang" "-0.5,-0.5" "0.5,0.5")
     (command "_chprop" "_last" "" "_color" "_byblock" "_ltype" "_byblock" "_lweight" "_byblock" "")
     (command "_-block" "Колонна" "0,0" "_last" "")
   )
 )

 (command "_-layer" "_make" "Колонна" "")

 (setq get_nil t) ;_Устанавливаем флаг
(while get_nil
  (princ "\Укажите ТОЧКУ (ENTER-Хватит):")
  (command "_-insert" "Колонна" "_x" dimensionX "_y" dimensionY "0,0" "")
  (setq pt0 (getvar "lastpoint"))
  (setq blk (entlast))
  (command "_change" blk "" "" pause)
  (setq pt1 (getvar "lastpoint"))
 (if (equal pt0 pt1 0.000001)
    (progn
      (command "") ;_Завершаем команду Change нажатием Enter
      (entdel blk)
      (setq get_nil nil) ;_Сбрасываем флаг
     ) ;_ end of progn
    (progn
      (command pause) ;_Завершаем команду Change. Ждем от пользователя указания угла поворота
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of while


 (setvar "clayer" OldLAY)

 (command "_circle" (getvar "lastpoint") (/ dimensionX 2) "")

 (setvar "osmode" oldOSM)
)

[Кулик Алексей aka kpblc]

Вот интересно, если код пишется для AutoCAD'a, то почему не использовать vl-cmdf и его особенности?

[Red Nova]

Кулик Алексей aka kpblc,
Дай подсказку к своему заданию по поводу подсчета блоков пожалста.

[Кулик Алексей aka kpblc]

Получаешь набор блоков (с фильтрацией по имени), проход по каждому элементу. Забрать "габариты"; если "габариты" уже есть в списке результатов, то для этого элемента увеличить счетчик.
Понадобятся функции ssget, ssname, assoc, member, subst, cons.

[VVA]

VVA, Пока не заработало

Что ты имел ввиду? Код из #306 работает. Только

Код:

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

(command "_circle" (getvar "lastpoint") (/ dimensionX 2) "")

Надо поставить после

Код:

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

(command pause) ;_Завершаем команду Change. Ждем от пользователя указания угла поворота

[Red Nova]

VVA,
Поправил, теперь работает.

Код:

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

(defun C:колонна (/ dimensionX dimensionY oldOSM OldLAY get_nil pt0 pt1 )

 (defun *error*(msg) 
 (princ msg) ; Отменено пользователем
 (if oldOSM (setvar "osmode" oldOSM)) 
 (if OldLAY (setvar "clayer" OldLAY)) 
 ) 

 (setq OldLAY (getvar "clayer"))

 (setq oldOSM (getvar "osmode"))

 (setvar "osmode" 0)

 (initget 7)
 (setq dimensionX (getreal "Введите ширину колонны: "))
 (initget 7)
 (setq dimensionY (getreal "Введите толщину колонны: "))

 (if (not (tblsearch "block" "Колонна"))
   (progn
     (command "_-layer" "_set" "0" "")
     (command "_rectang" "-0.5,-0.5" "0.5,0.5")
     (command "_chprop" "_last" "" "_color" "_byblock" "_ltype" "_byblock" "_lweight" "_byblock" "")
     (command "_-block" "Колонна" "0,0" "_last" "")
   )
 )

 (command "_-layer" "_make" "Колонна" "")

 (setq get_nil t) ;_Устанавливаем флаг
(while get_nil
  (princ "\Укажите ТОЧКУ (ENTER-Хватит):")
  (command "_-insert" "Колонна" "_x" dimensionX "_y" dimensionY "0,0" "")
  (setq pt0 (getvar "lastpoint"))
  (setq blk (entlast))
  (command "_change" blk "" "" pause)
  (setq pt1 (getvar "lastpoint"))
 (if (equal pt0 pt1 0.000001)
    (progn
      (command "") ;_Завершаем команду Change нажатием Enter
      (entdel blk)
      (setq get_nil nil) ;_Сбрасываем флаг
     ) ;_ end of progn
    (progn
      (command pause) ;_Завершаем команду Change. Ждем от пользователя указания угла поворота
      (command "_circle" (getvar "lastpoint") (/ dimensionX 2) "")
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of while


 (setvar "clayer" OldLAY)


 (setvar "osmode" oldOSM)
)

[Red Nova]

Кулик Алексей aka kpblc,
Вроде можно выбрать все блоки “колонна” вот так

Код:

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

(setq ss1 (ssget "_X" '((0 . "BLOCK") (2 . "Колонна"))))

Тогда дальше надо пройти по списку пока он не кончится и извлечь данные scale X и scale Y.
Выбрать очередной элемент можно так (загнав в цикл)

Код:

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

 (setq number 0)
 (ssname ss1 (+ number 0))
 (setq number (+ number 1))

Но нам вернется имя объекта, как это имя преобразовать в структурированный список со свойствами я не знаю. Если предположить что уже имеем структурированный список, то забрать определенное свойство и преобразовать их в список можно так.

Код:

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

(setq ss2 list (
             (assoc 'scale_x (некий структурированный список текущего блока))
             (assoc 'scale_y (некий структурированный список текущего блока))
         );end of list
);end of setq

Потом уже можно думать про счетчик.
Зачем нужны member, subst, cons пока не понял

[Дима_]

Смотри команды entget, assoc и dxf reference.
p.s. Когда до VB дойдешь, я тоже присоеденюсь - в качестве чайника.

[Кулик Алексей aka kpblc]

Примерно так (код не гонял и не проверял совсем):

Код:

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

(defun test (/ selset res x y)
  (if (setq selset (ssget '((0 . "INSERT") (2 . "Колонна"))))
    (foreach item (_dwgru-conv-pickset-to-list selset)
      (if (member (setq size (strcat (rtos (cdr (assoc 41 (entget item))) 2 4)
                                     "x"
                                     (rtos (cdr (assoc 42 (entget item))) 2 4)
                                     ) ;_ end of strcat
                        ) ;_ end of setq
                  (mapcar 'car res)
                  ) ;_ end of member
        (setq res (subst (cons size (1+ (cdr (assoc size res))))
                         (assoc size res)
                         res
                         ) ;_ end of subst
              ) ;_ end of setq
        (setq res (cons (cons size 1) res))
        ) ;_ end of if
      ) ;_ end of foreach
    ) ;_ end of if
  ) ;_ end of defun

[Red Nova]

Кулик Алексей aka kpblc,
Их хелпа

(foreach <имя> <список> <выражение>...) Эта функция, проходя по <списку>, присваивает каждому элементу <имя> и вычисляет каждое <выражение> для каждого элемента в списке. Может быть задано любое число <выражений>. FOREACH выдает результат последнего, вычисленного <выражения>

я так понял, что у тебя
item = <имя>,
(_dwgru-conv-pickset-to-list selset) = <список>
(if (member ...............)) = <выражение>

Что такое (_dwgru-conv-pickset-to-list selset)? Если это функция разработанная на этом сайте, то почему ее нет в коде?
Про остальное пока молчу. Непонятного много пока.

VVA Жду еще задания

[Кулик Алексей aka kpblc]

В подписи см. библиотека DwgRuLispLib.

[Red Nova]

kpblc,
Нашел по поиску только в этом топике, на #21. В библиотеке нету.

[Кулик Алексей aka kpblc]

http://dwg.ru/f/showpost.php?p=188342&postcount=21

[Red Nova]

Кулик Алексей aka kpblc, ]
Пытаюсь понять структуру функции (_dwgru-conv-pickset-to-list selset). Начал с самой внутренней строчки. Там такое

Код:

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

(1- item)

Как это понять. Ведь в лиспе другая форма записи. Разве минус не должен быть спереди?

[Кулик Алексей aka kpblc]

Запусти в VLIDE следующие строки:

Код:

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

(setq count 100)
(1+ count)
(1- count)

И посмотри результат

[ShaggyDoc]

Разве минус не должен быть спереди

Символ "-" это не просто "минус", и не оператор "отнимания", а имя функции.
"1-" или "1+" это тоже имена функций. Странные такие, но все равно имена. Этим функциям передается аргументом целое число, результат (сам догадайся).

[Alaspher]

Сообщение от ShaggyDoc Этим функциям передается аргументом целое число...

Поправка - любое число.

[Дима_]

Ну тогда уж любое вещественное число.

[Alaspher]

Сообщение от Дима_ Ну тогда уж любое вещественное число.

С учётом контекста (AutoLISP) "любое число" тождественно "любому вещественному числу", а точнее - "любому рациональному числу" (и то с некоторыми ограничениями), поскольку сам язык не позволяет выйти за эти рамки. В хэлпе дано в варианте "Any number", что подразумевает любое число допустимое в AutoLISP.

[Дима_]

И вообще фулдить на уроках...
P.S. не удержался - (1+ (sqrt 2)) - работает, а значит и ирациональному.

[Red Nova]

Тогда еще вопрос. Как понять это

Код:

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

(setq tab  nil item (sslength value))

Я до сих пор не встречал после setq сразу 4 элемента. Разве их не должно быть только 2

[Alaspher]

Сообщение от Дима_ И вообще фулдить на уроках... P.S. не удержался - (1+ (sqrt 2)) - работает, а значит и ирациональному.

Ну это не флуд вообще-то. Понимание того, как работает интерпретатор языка отчасти страхует от сюрпризов в результатах.

В выражении [FONT=Courier New](1+ (sqrt 2))[/FONT] на вход функции [FONT=Courier New]1+[/FONT] будет подан результат выполнения функции [FONT=Courier New]sqrt[/FONT] фиксированной точности, т.е. рациональное число, где вся "иррациональность" будет уже потеряна - [FONT=Courier New]1+[/FONT] ничего "не знает" об источнике своего аргумента, если так можно выразиться.

[Alaspher]

Сообщение от Red Nova Тогда еще вопрос. Как понять это Код: [Выделить все] (setq tab nil item (sslength value)) Я до сих пор не встречал после setq сразу 4 элемента. Разве их не должно быть только 2

Да, может быть любое чётное количество аргументов, нечётные трактуются, как символы и им присваиаваются значения чётных.

Код:

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

(setq tab  nil item (sslength value))

Равносильно:

Код:

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

(setq tab  nil)
(setq item (sslength value))

[Red Nova]

А как понять это

Код:

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

(repeat (setq tab  nil
                item (sslength value)
                ) ;_ end setq
    (setq tab (cons (ssname value (setq item (1- item))) tab))
    ) ;_ end repeatА как понять это

Из хелпа знаю что

(repeat <число> <выражение>...) В этой функции <число> представляется любой положительной целой величиной. Функция выполняет каждое <выражение> заданное <число> раз и возвращает значение последнего выражения.

То есть форма такая
repeat <число> <выражение>
А у нас вместо <числа>
(setq tab nil item (sslength value))
Как ни кручу это выражение не может вернуть число.

[Кулик Алексей aka kpblc]

Код:

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

(setq tab  nil
                item (sslength value)
                )

Вернет значение item.
P.S. Непонятные куски запускай в консоли vlide - понимания будет больше )

[Дима_]

Сообщение от Alaspher Ну это не флуд вообще-то. Понимание того, как работает интерпретатор языка отчасти страхует от сюрпризов в результатах. В выражении [FONT=Courier New](1+ (sqrt 2))[/FONT] на вход функции [FONT=Courier New]1+[/FONT] будет подан результат выполнения функции [FONT=Courier New]sqrt[/FONT] фиксированной точности, т.е. рациональное число, где вся "иррациональность" будет уже потеряна - [FONT=Courier New]1+[/FONT] ничего "не знает" об источнике своего аргумента, если так можно выразиться.

В том то и дело, что ИНТЕРПРИТАТОР иначе как вы объямните эти примеры:
1. (* (1- (1+ (sqrt 2))) (1+ (1- (sqrt 2))))
2.0;
2. (* 100000000000000000000 (/ 10 3.0))
3.33333e+020;
3. (* 6.0 (/ 20.0 3.0))
40.0;
- по Вашей логике (если числа выдаються с определенной точностью) ответы должны другими получаться.

[Alaspher]

Сообщение от Дима_ - по Вашей логике (если числа выдаються с определенной точностью) ответы должны другими получаться.

Не обязательно - если сохранять все промежуточные результаты в переменных, то окончательный результат не изменится, т.е. в данных случаях просто округление происходит в "правильную" сторону.

[Кулик Алексей aka kpblc]

1. (1- (1+ (sqrt 2))) -> (sqrt 2)
(1+ (1- (sqrt 2))) -> (sqrt 2)
(* (sqrt 2) (sqrt 2)) -> 2.0
Так что все логично
2. (/ 10 3.0) -> 10/3
(* 1e20 10/3) да простят меня профессионалы -> (/ 1e21 3.) -> воспользуюсь математической записью 3.(3) * 10^20:
3.

[Red Nova]

kpblc, Вот что отвечает Vlide

_$ (setq tab nil item (sslength value) ) ; error: bad argument type: lselsetp nil _$

[Кулик Алексей aka kpblc]

А перед этим сделать (setq value (ssget)) попробуй

[Red Nova]

У меня проблема с пониманием смысла value в данном коде, да и вообще с пониманием понятия аргумент.
Смысл переменной был понятен сразу. Ей можно присваивать разные значения. А какую роль играют аргументы не пойму.
Вот к примеру тут

Код:

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

(defun _dwgru-conv-pickset-to-list (value / tab item)
  (repeat (setq tab  nil
                item (sslength value)
                ) ;_ end setq
    (setq tab (cons (ssname value (setq item (1- item))) tab))
    ) ;_ end repeat
  ) ;_ end defun

В строке

Код:

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

(setq tab  nil
                item (sslength value)
                ) ;_ end setq

мы даем переменной item значение равное количеству выбора value. Но ведь value еще не чем не определено. Что за элементы в него входят? Сколько их?
Извиняюсь за черепашье мышление.

[Кулик Алексей aka kpblc]

В данном случае value не "любое", а именно pickset - то есть результат (ssget). При вызове, аналогичном

Код:

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

(_dwgru-conv-pickset-to-list (ssget))

value уже получает значение сформированного набора. И потом обрабатывается.

[Дима_]

Сообщение от Alaspher Не обязательно - если сохранять все промежуточные результаты в переменных, то окончательный результат не изменится, т.е. в данных случаях просто округление происходит в "правильную" сторону.

Как вариант - а есть идеи как можно проверить каким способом он работает? (то есть проверить хранит он в переменнной число с определенной точностью а при значениях близких к "круглым" - округляет или-же иррациональное выражение).

[Red Nova]

То есть получается, что вызывая

Код:

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

(_dwgru-conv-pickset-to-list selset)

Мы задаем value значение selset?

[Кулик Алексей aka kpblc]

Ну типа того (если я только не запутался окончательно)

[Red Nova]

Получается мы записываем в список tab имена всех элементов списка selset. А что возвращает функция (_dwgru-conv-pickset-to-list selset)? Полученный список tab?

[Red Nova]

То есть смысл (_dwgru-conv-pickset-to-list selset) в данном коде это преобразование набора в список имен элементов в него входящих?

[ShaggyDoc]

Сообщение от Red Nova То есть смысл (_dwgru-conv-pickset-to-list selset) в данном коде это преобразование набора в список имен элементов в него входящих?

Прекрасно. Правильно разобрался. Вообще-то функции требуется документировать в комментариях - назначение, аргументы, результаты, особенности. Но с документированием у программистов всегда напряженка

А разобраться по исходнику бывает очень трудно, особенно если текст лихо оптимизирован в "лисповском" стиле.

Иногда даже приходится, в сложных случаях, "деоптимизировать" текст.

Поначалу можно писать и "по-бейсиковски", то есть присваивать через setq значения переменным, а потом уже что-то делать.
Типа

Код:

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

 
(setq a 2) (setq b 2)(setq с (* a b))

Потом перейти к

Код:

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

 
(setq a 2
 b 2
 с (* a b)
)

И, наконец, просто и элегантно

Код:

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

 
(* 2 2)

Но лучше учиться делать элегантно сразу. В какой-то момент конструкции, наподобие первого варианта будут глаз резать. Это будет означать - "лисп понял".

[VVA]

У меня есть предложение ко всем, но в основном модераторам такого плана:
Разделить уроки на "академисеские часы" или даже на мастер-классы, а не валить все в одну кучу.
Этот топик (удалив все лишнее) можно например назвать
"Урок 1. Создание и модификация примитивов с помощью команд Автокада"

Задание Алексея вынести в "Урок 2. Модификация и создание примитивов с помощью enget, entmake и т.д." ну и т.д.
Потом урок 3 и т.д.

[Red Nova]

VVA, Я буду только за. Мне бы уроков по больше и по понятнее
Но в этом случае правильно будет создать новый подраздел в разделе программирование, и назвать его типа "Уроки программирования" и там уже создать отдельные топики уроков по разной тематике.

P.S. В свое время обнаружив этот сайт я был удивлен отсутствием на нем разделов с уроками, на сайтах по 3dmax таких уроков пруд пруди.

[Рyslan]

Подскажите, как в программе выразить Select object? Например когда используешь Copy

[Кулик Алексей aka kpblc]

(ssget)

[Рyslan]

А в таком выражении ssget будет работать ?(command "Copy" "" "" "0,0" 18 "")

[Red Nova]

Пока модераторы думают над мыслю VVA я продолжу разборку кода с поста #314 от kpblc. Приведу его снова

Код:

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

 (defun test (/ selset res x y)
  (if (setq selset (ssget '((0 . "INSERT") (2 . "Колонна"))))
    (foreach item (_dwgru-conv-pickset-to-list selset)
      (if (member (setq size (strcat (rtos (cdr (assoc 41 (entget item))) 2 4)
                                     "x"
                                     (rtos (cdr (assoc 42 (entget item))) 2 4)
                                     ) ;_ end of strcat
                        ) ;_ end of setq
                  (mapcar 'car res)
                  ) ;_ end of member
        (setq res (subst (cons size (1+ (cdr (assoc size res))))
                         (assoc size res)
                         res
                         ) ;_ end of subst
              ) ;_ end of setq
        (setq res (cons (cons size 1) res))
        ) ;_ end of if
      ) ;_ end of foreach
    ) ;_ end of if
  ) ;_ end of defun

С (_dwgru-conv-pickset-to-list selset) понятно. Набор selset преобразуется в список имен примитивов и возвращает его. Идем дальше.
Как понять (entget item)
Item в числе локальных переменных функции test нет, но есть среди локальных переменных функции _dwgru-conv-pickset-to-list. Насколько я знаю локальная переменная живет на срок действия ее функции. То есть на момент ее упоминания она уже не локальная переменная.
Из хелпа

(entget <ename>) Примитив, который называется <ename> восстанавливается из базы данных и возвращается как список, содержащий эти определяемые данные. Результирующий список кодируется, как структурированный список LISP, элементы которого могут быть легко восстановлены функцией ASSOC.

Как понять “<ename> восстанавливается из базы данных и возвращается как список”? Может смысл в том, что <ename> ищется среди бывших локальных переменных и восстанавливается? И как item может восстановится списком? В (_dwgru-conv-pickset-to-list selset) переменная item отвечает только за номер примитива.

[Дима_]

ename это имя примитива возращаемого функциями entlast, entsel, ssname.
Если не понятно то нарисуй круг и введи (entget (entlast)).

P.S. Гуру, не издевайтесь, скорей объясняйте DXF.

[Red Nova]

Дима_, Не не пойму. Ты на конкретном примере объясни, на посте #346, что делает (entget item)

[Кулик Алексей aka kpblc]

Нет, и проблема не в (ssget)

[Makswell]

Сообщение от Red Nova Item в числе локальных переменных функции test нет, но есть среди локальных переменных функции _dwgru-conv-pickset-to-list. Насколько я знаю локальная переменная живет на срок действия ее функции. То есть на момент ее упоминания она уже не локальная переменная.

ИМХО значение Item становится nil сразу после окончания работы foreach. И в локальных переменных Item объявлять не надо, как и не надо нигде объявлять x в '(lambda (x) ...)

Добавлено:
Вот, накатал простенький лиспик для демонстрации вышенаписанного:

Код:

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

(defun test (/ k)
  (Setq k '(1 2 3))
  (princ "item внутри foreach")
  (terpri)
  (foreach item	k
    (princ item)
    (terpri)
  )
  (princ "item после выполнения foreach")
  (terpri)
  item
)

[Red Nova]

На вопрос ты все же не ответил. Надо понять что (entget item) означает в данном коде.

[Дима_]

команда (foreach item... )создает временную переменнту item, которая действует ТОЛЬКО внутри цикла foreach и принимает последовательно (циклично) все значения списка вернувшего (_dwgru-conv-pickset-to-list selset), далее в этом-же цикле есть команда (entget item) - возращает свойства примитива в виде списка состоящего из DXF кодов (ты уже использовал их в (ssget '((0 . "INSERT") (2 . "Колонна"))))), а команда (cdr(assoc xx возращает первое значение из списка с кодом хх - расшифровка кодов в DXF Reference

[Рyslan]

Короче, мне нужно скопировать объект на заданное расстояние, когда я заключаю в кавычки ALL программа копирует но не правильно. Какой стандартный прием в программировании для выделения объекта? Обычно же мышкой выделяем, а тут как?

[Кулик Алексей aka kpblc]

Код:

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

(command "_.copy" (ssget) "" pause pause)

Как-то так..

[Рyslan]

(command "Copy" "ALL" "" "0,0" "18,0" "") я тут неправильно координаты поставил извиняйте, разобрался

[Red Nova]

Спасибо. Эту часть понял

Код:

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

(setq size (strcat (rtos (cdr (assoc 41 (entget item))) 2 4)
                                     "x"
                                     (rtos (cdr (assoc 42 (entget item))) 2 4)
                                     ) ;_ end of strcat
                        ) ;_ end of setq

Получаем для конкретного элемента списка такую строчку ("Значение Х" "x" "Значение Y"), а вот дальше опять тормоз. Вот тут

Код:

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

(member (..........)
                  (mapcar 'car res)
                  ) ;_ end of member

Из хелпа

(member <выражение> <список>) Эта функция просматривает <список> - встречается ли <выражение> и возвращает часть <списка>, начинающуюся с первого найденного <выражения>. Если в <списке> нет <выражения>, MEMBER возвращает nil. Например: (member 'c '(a b c d e)) возвращает (C D E) (member 'q '(a b c d e)) возвращает nil

То есть <выражение> это у нас ("Значение Х" "x" "Значение Y"), а <список> это (mapcar 'car res). Переменная res еще не назначенна. Как понять (mapcar 'car res) не знаю. Вроде как следуя хелпу получается, что mapcar должен взять только первый элемент у каждого элемента списка res. Но что за список res?

[VVA]

Получаем для конкретного элемента списка такую строчку ("Значение Х" "x" "Значение Y")

Не так. У тебя список, а не строчка. Получаем такую строчку:
Масштаб_блока_XxМасштаб_блока_Y (например "400x300") Она же и является ключом поиска в списке res для ф-ций member и assoc.
В res ввиде ассоциативного списка будем подсчитывать размеры колонн
Добустим у нас 2 колонны размером 300x400 и 1 400x400. ТОгда окончательное значение res='(("300x400" . 2)("400x400" . 1))
(mapcar 'car res)= выполняет ф-цию car ко всем элементам res. Т.е. (car '("300x400" . 2)) и (car '("400x400" . 1)). В итоге получается список из 1-х элементов res (ключей)
res='(("300x400" . 2)("400x400" . 1))
(mapcar 'car res) = '("300x400" "400x400")

[Red Nova]

VVA,
Про (Масштаб_блока_XxМасштаб_блока_Y) понял. А про ключ поиска не понял. Что это такое?

В итоге получается список из 1-х элементов res (ключей)

Каким образом res стал ключем?
Из хелпа

(member <выражение> <список>) Эта функция просматривает <список> - встречается ли <выражение> и возвращает часть <списка>, начинающуюся с первого найденного <выражения>. Если в <списке> нет <выражения>, MEMBER возвращает nil. Например: (member 'c '(a b c d e)) возвращает (C D E) (member 'q '(a b c d e)) возвращает nil

Тут нет упоминания ключей. Если верить хелпу, то (mapcar 'car res) это <список>.
Не могу понять каким образом res получает связь с размерами колонн.

[Кулик Алексей aka kpblc]

Примерно так получилось (см.комментарии)

Код:

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

(foreach item (_dwgru-conv-pickset-to-list selset)
          ; Для каждого элемента набора
  (if ;; Проверяем
      (member
        ;; Входит ли {1}
        (setq size (strcat (rtos (cdr (assoc 41 (entget item))) 2 4)
                           "x"
                           (rtos (cdr (assoc 42 (entget item))) 2 4)
                           ) ;_ end of strcat
              ) ;_ end of setq
        ;; {1} Назначили переменной size значение "ШиринаВысота"
        (mapcar 'car res)
        ;; В список первых элементов res
        ) ;_ end of member
    ;; Если входит, то
    (setq res ;; Присвоить res результат
              (subst ;; Замены
                     (cons ;; На новый элемент, равный точечной паре из
                           size  ;; {1}
                           (1+ (cdr (assoc size res))) ;; И увеличенного на 1 имеющегося счетчика
                           ) ;_ end of cons
                     (assoc size res)  ;; А это старый элемент списка, его-то и меняем
                     res ;; А это сам res, над которым издеваемся
                     ) ;_ end of subst
          ) ;_ end of setq
    ;; Если не входит, то
    (setq res ;; Присвоить res результат
           (cons ;; Соединения
             (cons size 1) ;; Точечной пары "ШиринаВысота" и 1 (ведь 1 элемент с такой шириной-высотой уже найден)
             res ;; С имеющимся res
             ) ;_ end of cons
          ) ;_ end of setq
    ) ;_ end of if
  ) ;_ end of foreach

[Red Nova]

Кулик Алексей aka kpblc,
Все равно вопрос с #354 остается мною непонятым

[Кулик Алексей aka kpblc]

res - не ключ. Это результирующий список.
Иллюстрации для member:

Код:

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

_$ (member 1 (list 10 2 3 "qwer" 1 "asd" "qwer"))
(1 "asd" "qwer")
_$ (member 12 (mapcar 'car '((1 . 2) (12 . 6) (654 . 32) (12 . 1))))
(12 654 12)

Пройди по коду в пошаговом режиме совместно с отслеживанием значений переменных - многое будет понятно.

[Red Nova]

Твой код с #357 я полностью понимаю. Как работают mapcar и member мне ясно. Непонятно как переменная res принимает на сея значение выражения

Код:

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

(setq size (strcat (rtos (cdr (assoc 41 (entget item))) 2 4)
                           "x"
                           (rtos (cdr (assoc 42 (entget item))) 2 4)
                           ) ;_ end of strcat
              )

Я бы предположил, что на месте Res должна быть size, ведь именно ей присвоено нужное выражение.

[Кулик Алексей aka kpblc]

Стоп. Попробую словами, без кодов. Правда, подробно, боюсь, не получится.
"Зайдем" в цикл.
item - элемент набора. Из этого элемента забираем коэффициент масштабирования по осям х и у (соответственно группы 41 и 42) и из них формируем текстовую строку "<Ширина>х<Высота>". Чтобы не вычислять ее еще несколько раз, засовываем в переменную size (в #355 помечено как {1} - это база, с нее начинаются все пляски). Ну а дальше я в 355 вроде расписал.

[Red Nova]

То что ты написал я как раз знаю. Я именно это и говорю. Ты записал "<Ширина>х<Высота>" в переменную size. Но далее, в mapcar, ты используешь не size а res А переменной res мы ведь пока ничего не обозначили.

Код:

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

(member
        ;; Входит ли {1}
        (setq size (strcat (rtos (cdr (assoc 41 (entget item))) 2 4)
                           "x"
                           (rtos (cdr (assoc 42 (entget item))) 2 4)
                           ) ;_ end of strcat
              ) ;_ end of setq
        ;; {1} Назначили переменной size значение "ШиринаВысота"
        (mapcar 'car res)
        ;; В список первых элементов res
        ) ;_ end of member

[Кулик Алексей aka kpblc]

(mapcar 'car nil) вернет nil, соответственно (member <Чего-то-там> nil) вернет тоже nil. И будет выполняться строка

Код:

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

(setq res ;; Присвоить res результат
           (cons ;; Соединения
             (cons size 1) ;; Точечной пары "ШиринаВысота" и 1 (ведь 1 элемент с такой шириной-высотой уже найден)
             res ;; С имеющимся res
             ) ;_ end of cons
          ) ;_ end of setq

Если сразу после этого посмотреть res, то оно будет равно

Код:

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

(("<Ширина>х<Высота>" . 1))

[andery]

Сообщение от VVA У меня есть предложение ко всем, но в основном модераторам такого плана: Разделить уроки на "академисеские часы" или даже на мастер-классы, а не валить все в одну кучу. Этот топик (удалив все лишнее) можно например назвать "Урок 1. Создание и модификация примитивов с помощью команд Автокада" Задание Алексея вынести в "Урок 2. Модификация и создание примитивов с помощью enget, entmake и т.д." ну и т.д. Потом урок 3 и т.д.

Полностью поддерживаю.
Обращение к ГУРу:
я понимаю что для Вас это все понятно и возможно уже неинтересно, но мне (нам) начинающим сложно шагать такими шагами.
Чуть помедленнее. Расписать ВСЕ возможности функций, их вариации....
Но эт так, может я торможу....
ИМХО считать кол-во заданых колон немного рановато....
А то выполняем сложные задачи, а не знали что монжна одним setq присваивать несколько значений, или пользовать if (progn), ну и всякое такое....

Вопрос такой чуть не по теме:
хочу создать свой стиль текста с помощью команды _-style
(command "_-style" "gost200" "ISOCPEUR" 200 "1" "0" "_n" "_n")
Вопрос: как сделать курсив?
Неужели углом наклона?
Я хочу оригинальный курсив данного шрифта.
Спаибо.

[Кулик Алексей aka kpblc]

Кхе, одним setq можно не только несколько значений присваивать. В результате выполнения кода

Код:

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

(setq aa 1 ab 2 ac (* (1+ aa) a2))

будет сделано следующее: переменная aa получит значение 1; ab - 2; ac - 4 и возвращено вычисленное значение ac (4). То есть теоретически будет правомерна конструкция

Код:

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

(setq ad (1+ (setq aa 1 ab 2 ac (* (1+ aa) a2))))

В результате которой переменная ad получит значение 5

[andery]

Повторю вопрос, может кто знает....
хочу создать свой стиль текста с помощью команды _-style
(command "_-style" "gost200" "ISOCPEUR" 200 "1" "0" "_n" "_n")
Вопрос: как сделать курсив?
Неужели углом наклона?
Я хочу оригинальный курсив данного шрифта.
Заранее благодарен.

[Кулик Алексей aka kpblc]

http://dwg.ru/f/showpost.php?p=132694&postcount=25 не катит?

[andery]

Сообщение от Кулик Алексей aka kpblc http://dwg.ru/f/showpost.php?p=132694&postcount=25 не катит?

Для меня это темный лес......
Я хочу просто курсив.... "своими руками" так сказать

[andery]

Создание стиля текста и активизация стиля (command "_.style" "имя стиля" "шрифт" "высота" "коэф. ширины" "угол" "Backwards? <N>" "Upside-down? <N>" "Vertical? <N>") Если кроме имени стиля нет параметров, он становится текущим стилем текста.

Вот хочу вместо угла - задать курсив.
Не получится с помощью данной команды?

[Кулик Алексей aka kpblc]

Под словом "угол" подразумевается угол наклона букв.

[andery]

Сообщение от Кулик Алексей aka kpblc Под словом "угол" подразумевается угол наклона букв.

Спасибо, это я понимаю.
Хочу задать опцию "начертание" с командной строки.

[Кулик Алексей aka kpblc]

При использовании shx-шрифтов, по-моему, такого нет. ttf-шрифтами просто не пользуюсь - весу и головняка много, а толку - "маловато будет" (с)

[andery]

shx-шрифтов

они не поддерживают украинский язык
Стоит ли искать ответ на заданный вопрос или пока забыть об этом?

[Кулик Алексей aka kpblc]

shx-шрифты, насколько я помню, можно редактировать. Подробностей не знаю

[Alaspher]

Сообщение от andery они не поддерживают украинский язык Стоит ли искать ответ на заданный вопрос или пока забыть об этом?

Надо точно знать название файла курсивного шрифта, например:

Код:

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

(command "_.-style" "gost200" "isocpeui.ttf" 200 "1" "0" "_n" "_n")

[andery]

Alaspher
Спасибо, то что нада

[Red Nova]

Отбился я от рук. Работа...
kpblc,
Твой лисп я таки понял, но как синхронизировать его с "колонной". Я топорно вставил, и пока не работает.

Код:

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

(defun C:колонна (/ dimensionX dimensionY oldOSM OldLAY get_nil pt0 pt1 selset res x y)

 (defun *error*(msg) 
 (princ msg) ; Отменено пользователем
 (if oldOSM (setvar "osmode" oldOSM)) 
 (if OldLAY (setvar "clayer" OldLAY)) 
 ) 

 (setq OldLAY (getvar "clayer"))

 (setq oldOSM (getvar "osmode"))

 (setvar "osmode" 0)

 (initget 7)
 (setq dimensionX (getreal "Введите ширину колонны: "))
 (initget 7)
 (setq dimensionY (getreal "Введите толщину колонны: "))

 (if (not (tblsearch "block" "Колонна"))
   (progn
     (command "_-layer" "_set" "0" "")
     (command "_rectang" "-0.5,-0.5" "0.5,0.5")
     (command "_chprop" "_last" "" "_color" "_byblock" "_ltype" "_byblock" "_lweight" "_byblock" "")
     (command "_-block" "Колонна" "0,0" "_last" "")
   )
 )

 (command "_-layer" "_make" "Колонна" "")

 (setq get_nil t) ;_Устанавливаем флаг
(while get_nil
  (princ "\Укажите ТОЧКУ (ENTER-Хватит):")
  (command "_-insert" "Колонна" "_x" dimensionX "_y" dimensionY "0,0" "")
  (setq pt0 (getvar "lastpoint"))
  (setq blk (entlast))
  (command "_change" blk "" "" pause)
  (setq pt1 (getvar "lastpoint"))
 (if (equal pt0 pt1 0.000001)
    (progn
      (command "") ;_Завершаем команду Change нажатием Enter
      (entdel blk)
      (setq get_nil nil) ;_Сбрасываем флаг
     ) ;_ end of progn
    (progn
      (command pause) ;_Завершаем команду Change. Ждем от пользователя указания угла поворота
      (command "_circle" (getvar "lastpoint") (/ dimensionX 2) "")
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of while

 (setvar "clayer" OldLAY)

 (setvar "osmode" oldOSM)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  (if (setq selset (ssget '((0 . "INSERT") (2 . "Колонна"))))
    (foreach item (_dwgru-conv-pickset-to-list selset)
      (if (member (setq size (strcat (rtos (cdr (assoc 41 (entget item))) 2 4)
                                     "x"
                                     (rtos (cdr (assoc 42 (entget item))) 2 4)
                                     ) ;_ end of strcat
                        ) ;_ end of setq
                  (mapcar 'car res)
                  ) ;_ end of member
        (setq res (subst (cons size (1+ (cdr (assoc size res))))
                         (assoc size res)
                         res
                         ) ;_ end of subst
              ) ;_ end of setq
        (setq res (cons (cons size 1) res))
        ) ;_ end of if
      ) ;_ end of foreach
    ) ;_ end of if

 )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun _dwgru-conv-pickset-to-list (value / tab item)
  (repeat (setq tab  nil
                item (sslength value)
                ) ;_ end setq
    (setq tab (cons (ssname value (setq item (1- item))) tab))
    ) ;_ end repeat
  ) ;_ end defun

[Кулик Алексей aka kpblc]

А в каком именно месте не работает? по-моему (код не тестировал - не до того ) все работает, только никуда результат не выводится

[Red Nova]

А я не знаю как.

[Red Nova]

kpblc
Знаю что нужно использовать prompt, но правильно записать (и где) понять не могу.

[Кулик Алексей aka kpblc]

можно, конечно, и prompt. Но я б использовал princ.
Извини, у меня сейчас запарка, я отвечать осмысленно врд ли смогу

[Red Nova]

Пдаждемс

[andery]

Решил для себя написать такой лисп.
Данный листп создает стили шрифтов (шрифт ISOCPEUR и его курсив) от вводимого минимального размера до максимального с заданным интервалом.

Код:

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

(defun c:шрифт (/)
    	(initget (+ 1 2 4))
  	(setq min_T (getint "Введите минимальную высоту шрифта:"))
  	(initget (+ 1 2 4))
  	(setq max_T (getint "Введите максимальную высоту шрифта:"))
  	(initget (+ 1 2 4))
  	(setq I (getint "Введите интервал между создаваемыми шрифтами:"))
  	(While (>= max_T min_T)
	  	(progn
		  (setq tt (strcat "gost" (itoa min_T)))
		  (setq ttk (strcat "gost" (itoa min_T) "(курсив)"))
		  (command "_-style" tt "ISOCPEUR" min_T "1" "0" "_n" "_n")
		  (command "_-style" ttk "isocpeui.ttf" min_T "1" "0" "_n" "_n")
		  (setq min_T (+ min_T I))
		) ;;end of progn  
	) ;;end of while
  	(setq tt (strcat "gost" (itoa max_T)))
	(setq ttk (strcat "gost" (itoa max_T) "(курсив)"))
  	(command "_-style" tt "ISOCPEUR" max_T "1" "0" "_n" "_n")
	(command "_-style" ttk "isocpeui.ttf" max_T "1" "0" "_n" "_n")
);;end of defun

Возник такой вопрос, хотелось бы чтоб лисп был универсальный и создавал шрифты и с десятичной высотой (0.5, 1.0, 1.5....)
Но itoa понимает тока целые числа, может есть какой то выход ? или надо игратся с переносом нуля, отделением цело или десятичной части .....

[andery]

Нашел выход с rtos
(rtos <число> [<режим> [<точность>]]) - преобразование вещественного числа в строку;
Ну значит прошу заценить код:

Код:

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

(defun c:шрифт (/ min_T max_T I tt ttk)
    	(initget (+ 1 2 4))
  	(setq min_T (getreal "Введите минимальную высоту шрифта:"))
  	(initget (+ 1 2 4))
  	(setq max_T (getreal "Введите максимальную высоту шрифта:"))
  	(initget (+ 1 2 4))
  	(setq I (getreal "Введите интервал между создаваемыми шрифтами:"))
  	(While (>= max_T min_T)
	  	(progn
		  (setq tt (strcat "gost" (rtos min_T)))
		  (setq ttk (strcat "gost" (rtos min_T) "(курсив)"))
		  (command "_-style" tt "ISOCPEUR" min_T "1" "0" "_n" "_n")
		  (command "_-style" ttk "isocpeui.ttf" min_T "1" "0" "_n" "_n")
		  (setq min_T (+ min_T I))
		) ;;end of progn  
	) ;;end of while
  	(setq tt (strcat "gost" (rtos max_T)))
	(setq ttk (strcat "gost" (rtos max_T) "(курсив)"))
  	(command "_-style" tt "ISOCPEUR" max_T "1" "0" "_n" "_n")
	(command "_-style" ttk "isocpeui.ttf" max_T "1" "0" "_n" "_n")
);;end of defun

[Alaspher]

Сообщение от andery Ну значит прошу заценить код

Можно немного упростить не меняя функциональность:

Код:

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

(defun c:шрифт (/ min_t max_t i tt)
 (initget (+ 1 2 4))
 (setq min_t (getreal "\nВведите минимальную высоту шрифта: "))
 (initget (+ 1 2 4))
 (setq max_t (getreal "\nВведите максимальную высоту шрифта: "))
 (initget (+ 1 2 4))
 (setq i (getreal "\nВведите интервал между создаваемыми шрифтами: "))
 (while (>= max_t min_t)
  (setq tt (strcat "gost" (rtos min_t)))
  (vl-cmdf "_-style" tt "ISOCPEUR" min_t 1 0 "_n" "_n")
  (vl-cmdf "_-style" (strcat tt "(курсив)") "isocpeui.ttf" min_t 1 0 "_n" "_n")
  (setq min_t (+ min_t i))
 )
 (princ)
)

[andery]

(vl-cmdf "_-style" tt "ISOCPEUR" min_t 1 0 "_n" "_n") (vl-cmdf "_-style" (strcat tt "(курсив)") "isocpeui.ttf" min_t 1 0 "_n" "_n")

вот vl-cmdf - мне пока не знакомо...

[Кулик Алексей aka kpblc]

Практически аналог (command). Единственное отличие в AutoCAD - при успешном завершении возвращает t (command возвращает nil независимо ни от чего).

[Alaspher]

Есть ещё одно важное отличие - vl-cmdf вычисляет аргумент перед передачей и если возникает ошибка, то аргумент не передаётся (соответственно не возникает ошибка команды, которую ЛИСП обработать уже не может), а command валит аргументы в комстроку не глядя.

[andery]

а команды с приставкой vl- это уже из какой "оперы"?
И когда к ним стоит переходить?

[Дима_]

vl - visual lisp, а переходить к ним надо когда не хочешь изобретать велосипед, например если надо объем померить, или таблицу заполнить - можно и через dxf, но муторно да и незачем.

[Alan]

Сообщение от andery они не поддерживают украинский язык Стоит ли искать ответ на заданный вопрос или пока забыть об этом?

Есть несколько shx шрифтов, которые прекрасно поодерживают украинский язык, а russ14.shx еще и верхний/нижний индекс и знак номера - №
Зайдите к Поспелову http://cadhlp.kulichki.com/pgtxt.htm возьмите russ-pg.shx и будет Вам счастье.

[Red Nova]

Предлагаю возобновить обучение чайников.
Мне хотелось бы научиться работать со списками. По соседству я начал тему про копирование данных из выносок СПДС в спецификацию из мтекстов. Крыс написал функцию преобразующую содержание позиционных выносок в набор. Теперь следующим шагом должна быть фильтрация ненужной информации и модификация списка. Чему собственно и хотелось бы научиться.
Предположим имеем такой список:

(("1" "Тр. Ø89х3.5, L=2500") ("Труба" "") ("2" "-10х100x100") ("3" "Уголок 75х5, L=800") ("4" "Швеллер 20") ("" "Швеллер") ("Труба" "бесшовная") ("2 окна" "класса а") ("5" "Проем") ("6" "Стекловата"))

Со списком нужно произвести ряд операций.
В первую очередь нужно отфильтровать ненужные элементы списка.
Элементы которые нужно оставить должны удовлетворять следующим пунктам.
1. Данные должны содержать оба элемента пары.
То есть элементы ("Труба" "") и ("" "Швеллер") нужно удалить из списка, так как они не удовлетворяют указанному условию.
2. Верхняя строка выноски (первый элемент пары) должна содержать информацию нумерационного характера, нумерация отсчитывается по цифрам и по буквам латинского и русского алфавитов. Можно использовать знак ‘ и “. Допускаемые записи могут иметь такой вид – 1, 2, 3, 4, // а, б, в, г, // a, b, c, d, // 1a, 1b, 1c, // 1, 1’, 1”, 2, 2’ // a1, a2, a3, b, b1, ...
То есть на данном этапе отсеваются элементы
("Труба" "бесшовная") ("2 окна" "класса а"))
3. Нижняя строка должна начинаться на определенные символы, вот их список
- Знак “-”, слова “Лист” и “Полоса”
- Слово “Труба”, “Тр.” и знак трубы из шрифтов СПДС
- Слово “Уголок” и аналогичные символы из шрифтов СПДС
- Слово “Двутавр” и аналогичные символы из шрифтов СПДС
- Слово “Швеллер” и аналогичные символы из шрифтов СПДС
- Слово “Фланец”, то же “Фл.”
- Стандартный знак диаметра и знак диаметра из шрифтов СПДС
- Символ квадратной трубы из шрифтов СПДС
То есть на данном этапе отсеваются элементы
("5" "Проем") ("6" "Стекловата"))

В результате остается список из элементов
(("1" "Тр. Ø89х3.5, L=2500") ("2" "-10х100x100") ("3" "Уголок 75х5, L=800") ("4" "Швеллер 20"))

Ясно что тут пригодятся car и cdr. Но как пройтись по всему списку и самое главное как правильно задать фильтр я не знаю. Был бы благодарен если кто-нибудь напишет хоть один пример фильтрации из вышеприведенного списка, тогда я пойду по подобию, может даже удачно.

[Дима_]

А в чем сложность то? Напиши функцию которая распознает элемент по заданным критериям (parsing) и
(foreach tmp lst
(if (parsing tmp) (setq newlst (append newlst tmp)))
)
П.С. написанно без проверки, но суть я думаю ясна

[Кулик Алексей aka kpblc]

Уж лучше тогда использовать (vl-remove-if) или (vl-remove-if-not) ...

[Red Nova]

Дима_,

А в чем сложность то?

Сложность в том, что я пока этого не умею. Почитаю про parsing
kpblc Если можно, то хотелось бы без vla обойтись.

[Red Nova]

Дима_
Попробую разобраться.

(append newlst tmp)
Из хелпа

(append <выражение>...) Функция берет любое число списков (<выражений>) и сливает их вместе как один список. (append '(a b) '(c d)) возвращает (A B C D) (append '((a) (b)) '((c) (d))) возвращает ((A) (B) (C) (D)) APPEND требует, чтобы аргументы были списками.

То есть получаем склеенный список из элементов списков newlst и tmp

(setq newlst (append newlst tmp))
Назначаем newlst только что полученный склеенный список.

(if (parsing tmp) (setq newlst (append newlst tmp)))
Не пойму что значит (parsing tmp).
Из хелпа

(if <текст-выражение> <выражение-тогда> [<выражение-иначе>]) Эта функция исполняет выражение по условию. Если <тест-выражение> не nil, тогда исполняется <выражение-тогда>, иначе исполняется <выражение-иначе>. Последнее выражение <выражение-иначе> не обязательно. IF возвращает значение выбранного выражения; если <выражение-иначе> отсутствует и <тест-выражение> nil, IF возвращает nil. Например: (if (= 1 3) "Yes!!" "no.") возвращает "no."

То есть сперва должно идти тест выражение. А что тестируется в (parsing tmp) я не понемаю.

[Дима_]

погоди - parsing - это название функции которую надо сделать - про нее ни читать а делать надо.

[Дима_]

Короче подразумеваеться функция которая проверят все вышеперечисленные условия к параметру и в зависимости от результат возращает T или nil, ну а дальше применяешь ее к всему списку либо как я написал - либо по КРЫС'овски.

[Red Nova]

Дима_
Можно полный пример, я так не пойму? Принцип ясен, а с исполнение туманно.
Вот функция от крыса, которая преобразует выноски в список. Прицепи к ней пожалуйста какой–нибудь фильтр из мною упомянутых.

Код:

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

(defun test (/ selset lst)

  (defun _dwgru-conv-pickset-to-list (value / tab item)
    (repeat (setq tab  nil
                  item (sslength value)
                  ) ;_ end setq
      (setq tab (cons (ssname value (setq item (1- item))) tab))
      ) ;_ end repeat
    ) ;_ end defun

  (if
    (and (setq selset (ssget))
         (setq
           selset (vl-remove-if-not
                    (function (lambda (x)
                                (= (cdr (assoc 0 (entget x))) "spdsNotePosition")
                                ) ;_ end of LAMBDA
                              ) ;_ end of function
                    (_dwgru-conv-pickset-to-list selset)
                    ) ;_ end of vl-remove-if-not
           ) ;_ end of setq
         ) ;_ end of and
     (setq
       lst
        (vl-sort
          (vl-remove-if
            (function
              (lambda (a)
                (= (cadr a) "")
                ) ;_ end of lambda
              ) ;_ end of function
            (mapcar (function
                      (lambda (obj)
                        (mapcar (function cdr)
                                (vl-remove-if-not
                                  (function
                                    (lambda (x)
                                      (= (car x) 300)
                                      ) ;_ end of lambda
                                    ) ;_ end of function
                                  (member '(301 . "Первая строка") (entget obj))
                                  ) ;_ end of vl-remove-if-not
                                ) ;_ end of mapcar
                        ) ;_ end of LAMBDA
                      ) ;_ end of function
                    selset
                    ) ;_ end of mapcar
            ) ;_ end of vl-remove-if
          (function (lambda (a b) (< (car a) (car b))))
          ) ;_ end of vl-sort
       ) ;_ end of setq
     ) ;_ end of if
  lst
  ) ;_ end of defun

[Дима_]

Код:

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

(vl-load-com)
(defun parsing (tmp)
(if (and
(= (length tmp) 2); длина списка равна 2
(/= (car tmp) ""); Первый элемент не равен ""
(/= (cadr tmp) ""); то же со вторым
);блок условий который надо расширять до твоих требований
T;при выполнении условия
nil;при невыполнении
)
);end of parsing

(defun filtr (lst / newlst)
(foreach tmp lst
(if (parsing tmp) (setq newlst (append newlst (list tmp))))
);end of foreach
);end filtr

(defun vlfiltr (lst); Вариант через vl.
(vl-remove-if-not 'parsing lst)
);end of vlfiltr

(setq lst (list '("Первый" "Второй") '("Элемент который должен отфильтроваться") '("Аналогично" "") 
'("" "Аналогично") '("Этот" "дожен остаться")));тестовая строка

После запуска образуеться тестовый список lst, в моем примере проверяются 3 условия (в функции parsing), для проверки набери:
(list lst)
(filtr lst)
(vfiltr lst)
обращаю внимание что функции НЕ ИЗМЕНЯЮТ списки а возращают отфильтрованные, то есть для замены понадобиться:
(setq lst (filtr lst))

[Makswell]

Дима_, функцию parsing можно сделать проще

Код:

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

(defun parsing (tmp)
  (not (member "" tmp))
)

Добавлено:
Хотя нет, что-то я немного не туда. Только сейчас заметил фразу "блок условий который надо расширять до твоих требований". У тебя всё глобальней.

[Дима_]

Тут главное чтобы не оптимальней работало, а чтоб человек логику понял - а как это оптимизировать дело десятое.

[Red Nova]

Дима_
Вроде как начал понимать.
Функция (setq lst (filtr lst)) будет применять к каждому парному элементу списка lst фильтр parsing, который проверяет удовлетворяет ли пара различным условием.
Соединив твой лисп с Лиспом от крыса получил вот что. (Проверил, работает)

Код:

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

(defun test (/ selset lst)

 (vl-load-com)
 (defun parsing (tmp)
 (if (and
 (= (length tmp) 2); длина списка равна 2
 (/= (car tmp) ""); Первый элемент не равен ""
 (/= (cadr tmp) ""); то же со вторым
 );блок условий который надо расширять до твоих требований
 T;при выполнении условия
 nil;при невыполнении
 )
 );end of parsing
 
 (defun filtr (lst / newlst)
 (foreach tmp lst
 (if (parsing tmp) (setq newlst (append newlst (list tmp))))
 );end of foreach
 );end filtr

  (defun _dwgru-conv-pickset-to-list (value / tab item)
    (repeat (setq tab  nil
                  item (sslength value)
                  ) ;_ end setq
      (setq tab (cons (ssname value (setq item (1- item))) tab))
      ) ;_ end repeat
    ) ;_ end defun

  (if
    (and (setq selset (ssget))
         (setq
           selset (vl-remove-if-not
                    (function (lambda (x)
                                (= (cdr (assoc 0 (entget x))) "spdsNotePosition")
                                ) ;_ end of LAMBDA
                              ) ;_ end of function
                    (_dwgru-conv-pickset-to-list selset)
                    ) ;_ end of vl-remove-if-not
           ) ;_ end of setq
         ) ;_ end of and
     (setq
       lst
        (vl-sort
          (vl-remove-if
            (function
              (lambda (a)
                (= (cadr a) "")
                ) ;_ end of lambda
              ) ;_ end of function
            (mapcar (function
                      (lambda (obj)
                        (mapcar (function cdr)
                                (vl-remove-if-not
                                  (function
                                    (lambda (x)
                                      (= (car x) 300)
                                      ) ;_ end of lambda
                                    ) ;_ end of function
                                  (member '(301 . "Первая строка") (entget obj))
                                  ) ;_ end of vl-remove-if-not
                                ) ;_ end of mapcar
                        ) ;_ end of LAMBDA
                      ) ;_ end of function
                    selset
                    ) ;_ end of mapcar
            ) ;_ end of vl-remove-if
          (function (lambda (a b) (< (car a) (car b))))
          ) ;_ end of vl-sort
       ) ;_ end of setq
     ) ;_ end of if
  lst


(setq lst (filtr lst)) 

  ) ;_ end of defun

Теперь надо расширить параметры фильтрации функции parsing.
Подскажи пожалуйста как быть со вторым и третьим пунктами?

2. Верхняя строка выноски (первый элемент пары) должна содержать информацию нумерационного характера, нумерация отсчитывается по цифрам и по буквам латинского и русского алфавитов. Можно использовать знак ‘ и “. Допускаемые записи могут иметь такой вид – 1, 2, 3, 4, // а, б, в, г, // a, b, c, d, // 1a, 1b, 1c, // 1, 1’, 1”, 2, 2’ // a1, a2, a3, b, b1, ... Важно учесть, что две буквы не могут одновременно находится в верхней сторке, то есть записи типа (ab) или (1bc) исключаются. 3. Нижняя строка должна начинаться на определенные символы, вот их список - Знак “-”, слова “Лист” и “Полоса” - Слово “Труба”, “Тр.” и знак трубы из шрифтов СПДС - Слово “Уголок” и аналогичные символы из шрифтов СПДС - Слово “Двутавр” и аналогичные символы из шрифтов СПДС - Слово “Швеллер” и аналогичные символы из шрифтов СПДС - Слово “Фланец”, то же “Фл.” - Стандартный знак диаметра и знак диаметра из шрифтов СПДС - Символ квадратной трубы из шрифтов СПДС

[Кулик Алексей aka kpblc]

Значит так. Ставишь выноски со своими текстами (всеми, которые надо использовать в дальнейшем), получаешь с нее строки и результат на форум (код используй в #404. Хотя номер поста, конечно, вгоняет в дрожь )

[Red Nova]

kpblc
Я так понял, что ты хочешь чтобы я привел пример списка, который надо фильтровать. Если так то вот. Но я использую лисп не с #404 а с # 408, там уже отфильтрованы выноски одна из строк которых не содержит информацию.

(("1" "Дверь") ("1" "-10х100x100") ("1\"" "-10х100x250") ("1'" "-10х100x200")
("10" "2x40x40, L=1000") ("11" "2x40x40, ΣL=10000") ("12" "Тр. 89х3.5")
("13" "75х5") ("14" "Уголок 75х5") ("15" "20") ("16" "Двутавр 20") ("17"
"12") ("18" "Швеллер 12") ("19" "12 Ас1, ΣL=10000") ("1a" "-10х100x600")
("1АС" "Швеллер") ("2" "Окно") ("2" "Лист -10х100x100") ("20" "20 А500c")
("21" "8 20 А500c") ("3" "Фл. 300х8") ("4" "Фланец 300х8") ("5" "Лист ромб
-10х100x300") ("6" "Лист чечевица -10х100x300") ("7" "-4х50, L=1000") ("8"
"Полоса -4х50, L=1000") ("9" "Полоса -4х50, ΣL=10000") ("a" "-10х100x500")
("a1" "-10х100x300") ("a2" "-10х100x400") ("АС" "Двутавр") ("Торец"
"фрезеровать"))

Здесь на месте крякозябр спец. символы СПДС для профилей, на всякий случай выкладываю и корректный список в формате dwg (без крякозябр). Думаю шрифты СПДС в наличие у формумчан есть. В прикрепленном файле есть также пояснение что надо удалить, а что оставить.

код используй в #404. Хотя номер поста, конечно, вгоняет в дрожь

Подожди еще до 666-го дойдем.

[Дима_]

С 3 условием все просто составляешь список (spisok) возможных начал и

Код:

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

(defun check3 (var lst / flag) 
(foreach tmp lst
(if (= var (substr tmp 1 (strlen var))) (setq flag T))
)
flag 
);end of check3

а в проверку (parsing) добавляешь:
(check3 (cadr tmp) spisok)

Со вторым пунктом распиши условия поясней, чего можно чего нельзя.

P.S. Вобще алгоритм проверки не очень правильный, т.к. проверяет весь spisok, а достаточно до совпадения, то есть что то типа (while (and ...,
но чтоб тебя не путать оставил проверку всего списка.

[Red Nova]

Дима_
Не понял что ты имел в виду говоря

составляешь список (spisok) возможных начал и Код: [Выделить все] (defun check3 (var lst / flag) (foreach tmp lst (if (= var (substr tmp 1 (strlen var))) (setq flag T)) ) flag );end of check3

Какова связь между (spisok) и приведенным кодом?

[Дима_]

(setq spisok (list "Труба" "Тр." "Дверь")); список всех "правильных" начал
(check3 "Тр." spisok); верент T
(check3 "ПП." spisok); верент nil

[Кулик Алексей aka kpblc]

> #410: Лови:

Код:

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

(defun test1 (/ selset lst _dwgru-conv-pickset-to-list crit)

  (defun _dwgru-conv-pickset-to-list (value / tab item)
    (repeat (setq tab  nil
                  item (sslength value)
                  ) ;_ end setq
      (setq tab (cons (ssname value (setq item (1- item))) tab))
      ) ;_ end repeat
    ) ;_ end defun

  (setq crit (strcat
               "*\U+03B1*,*\U+03B2*,*\U+03B3*,*\U+03B4*,*\U+03B5*,"
               "*\U+03B6*,*\U+03B7*,*\U+03B8*,*\U+03B9*,*\U+03BA*,"
               "*\U+03BB*,*\U+03BC*,*\U+03BD*,*\U+03BE*,*\U+03BF*,"
               "*\U+03C0*,*\U+03C1*,*\U+03C3*,*\U+03C4*,*\U+03C5*,"
               "*\U+03C6*,*\U+03C7*,*\U+03C8*,*\U+03C9*,*\U+0391*,"
               "*\U+0392*,*\U+0393*,*\U+0394*,*\U+0395*,*\U+0396*,"
               "*\U+0397*,*\U+0398*,*\U+0399*,*\U+039A*,*\U+039B*,"
               "*\U+039C*,*\U+03A4*,*\U+03A5*,*\U+03A6*,*\U+03A7*,"
               "*\U+03A8*,*\U+03A9*,*\U+E740*,*\U+E741*,*\U+E742*,"
               "*\U+2248*,*\U+E743*,*\U+2264*,*\U+E744*,*\U+2265*,"
               "*\U+00D7*,*·*,*\U+E751*,*\U+E746*,*\U+E745*,*\U+E747*,"
               "*\U+E748*,*\U+E749*,*\U+221A*,*\U+222B*,*\U+E713*,"
               "*\U+E750*,*\U+E722*,*\U+E723*,*\U+E724*,*\U+E725*,"
               "*\U+E726*,*\U+E727*,*\U+E728*,*\U+E729*,*\U+E72A*,"
               "*\U+E72B*,*\U+E72C*,*\U+E72D*,*\U+E72E*,*\U+E72F*,"
               "*\U+03B4*,*\U+E712*,*\U+E714*,*\U+E715*,*\U+E716*,"
               "*\U+E717*,*°*,*±*,*№*") ;_ end of strcat
        ) ;_ end of setq

  (if
    (and (setq selset (ssget))
         (setq
           selset (vl-remove-if-not
                    (function (lambda (x)
                                (= (cdr (assoc 0 (entget x))) "spdsNotePosition")
                                ) ;_ end of lambda
                              ) ;_ end of function
                    (_dwgru-conv-pickset-to-list selset)
                    ) ;_ end of vl-remove-if-not
           ) ;_ end of setq
         ) ;_ end of and
     (setq
       lst
        (vl-remove-if-not
          (function
            (lambda (x)
              (or (wcmatch (car x) crit) (wcmatch (cadr x) crit))
              ) ;_ end of lambda
            ) ;_ end of function
          (mapcar (function
                    (lambda (obj)
                      (mapcar (function cdr)
                              (vl-remove-if-not
                                (function
                                  (lambda (x)
                                    (= (car x) 300)
                                    ) ;_ end of lambda
                                  ) ;_ end of function
                                (member '(301 . "Первая строка") (entget obj))
                                ) ;_ end of vl-remove-if-not
                              ) ;_ end of mapcar
                      ) ;_ end of LAMBDA
                    ) ;_ end of function
                  selset
                  ) ;_ end of mapcar
          ) ;_ end of vl-remove-if-not
       ) ;_ end of setq
     ) ;_ end of if
  lst
  ) ;_ end of defun

[Red Nova]

kpblc, Спсибо, но пока удаляет и то что не надо удалять, вот что осталось

(("21" "8 20 А500c") ("20" "20 А500c") ("19" "12 Ас1, ΣL=10000") ("17"
"12") ("15" "20") ("12" "Тр. 89х3.5") ("11" "2x40x40, ΣL=10000") ("10"
"2x40x40, L=1000") ("4" "Фланец 300х8") ("3" "Фл. 300х8"))

[Кулик Алексей aka kpblc]

Тогда надо образец. Я проверял на 12 выносках, работало вроде корректно...

[Red Nova]

Пытался сделать как Дима_ говорит, лисп перестал работать.
Что я сделал не так? (последние изменения отмечены красным)

Код:

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

 (defun test (/ selset lst spisok)

 (vl-load-com)
 (defun parsing (tmp)
 (if (and
 (= (length tmp) 2); длина списка равна 2
 (/= (car tmp) ""); Первый элемент не равен ""
 (/= (cadr tmp) ""); то же со вторым
 (check3 (cadr tmp) spisok); проверка первых символов второй строки
 );блок условий который надо расширять до твоих требований
 T;при выполнении условия
 nil;при невыполнении
 )
 );end of parsing
 
 (defun filtr (lst / newlst)
 (foreach tmp lst
 (if (parsing tmp) (setq newlst (append newlst (list tmp))))
 );end of foreach
 );end filtr

(defun check3 (var lst / flag) 
(foreach tmp lst
(if (= var (substr tmp 1 (strlen var))) (setq flag T))
)
flag 
);end of check3

 (setq spisok (list "-" "Фл" "Лист" "Полоса" "U+E72E" "Тр" "U+E720" "Уголок" "U+E729" "Двутавр" "U+E725" "Швеллер" 
"%%c" "U+E712" "2%%c" "3%%c" "4%%c" "5%%c" "6%%c" "7%%c" "8%%c" "9%%c" "10%%c" "11%%c" "12%%c" "13%%c" "14%%c" "15%%c" "16%%c" "17%%c" "18%%c" "19%%c" "20%%c" 
 "2 %%c" "3 %%c" "4 %%c" "5 %%c" "6 %%c" "7 %%c" "8 %%c" "9 %%c" "10 %%c" "11 %%c" "12 %%c" "13 %%c" "14 %%c" "15 %%c" "16 %%c" "17 %%c" "18 %%c" "19 %%c" "20 %%c" 
"2U+E712" "3U+E712" "4U+E712" "5U+E712" "6U+E712" "7U+E712" "8U+E712" "9U+E712" "10U+E712" "11U+E712" "12U+E712" "13U+E712" "14U+E712" "15U+E712" "16U+E712" "17U+E712" "18U+E712" "19U+E712" "20U+E712"  
"2 U+E712" "3 U+E712" "4 U+E712" "5 U+E712" "6 U+E712" "7 U+E712" "8 U+E712" "9 U+E712" "10 U+E712" "11 U+E712" "12 U+E712" "13 U+E712" "14 U+E712" "15 U+E712" "16 U+E712" "17 U+E712" "18 U+E712" "19 U+E712" "20 U+E712"))

  (defun _dwgru-conv-pickset-to-list (value / tab item)
    (repeat (setq tab  nil
                  item (sslength value)
                  ) ;_ end setq
      (setq tab (cons (ssname value (setq item (1- item))) tab))
      ) ;_ end repeat
    ) ;_ end defun

  (if
    (and (setq selset (ssget))
         (setq
           selset (vl-remove-if-not
                    (function (lambda (x)
                                (= (cdr (assoc 0 (entget x))) "spdsNotePosition")
                                ) ;_ end of LAMBDA
                              ) ;_ end of function
                    (_dwgru-conv-pickset-to-list selset)
                    ) ;_ end of vl-remove-if-not
           ) ;_ end of setq
         ) ;_ end of and
     (setq
       lst
        (vl-sort
          (vl-remove-if
            (function
              (lambda (a)
                (= (cadr a) "")
                ) ;_ end of lambda
              ) ;_ end of function
            (mapcar (function
                      (lambda (obj)
                        (mapcar (function cdr)
                                (vl-remove-if-not
                                  (function
                                    (lambda (x)
                                      (= (car x) 300)
                                      ) ;_ end of lambda
                                    ) ;_ end of function
                                  (member '(301 . "Первая строка") (entget obj))
                                  ) ;_ end of vl-remove-if-not
                                ) ;_ end of mapcar
                        ) ;_ end of LAMBDA
                      ) ;_ end of function
                    selset
                    ) ;_ end of mapcar
            ) ;_ end of vl-remove-if
          (function (lambda (a b) (< (car a) (car b))))
          ) ;_ end of vl-sort
       ) ;_ end of setq
     ) ;_ end of if
  lst


(setq lst (filtr lst)) 


  ) ;_ end of defun

[Red Nova]

kpblc,
Вот образец

[Red Nova]

Дима_
Попробую еще раз объяснить про пункт 2,
Верхняя строка выноски должна содержать номер позиции, говоря номер подразумеваем цифру, букву (одну), цифру + букву.
То есть номера могут быть такие.
1, 2, 3, 4, 5, 6, 7, 8, 9
a, b, c, d, e, f, g
а, б, в, г, д, е
1a, 1b, 1c, 1d, 1e, 1f, 1g
1а, 1б, 1в, 1г, 1д, 1е
Допускается использовать все вышеупомянутое вместе со знаками ‘ и “
Не допускается чтобы в номере одновременно были две буквы.
То есть строки
“1ас”
“ad5”
не подходят.

[Дима_]

Сообщение от Red Nova Пытался сделать как Дима_ говорит, лисп перестал работать. Что я сделал не так? (последние изменения отмечены красным) Код: [Выделить все] (defun test (/ selset lst spisok) (vl-load-com) (defun parsing (tmp) (if (and (= (length tmp) 2); длина списка равна 2 (/= (car tmp) ""); Первый элемент не равен "" (/= (cadr tmp) ""); то же со вторым (check3 (cadr tmp) spisok); проверка первых символов второй строки );блок условий который надо расширять до твоих требований T;при выполнении условия nil;при невыполнении ) );end of parsing (defun filtr (lst / newlst) (foreach tmp lst (if (parsing tmp) (setq newlst (append newlst (list tmp)))) );end of foreach );end filtr (defun check3 (var lst / flag) (foreach tmp lst (if (= var (substr tmp 1 (strlen var))) (setq flag T)) ) flag );end of check3 (setq spisok (list "-" "Фл" "Лист" "Полоса" "U+E72E " "Тр" "U+E720 " "Уголок" "U+E729 " "Двутавр" "U+E725 " "Швеллер" "%%c" "U+E712" "2%%c" "3%%c" "4%%c" "5%%c" "6%%c" "7%%c" "8%%c" "9%%c" "10%%c" "11%%c" "12%%c" "13%%c" "14%%c" "15%%c" "16%%c" "17%%c" "18%%c" "19%%c" "20%%c" "2 %%c" "3 %%c" "4 %%c" "5 %%c" "6 %%c" "7 %%c" "8 %%c" "9 %%c" "10 %%c" "11 %%c" "12 %%c" "13 %%c" "14 %%c" "15 %%c" "16 %%c" "17 %%c" "18 %%c" "19 %%c" "20 %%c" "2U+E712" "3U+E712" "4U+E712" "5U+E712" "6U+E712" "7U+E712" "8U+E712" "9U+E712" "10U+E712" "11U+E712" "12U+E712" "13U+E712" "14U+E712" "15U+E712" "16U+E712" "17U+E712" "18U+E712" "19U+E712" "20U+E712" "2 U+E712" "3 U+E712" "4 U+E712" "5 U+E712" "6 U+E712" "7 U+E712" "8 U+E712" "9 U+E712" "10 U+E712" "11 U+E712" "12 U+E712" "13 U+E712" "14 U+E712" "15 U+E712" "16 U+E712" "17 U+E712" "18 U+E712" "19 U+E712" "20 U+E712")) (defun _dwgru-conv-pickset-to-list (value / tab item) (repeat (setq tab nil item (sslength value) ) ;_ end setq (setq tab (cons (ssname value (setq item (1- item))) tab)) ) ;_ end repeat ) ;_ end defun (if (and (setq selset (ssget)) (setq selset (vl-remove-if-not (function (lambda (x) (= (cdr (assoc 0 (entget x))) "spdsNotePosition") ) ;_ end of LAMBDA ) ;_ end of function (_dwgru-conv-pickset-to-list selset) ) ;_ end of vl-remove-if-not ) ;_ end of setq ) ;_ end of and (setq lst (vl-sort (vl-remove-if (function (lambda (a) (= (cadr a) "") ) ;_ end of lambda ) ;_ end of function (mapcar (function (lambda (obj) (mapcar (function cdr) (vl-remove-if-not (function (lambda (x) (= (car x) 300) ) ;_ end of lambda ) ;_ end of function (member '(301 . "Первая строка") (entget obj)) ) ;_ end of vl-remove-if-not ) ;_ end of mapcar ) ;_ end of LAMBDA ) ;_ end of function selset ) ;_ end of mapcar ) ;_ end of vl-remove-if (function (lambda (a b) (< (car a) (car b)))) ) ;_ end of vl-sort ) ;_ end of setq ) ;_ end of if lst (setq lst (filtr lst)) ) ;_ end of defun

К моменту обращения к списку он еще не определен, перенеси (setq spisok ... в начало.

P.S. Вобще у тебя все функции объявляються внутри функции тест - не правильно это - не должно быть вложенных defun'ов:
то есть не
(defun f1...
(defun f2...)
)
а последовательно:
(defun f1...)
(defun f2...)

[Кулик Алексей aka kpblc]

Кто сказал, что нельзя объявлять вложенные функции? Где это сказано, ткни носом!
Живейший пример - локальное переопределение *error* - как собираешься делать без локальных функций?

[Дима_]

Да можно их объявлять - просто по моему Red Nova не очень понимает как defun работает - посмотри на код его последний - про который он спрашивает почему не работает.

Для Red Nova если в ком строке написать (setq test "123") то переменной тест будет присвоенно "123", в случае-же (defun prc () (setq test "345")), переменная не изменится, это произойдет только при вызове функции - (prc). В случае-же вложенных defun
при выполнении (defun aaa () (defun bbb () (setq ccc "work"))), после этого вызвать функцию (bbb) не получиться, вначале надо запустить (aaa) - только затем (bbb) будет объявленна, но не выполнена - ссс до сих пор = nil, и только сейчас можно вызвать (bbb) и переменной ссс будет присвоенно значение "work".
По этому я и советую вначале отдельно объяви все функции - parsing, check3 и пр., а только затем используй их в (test).

[Кулик Алексей aka kpblc]

Red Nova, Дима_, простите, мужики, но мне бы со своим кодом разобраться...
Кстати, касательно #417: я в свое время пропустил объявление _dwgru-conv-pickset-to-list в качестве локальной переменной, хотя это и не очень хорошо (это что увидел "сразу").

[CB]

Не вникая в способ получения списка позиционных выносок (как я понял это уже решено), могу предложить такой фильтр:

Код:

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

(setq lst
       '(("1‘" "Тр. O89х3.5, L=2500")
  ("1a‘" "Тр. O89х3.5, L=2500")
  ("1aa‘" "Тр. O89х3.5, L=2500")
  ("Труба" "")
  ("2" "-10х100x100")
  ("30a" "Уголок 75х5, L=800")
  ("4" "Швеллер 20")
  ("" "Швеллер")
  ("Труба" "бесшовная")
  ("2 окна" "класса а")
  ("5" "Проем")
  ("6" "Стекловата")
  ("45a" "Швеллер 20")
  ("4a5a" "Швеллер 20")
  ("45аa" "Швеллер 20")
 )
) ;_ end of setq
(vl-remove-if
  '(lambda (x)
     (or
;;;Если кол-во элементов подсписока lst не равно 2 - подсписок удалить
       (not (equal (length x) 2))
;;;Если в подсписке lst присутствует "" - подсписок удалить
       (member "" x)
;|Если второй элемент подсписка lst НЕ начинается со слов указанных в образце т.е.
со слов Труба, Тр, Лист, Полоса и т.д. - подсписок удалить
!!!В образец нужно еще добавить нужные знаки из шрифтов СПДС!!!|;
       (not
  (wcmatch
    (cadr x)
    "Труба*,Тр*,-*,Лист*,Полоса*,Уголок*,Швеллер*,Двутавр*,Фланец*,"
  ) ;_ end of wcmatch
       ) ;_ end of not
;|Фильтр по первому элементу подсписка сделан по условиям  #419
КРОМЕ - не обрабатывается подсписок например такого вида:
("4a5a" "Швеллер 20") - останется(хотя должен удалятся)
("45a" "Швеллер 20") - останется
("45аa" "Швеллер 20") - удалится|;
       (not
  (if (or (wcmatch (car x) "*‘")
   (wcmatch (car x) "*“")
      ) ;_ end of or
    (wcmatch
      (car x)
      "[a-gа-е0-9]?,#[a-gа-е0-9]?,##[a-gа-е0-9]?,#*#[a-gа-е0-9]?"
    ) ;_ end of wcmatch
    (wcmatch
      (car x)
      "[a-gа-е0-9],#[a-gа-е0-9],##[a-gа-е0-9],#*#[a-gа-е0-9]"
    ) ;_ end of wcmatch
  ) ;_ end of if
       ) ;_ end of not
     ) ;_ end of or
   ) ;_ end of lambda
  lst
) ;_ end of vl-remove

[Дима_]

Сообщение от Red Nova Дима_ Попробую еще раз объяснить про пункт 2, Верхняя строка выноски должна содержать номер позиции, говоря номер подразумеваем цифру, букву (одну), цифру + букву. То есть номера могут быть такие. 1, 2, 3, 4, 5, 6, 7, 8, 9 a, b, c, d, e, f, g а, б, в, г, д, е 1a, 1b, 1c, 1d, 1e, 1f, 1g 1а, 1б, 1в, 1г, 1д, 1е Допускается использовать все вышеупомянутое вместе со знаками ‘ и “ Не допускается чтобы в номере одновременно были две буквы. То есть строки “1ас” “ad5” не подходят.

Уточни могут ли быть двузначные номера - 10, 11 и.т.д. и соответственно буквы только до 'g' и 'е' или возможно продолжение по алфавиту, буквы только строчные, или заглавные тоже можно (компьютер глупый не скажешь не сделает). Значки ' и " могут только последними находиться?

[Red Nova]

Дима_,

К моменту обращения к списку он еще не определен, перенеси (setq spisok ... в начало.

Верно. Щас попробую.

обще у тебя все функции объявляються внутри функции тест - не правильно это - не должно быть вложенных defun'ов:

Думаю это все же не принципиально, просто у нас так кусками пошло

Уточни могут ли быть двузначные номера - 10, 11 и.т.д.

Могут

и соответственно буквы только до 'g' и 'е' или возможно продолжение по алфавиту

Если я верно понял, ты имел в виду дойти только до 'е' или можно и продолжить алфавит. Если так то да. Можно до конца.

буквы только строчные, или заглавные тоже можно

Можно и заглавные

Значки ' и " могут только последними находиться?

Верно подметил все. Только в конце.

CB, Спасибо за участие. Начало понял. А вот начиная с этой строчки - нет.

;|Фильтр по первому элементу подсписка сделан по условиям #419

[Red Nova]

Дима_,
А теперь что не так ?

Код:

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

 (defun test (/ selset lst spisok _dwgru-conv-pickset-to-list)


 (setq spisok (list "-" "Фл" "Лист" "Полоса" "U+E72E " "Тр" "U+E720 " "Уголок" "U+E729 " "Двутавр" "U+E725 " "Швеллер" 
"%%c" "U+E712" "2%%c" "3%%c" "4%%c" "5%%c" "6%%c" "7%%c" "8%%c" "9%%c" "10%%c" "11%%c" "12%%c" "13%%c" "14%%c" "15%%c" "16%%c" "17%%c" "18%%c" "19%%c" "20%%c" 
 "2 %%c" "3 %%c" "4 %%c" "5 %%c" "6 %%c" "7 %%c" "8 %%c" "9 %%c" "10 %%c" "11 %%c" "12 %%c" "13 %%c" "14 %%c" "15 %%c" "16 %%c" "17 %%c" "18 %%c" "19 %%c" "20 %%c" 
"2U+E712" "3U+E712" "4U+E712" "5U+E712" "6U+E712" "7U+E712" "8U+E712" "9U+E712" "10U+E712" "11U+E712" "12U+E712" "13U+E712" "14U+E712" "15U+E712" "16U+E712" "17U+E712" "18U+E712" "19U+E712" "20U+E712"  
"2 U+E712" "3 U+E712" "4 U+E712" "5 U+E712" "6 U+E712" "7 U+E712" "8 U+E712" "9 U+E712" "10 U+E712" "11 U+E712" "12 U+E712" "13 U+E712" "14 U+E712" "15 U+E712" "16 U+E712" "17 U+E712" "18 U+E712" "19 U+E712" "20 U+E712"))


 (vl-load-com)
 (defun parsing (tmp)
 (if (and
 (= (length tmp) 2); длина списка равна 2
 (/= (car tmp) ""); Первый элемент не равен ""
 (/= (cadr tmp) ""); то же со вторым
 (check3 (cadr tmp) spisok); проверка первых символов второй строки
 );блок условий который надо расширять до твоих требований
 T;при выполнении условия
 nil;при невыполнении
 )
 );end of parsing
 
 (defun filtr (lst / newlst)
 (foreach tmp lst
 (if (parsing tmp) (setq newlst (append newlst (list tmp))))
 );end of foreach
 );end filtr

(defun check3 (var lst / flag) 
(foreach tmp lst
(if (= var (substr tmp 1 (strlen var))) (setq flag T))
)
flag 
);end of check3

  (defun _dwgru-conv-pickset-to-list (value / tab item)
    (repeat (setq tab  nil
                  item (sslength value)
                  ) ;_ end setq
      (setq tab (cons (ssname value (setq item (1- item))) tab))
      ) ;_ end repeat
    ) ;_ end defun

  (if
    (and (setq selset (ssget))
         (setq
           selset (vl-remove-if-not
                    (function (lambda (x)
                                (= (cdr (assoc 0 (entget x))) "spdsNotePosition")
                                ) ;_ end of LAMBDA
                              ) ;_ end of function
                    (_dwgru-conv-pickset-to-list selset)
                    ) ;_ end of vl-remove-if-not
           ) ;_ end of setq
         ) ;_ end of and
     (setq
       lst
        (vl-sort
          (vl-remove-if
            (function
              (lambda (a)
                (= (cadr a) "")
                ) ;_ end of lambda
              ) ;_ end of function
            (mapcar (function
                      (lambda (obj)
                        (mapcar (function cdr)
                                (vl-remove-if-not
                                  (function
                                    (lambda (x)
                                      (= (car x) 300)
                                      ) ;_ end of lambda
                                    ) ;_ end of function
                                  (member '(301 . "Первая строка") (entget obj))
                                  ) ;_ end of vl-remove-if-not
                                ) ;_ end of mapcar
                        ) ;_ end of LAMBDA
                      ) ;_ end of function
                    selset
                    ) ;_ end of mapcar
            ) ;_ end of vl-remove-if
          (function (lambda (a b) (< (car a) (car b))))
          ) ;_ end of vl-sort
       ) ;_ end of setq
     ) ;_ end of if
  lst


(setq lst (filtr lst)) 


  ) ;_ end of defun

[Дима_]

Вобщем вот-так, добавлен check2 - я правда его особо не проверял.

Код:

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

(vl-load-com)
(defun parsing (tmp)
(and
(= (length tmp) 2); длина списка равна 2
(/= (car tmp) ""); Первый элемент не равен ""
(/= (cadr tmp) ""); то же со вторым
(check2 (car tmp)); проверка второго условия к первой строке
(check3 (cadr tmp) spisok); проверка первых символов второй строки
);блок условий который надо расширять до твоих требований
);end of parsing

(defun filtr (lst / newlst)
(foreach tmp lst
(if (parsing tmp) (setq newlst (append newlst (list tmp))))
);end of foreach
newlst
);end filtr

(defun check2 (tmp / i str); возращает T либо nil в зависимости от соответствия 2-му условию
(setq i 1 str tmp)
(if (or (= (substr str (strlen str)) "'") (= (substr str (strlen str)) "\"")); если последний ' или "
(setq str (substr str 1 (1- (strlen str))))); убирает последний символ
(repeat (strlen str)
(if (and (>= (substr str i 1) "0") (<= (substr str i 1) "9")); проверка цифра ли это?
(setq str (strcat (substr str 1 (1- i)) (substr str (1+ i)))); если да то убираем ее из str
(setq i (1+ i)); переход к следующими символу, если не было вычитания
);end of if
);end of repeat
; таким образом мы убрали из str все цифры и символы на конце 'и"
(<= (strlen str) 1); остался только 1 символ или меньше?
);end of check2

(defun check3 (var lst / flag) 
(foreach tmp lst
;(if (= var (substr tmp 1 (strlen var))) (setq flag T)) логическая ошибочка ошибочка - не то подрезал
(if (= tmp (substr var 1 (strlen tmp))) (setq flag T))
)
flag 
);end of check3
  (defun _dwgru-conv-pickset-to-list (value / tab item)
    (repeat (setq tab  nil
                  item (sslength value)
                  ) ;_ end setq
      (setq tab (cons (ssname value (setq item (1- item))) tab))
      ) ;_ end repeat
    ) ;_ end defun



(defun test (/ lst selset spisok)

  (if
    (and (setq selset (ssget))
         (setq
           selset (vl-remove-if-not
                    (function (lambda (x)
                                (= (cdr (assoc 0 (entget x))) "spdsNotePosition")
                                ) ;_ end of LAMBDA
                              ) ;_ end of function
                    (_dwgru-conv-pickset-to-list selset)
                    ) ;_ end of vl-remove-if-not
           ) ;_ end of setq
         ) ;_ end of and
     (setq
       lst
        (vl-sort
          (vl-remove-if
            (function
              (lambda (a)
                (= (cadr a) "")
                ) ;_ end of lambda
              ) ;_ end of function
            (mapcar (function
                      (lambda (obj)
                        (mapcar (function cdr)
                                (vl-remove-if-not
                                  (function
                                    (lambda (x)
                                      (= (car x) 300)
                                      ) ;_ end of lambda
                                    ) ;_ end of function
                                  (member '(301 . "Первая строка") (entget obj))
                                  ) ;_ end of vl-remove-if-not
                                ) ;_ end of mapcar
                        ) ;_ end of LAMBDA
                      ) ;_ end of function
                    selset
                    ) ;_ end of mapcar
            ) ;_ end of vl-remove-if
          (function (lambda (a b) (< (car a) (car b))))
          ) ;_ end of vl-sort
       ) ;_ end of setq
     ) ;_ end of if
  
(setq spisok (list "-" "Фл" "Лист" "Полоса" "U+E72E " "Тр" "U+E720 " "Уголок" "U+E729 " "Двутавр" "U+E725 " "Швеллер" 
"%%c" "U+E712" "2%%c" "3%%c" "4%%c" "5%%c" "6%%c" "7%%c" "8%%c" "9%%c" "10%%c" "11%%c" "12%%c" "13%%c" "14%%c" "15%%c" "16%%c" "17%%c" "18%%c" "19%%c" "20%%c" 
 "2 %%c" "3 %%c" "4 %%c" "5 %%c" "6 %%c" "7 %%c" "8 %%c" "9 %%c" "10 %%c" "11 %%c" "12 %%c" "13 %%c" "14 %%c" "15 %%c" "16 %%c" "17 %%c" "18 %%c" "19 %%c" "20 %%c" 
"2U+E712" "3U+E712" "4U+E712" "5U+E712" "6U+E712" "7U+E712" "8U+E712" "9U+E712" "10U+E712" "11U+E712" "12U+E712" "13U+E712" "14U+E712" "15U+E712" "16U+E712" "17U+E712" "18U+E712" "19U+E712" "20U+E712"  
"2 U+E712" "3 U+E712" "4 U+E712" "5 U+E712" "6 U+E712" "7 U+E712" "8 U+E712" "9 U+E712" "10 U+E712" "11 U+E712" "12 U+E712" "13 U+E712" "14 U+E712" "15 U+E712" "16 U+E712" "17 U+E712" "18 U+E712" "19 U+E712" "20 U+E712"))

(setq lst (filtr lst)) ; можно и просто оставить в первом setq - но чтоб было понятней.
);end of test

P.S. Исправлена функция фильтр добавил возращение newlst .

[Red Nova]

Дима_
Пока не заработало

Command: (test) Select objects: Specify opposite corner: 32 found Select objects: nil

[CB]

>Red Nova (#426)
Не очень то я умею объяснять, но т.к. тема носит прежде всего обучающий характер все же попытаюсь.
Естественно главная в фильтре - это функция wcmatch. Эта функция проверяет структуру текста на соответствие
с образцом, который сделан по определенным правилам (каждый символ строки сверяется с образцом).
Небольшая информация по символам образца, которые здесь применялись (естественно здесь не все...)
1. * - заменяет ВСЕ символы строки до и после *.
Например:
(wcmatch "Труба" "Труба") ;T - все символы строки и образца совпадают
(wcmatch "Труба" "труба") ;nil - не все символы строки и образца совпадают
(wcmatch "Труба" "*") ;T - все символы строки заменяет *
(wcmatch "Труба" "Тр*") ;T - первые символы строки и образца совпадают, дальше * заменяет все оставшиеся символы строки
(wcmatch "Труба" "*уб*") ;T - первые символы строки до символа "у" заменяет *, все символы после "б" также заменяются *
(wcmatch "Труба" "*уа*") ;nil ...(надеюсь все понятно)
(wcmatch "Труба" "Т*у*") ;T ...(надеюсь и здесь все понятно)
Вернемся к нашему примеру:
(or (wcmatch (car x) "*‘") (wcmatch (car x) "*“"))
Если ПОСЛЕДНИЙ символ строки равен "‘" или "“" то ИСТИНА.
2. [...] - заменяет один любой символ строки на любой символ в []
Например:
(wcmatch "1" "[0123456789]") ;T - символ строки присутствует в образце
(wcmatch "a" "[0123456789]") ;nil - символ строки отсутствует в образце
(wcmatch "1aа" "[0123456789]*") ;T - первый символ строки присутствует в образце, остальные заменяются *
3. - определяет диапазон однотипных символов.
Например:
(wcmatch "1" "[0123456789]")
и
(wcmatch "1" "[0-9]") абсолютно идентичы
4. ? заменяет ровно один символ строки
Например:
(wcmatch "1aа" "[0-9]??") ;T - заменяет два последних символа строки (они могут быть любыми)
(wcmatch "1aа" "?[0-9]?") ;nil - первый символ строки любой, второй отсутствует в образце [0-9], третий любой.
(wcmatch "a1а" "?[0-9]?") ;T - первый символ строки любой, второй присутствует в образце [0-9], третий любой.
5. , разделяет несколько образцов
Например:
(wcmatch "a1а" "[0-9]??,?[0-9]?") ;T - первое условие не выполняется, второе выполняется
(wcmatch "1аа" "[0-9]??,?[0-9]?") ;T - первое условие выполняется, второе не выполняется
6. # заменяет одну любую цифру
Например:
(wcmatch "1аа" "#*") ;T - первый символ строки цифра, все остальные заменяются *
(wcmatch "20а" "#*") ;T - первый символ строки цифра, все остальные заменяются *
(wcmatch "а1а" "#*") ;nil - первый символ строки НЕ цифра, все остальные заменяются *
Вернемся к примеру:
"[a-gа-е0-9]?,#[a-gа-е0-9]?,##[a-gа-е0-9]?,#*#[a-gа-е0-9]?"
Здесь 4 варианта образцов:
Первый вариант для двух знаков строки - первый знак может быть любая цифра, буквы из диапазонов от "a" до "g" (a b c d f g)
и от "а" до "е" (а б в г д е). Вторая вроде бы любая, но по условию ф-ции if (см. в конце п.1)
это могут быть только знаки "‘" или "“" т.е.
(wcmatch "1‘" "[a-gа-е0-9]?") ;T - первый символ строки присутствует в образце [a-gа-е0-9], второй любой
(wcmatch "a‘" "[a-gа-е0-9]?") ;T - первый символ строки присутствует в образце [a-gа-е0-9], второй любой
(wcmatch "q‘" "[a-gа-е0-9]?") ;nil - первый символ строки отсутствует в образце [a-gа-е0-9], второй любой
Т.к. в #426 кое-что в условии поменялось, то можно поменять образец на "[A-Za-zА-Яа-я0-9]?"
(wcmatch "q‘" "[A-Za-zА-Яа-я0-9]?");T - первый символ строки присутствует в образце "[A-Za-zА-Яа-я0-9]?", второй любой т.е. первый символ может быть любой цифрой или любой буквой (также и заглавной)
Хочу заметить следующее - символы в [] восприннимаются не как управляющие, а как они есть т.е.
(wcmatch "10" "[A-Za-zА-Яа-я0-9]?") ;T
(wcmatch "10" "[A-Za-zА-Яа-я#]?") ;nil символ # не как управляющий
(wcmatch "#1" "[A-Za-zА-Яа-я#]?") ;T символ # не как управляющий
Второй вариант (#[A-Za-zА-Яа-я0-9]?) для трех знаков строки - первый знак ЦИФРА, дальше по первому варианту
(wcmatch "10‘" "#[A-Za-zА-Яа-я0-9]?") ;T
(wcmatch "1b‘" "#[A-Za-zА-Яа-я0-9]?") ;T
(wcmatch "1б‘" "#[A-Za-zА-Яа-я0-9]?") ;T
(wcmatch "a10‘" "#[A-Za-zА-Яа-я0-9]?") ;nil
Третий вариант (##[A-Za-zА-Яа-я0-9]?) для четырех знаков строки - первый и второй знаки ЦИФРА, дальше по первому варианту
(wcmatch "10a‘" "##[A-Za-zА-Яа-я0-9]?") ;T
(wcmatch "100‘" "##[A-Za-zА-Яа-я0-9]?") ;T
(wcmatch "1aa‘" "##[A-Za-zА-Яа-я0-9]?") ;nil
(wcmatch "a1a‘" "##[A-Za-zА-Яа-я0-9]?") ;nil
Четвертый вариант (#*#[A-Za-zА-Яа-я0-9]?) c "подводным камнем" - для случая > четырех знаков строки
первый знак ЦИФРA, дальше ЛЮБЫЕ, третий с конца ЦИФРA, второй с конца ЦИФРA или буква,
последний любой (в данном случае "‘" или "“").
(wcmatch "100a‘" "#*#[A-Za-zА-Яа-я0-9]?") ;T
(wcmatch "1а0a‘" "#*#[A-Za-zА-Яа-я0-9]?") ;T (не правильно)
Чтобы исключить "неправильность" я думаю, что лучше это условие изменить на "###[A-Za-zА-Яа-я0-9]?"
(wcmatch "1а0a‘" "###[A-Za-zА-Яа-я0-9]?") ;nil
(wcmatch "999a‘" "###[A-Za-zА-Яа-я0-9]?") ;T
(wcmatch "9999‘" "###[A-Za-zА-Яа-я0-9]?") ;T
Ну а дальше все тоже самое, только для случая, если в конце нет знаков "‘" или "“".

[Red Nova]

CB,
Спасибо за объяснение. Очень подробно и понятно. Есть один вопрос.
Так получается что образец wcmatch работает только тогда, когда количество символов совпадает с количественным параметром образца. А что если мы напишем образцы для строк содержащих до 4-х символов, а в строке их пять?

[Дима_]

Сообщение от Red Nova Дима_ Пока не заработало

Дай файлик (dwg) посмотрю.

[Red Nova]

Файл примера dwg прикреплен на #418

[Дима_]

К сожалению нету СПДС-ки но:

Код:

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

Команда: (LOAD "C:/Documents and Settings/Дима/Рабочий стол/test.lsp") TEST
Команда: (setq a (list '("1a" "Правильный") '("" "одна кавычка") '("1п" "одна 
кавычка") '("в" "Неправильный") '("D" "Правильный")))
(("1a" "Правильный") ("" "одна кавычка") ("1п" "одна кавычка") ("в" 
"Неправильный") ("D" "Правильный"))

Команда: (setq spisok (list "Правильный" "одна кавычка"))
("Правильный" "одна кавычка")

Команда: (filtr a)
(("1a" "Правильный") ("1п" "одна кавычка") ("D" "Правильный"))

Вероятно ошибка в определении spisok - (filtr) работает.

[Кулик Алексей aka kpblc]

Попробую разобрать мой код из #414:

Код:

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

(defun test1 (/ selset lst _dwgru-conv-pickset-to-list crit)

;|
Ну, этот кусок понятен - локальная функция, преобразовывающая
набор в список
|;  (defun _dwgru-conv-pickset-to-list (value / tab item)
    (repeat (setq tab  nil
                  item (sslength value)
                  ) ;_ end setq
      (setq tab (cons (ssname value (setq item (1- item))) tab))
      ) ;_ end repeat
    ) ;_ end defun

;|
1. А это самое главное - перечень символов, которые "надо оставлять".
Тут перечислены символы, которые можно вставить средствами СПДС
GraphiCS и используя стиль текста GOST 2.304
В дальнейшем будет использоваться в wcmatch
|;
  (setq crit (strcat
               "*\U+03B1*,*\U+03B2*,*\U+03B3*,*\U+03B4*,*\U+03B5*,"
               "*\U+03B6*,*\U+03B7*,*\U+03B8*,*\U+03B9*,*\U+03BA*,"
               "*\U+03BB*,*\U+03BC*,*\U+03BD*,*\U+03BE*,*\U+03BF*,"
               "*\U+03C0*,*\U+03C1*,*\U+03C3*,*\U+03C4*,*\U+03C5*,"
               "*\U+03C6*,*\U+03C7*,*\U+03C8*,*\U+03C9*,*\U+0391*,"
               "*\U+0392*,*\U+0393*,*\U+0394*,*\U+0395*,*\U+0396*,"
               "*\U+0397*,*\U+0398*,*\U+0399*,*\U+039A*,*\U+039B*,"
               "*\U+039C*,*\U+03A4*,*\U+03A5*,*\U+03A6*,*\U+03A7*,"
               "*\U+03A8*,*\U+03A9*,*\U+E740*,*\U+E741*,*\U+E742*,"
               "*\U+2248*,*\U+E743*,*\U+2264*,*\U+E744*,*\U+2265*,"
               "*\U+00D7*,*·*,*\U+E751*,*\U+E746*,*\U+E745*,*\U+E747*,"
               "*\U+E748*,*\U+E749*,*\U+221A*,*\U+222B*,*\U+E713*,"
               "*\U+E750*,*\U+E722*,*\U+E723*,*\U+E724*,*\U+E725*,"
               "*\U+E726*,*\U+E727*,*\U+E728*,*\U+E729*,*\U+E72A*,"
               "*\U+E72B*,*\U+E72C*,*\U+E72D*,*\U+E72E*,*\U+E72F*,"
               "*\U+03B4*,*\U+E712*,*\U+E714*,*\U+E715*,*\U+E716*,"
               "*\U+E717*,*°*,*±*,*№*") ;_ end of strcat
        ) ;_ end of setq

  (if ;|2. Если|;
    (and ;|3. и|;
(setq selset (ssget));|4. выбраны объекты
Дальше фильтрация|;
         (setq ;|8. Результат п.6 не пустой|;
           selset (vl-remove-if-not;|6. Удалить элемент, если он не удовлетворяет условию|;
                    (function (lambda (x)
                                (= (cdr (assoc 0 (entget x))) "spdsNotePosition")
;|7. То самое условие. Переменная x последовательно принимает значения
списка элементов|;
                                ) ;_ end of lambda
                              ) ;_ end of function
                    (_dwgru-conv-pickset-to-list selset);|5. Преобразовали набор в список|;
                    ) ;_ end of vl-remove-if-not
           ) ;_ end of setq
         ) ;_ end of and
;|9. Если выполнено условие п.8, то в переменную lst закидывается|;
     (setq
       lst
;|15. Удалить элемент, если он не удовлетворяет условию|;
        (vl-remove-if-not
          (function
            (lambda (x)
              (or (wcmatch (car x) crit) (wcmatch (cadr x) crit))
;|16. Или первый элемент списка "похож" на crit, или второй, или оба|;
              ) ;_ end of lambda
            ) ;_ end of function
;|
Список, к которому применяется п.
|;
          (mapcar 
;|14. К каждому элементу списка применить функцию|;
(function
                    (lambda (obj)
                      (mapcar ;|13. К каждому элементу результата выполнения 11 применить функцию|;(function ;|правильно, cdr|;cdr)
                              (vl-remove-if-not
;|11. Удалить элемент, если он не удовлетворяет условию п.12|;
                                (function
                                  (lambda (x)
                                    (= (car x) 300)
;|12. Ключ точечной пары равен 300|;
                                    ) ;_ end of lambda
                                  ) ;_ end of function
                                (member '(301 . "Первая строка") (entget obj))
;|10. Получение элементов результата (entget), следующих за парой '(301 . "Первая строка")|;
                                ) ;_ end of vl-remove-if-not
                              ) ;_ end of mapcar
                      ) ;_ end of LAMBDA
                    ) ;_ end of function
                  selset;|На данный момент selset список элементов|;
                  ) ;_ end of mapcar
          ) ;_ end of vl-remove-if-not
       ) ;_ end of setq
     ) ;_ end of if
  lst
  ) ;_ end of defun

Вроде так...

[Red Nova]

Дима_
Укоротил список до минимума, не помогло.

Код:

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

(setq spisok (list "-" "Фл"))

[Red Nova]

kpblc, Спасибо за подробности, пока не вникал, но заметил что код как и прежде фильтрует и нужную информацию. Например эту

Код:

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

(("1" "Дверь") ("1" "-10х100x100") ("1\"" "-10х100x250") ("1'" "-10х100x200") 
("13" "75х5") ("14" "Уголок 75х5") ("16" "Двутавр 20")  ("18" "Швеллер 12") ("1a" "-10х100x600") 
("2" "Окно") ("2" "Лист -10х100x100") ("5" "Лист ромб -10х100x300") ("6" "Лист чечевица -10х100x300") ("7" "-4х50, L=1000") ("8" 
"Полоса -4х50, L=1000") ("9" "Полоса -4х50, ΣL=10000") ("a" "-10х100x500") 
("a1" "-10х100x300") ("a2" "-10х100x400")

Кстати, не знаешь почему "1"" в списке становится "1\"" и что с этим делать?

[Дима_]

Сообщение от Red Nova Кстати, не знаешь почему "1"" в списке становится "1\"" и что с этим делать?

А как ты тогда " в текст втавишь? Интерпритатор воспимет ее как закрывающию.

[Дима_]

Сообщение от Red Nova Дима_ Укоротил список до минимума, не помогло. Код: [Выделить все] (setq spisok (list "-" "Фл"))

Чудеса какие-то, проверь filtr на тестовом списке? Если работает, то посмотри в отлдчике что lst до него предствляет, наверняка какая-нибудь глупость типа lst в скобках два раза прописан, если сам ошибку найдешь это гораздо полезней, чем тебе ее покажут.

[Red Nova]

Дима_

А как ты тогда " в текст втавишь? Интерпритатор воспимет ее как закрывающию.

Ну раз так, то и наш лисп в будущем при записи в текст должен изменять 1\" на 1".

[Red Nova]

kpblc, CB
Ребята, протестируйте пожалуйста код с #427, у Димы СПДС нет, а я никак не найду где ошибка.

Дима_ Пробовал добавить в filtr по отдельности check2 и check2, не работает ни в какую.

[Red Nova]

СВ
Пытался соеденить твой код с кодом #404 от крыса, нечего не вышло. Как это правильно сделать?

[Дима_]

АААААА! Вдарьте мне кирпичом, исправил в #428 - не ругайтесь строго, не тот элемент выравнивал - не из объекта, а из spisk'а - см. check3. А в тестовых моих они одинаковой длинны были.

[CB]

К сожалению СПДС нет и у меня, но я ориентировался на

Кулик Алексей aka kpblc, Спасибо, список из содержаний позиционных выносок создается

в http://dwg.ru/f/showthread.php?t=24951 #3
Лисп в #2 (по этой же ссылке) создает правильный список или нет?
Если да, то тогда нужно нужно ориентироваться именно на этот лисп...

[Red Nova]

Дима_
Заработало!!!
Фильтр готов. Спасибо большое.
Теперь у нас уже есть отфильтрованный от мусора список.
Я немного изменил список (spisok), и теперь наша функция такова.

Код:

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

(vl-load-com)
(defun parsing (tmp)
(and
(= (length tmp) 2); длина списка равна 2
(/= (car tmp) ""); Первый элемент не равен ""
(/= (cadr tmp) ""); то же со вторым
(check2 (car tmp)); проверка второго условия к первой строке
(check3 (cadr tmp) spisok); проверка первых символов второй строки
);блок условий который надо расширять до твоих требований
);end of parsing


(defun filtr (lst / newlst)
(foreach tmp lst
(if (parsing tmp) (setq newlst (append newlst (list tmp))))
);end of foreach
newlst
);end filtr


(defun check2 (tmp / i str); возращает T либо nil в зависимости от соответствия 2-му условию
(setq i 1 str tmp)
(if (or (= (substr str (strlen str)) "'") (= (substr str (strlen str)) "\"")); если последний ' или "
(setq str (substr str 1 (1- (strlen str))))); убирает последний символ
(repeat (strlen str)
(if (and (>= (substr str i 1) "0") (<= (substr str i 1) "9")); проверка цифра ли это?
(setq str (strcat (substr str 1 (1- i)) (substr str (1+ i)))); если да то убираем ее из str
(setq i (1+ i)); переход к следующими символу, если не было вычитания
);end of if
);end of repeat
; таким образом мы убрали из str все цифры и символы на конце 'и"
(<= (strlen str) 1); остался только 1 символ или меньше?
);end of check2


(defun check3 (var lst / flag) 
(foreach tmp lst
(if (= tmp (substr var 1 (strlen tmp))) (setq flag T))
)
flag 
);end of check3
  (defun _dwgru-conv-pickset-to-list (value / tab item)
    (repeat (setq tab  nil
                  item (sslength value)
                  ) ;_ end setq
      (setq tab (cons (ssname value (setq item (1- item))) tab))
      ) ;_ end repeat
    ) ;_ end defun


(defun test (/ lst selset spisok)
  (if
    (and (setq selset (ssget))
         (setq
           selset (vl-remove-if-not
                    (function (lambda (x)
                                (= (cdr (assoc 0 (entget x))) "spdsNotePosition")
                                ) ;_ end of LAMBDA
                              ) ;_ end of function
                    (_dwgru-conv-pickset-to-list selset)
                    ) ;_ end of vl-remove-if-not
           ) ;_ end of setq
         ) ;_ end of and
     (setq
       lst
        (vl-sort
          (vl-remove-if
            (function
              (lambda (a)
                (= (cadr a) "")
                ) ;_ end of lambda
              ) ;_ end of function
            (mapcar (function
                      (lambda (obj)
                        (mapcar (function cdr)
                                (vl-remove-if-not
                                  (function
                                    (lambda (x)
                                      (= (car x) 300)
                                      ) ;_ end of lambda
                                    ) ;_ end of function
                                  (member '(301 . "Первая строка") (entget obj))
                                  ) ;_ end of vl-remove-if-not
                                ) ;_ end of mapcar
                        ) ;_ end of LAMBDA
                      ) ;_ end of function
                    selset
                    ) ;_ end of mapcar
            ) ;_ end of vl-remove-if
          (function (lambda (a b) (< (car a) (car b))))
          ) ;_ end of vl-sort
       ) ;_ end of setq
     ) ;_ end of if

  
(setq spisok (list "-" "Фл." "Фл." "Фланец" "Лист" "Полоса" "\U+E72E" "Тр" "\U+E720" "Уголок" "\U+E729" "Двутавр" "\U+E725" "Швеллер" 
"%%c" "\U+E712" "2%%c" "3%%c" "4%%c" "5%%c" "6%%c" "7%%c" "8%%c" "9%%c" "10%%c" "11%%c" "12%%c" "13%%c" "14%%c" "15%%c" "16%%c" "17%%c" "18%%c" "19%%c" "20%%c" 
 "2 %%c" "3 %%c" "4 %%c" "5 %%c" "6 %%c" "7 %%c" "8 %%c" "9 %%c" "10 %%c" "11 %%c" "12 %%c" "13 %%c" "14 %%c" "15 %%c" "16 %%c" "17 %%c" "18 %%c" "19 %%c" "20 %%c" 
"2\U+E712" "3\U+E712" "4\U+E712" "5\U+E712" "6\U+E712" "7\U+E712" "8\U+E712" "9\U+E712" "10\U+E712" "11\U+E712" "12\U+E712" "13\U+E712" "14\U+E712" "15\U+E712" "16\U+E712" "17\U+E712" "18\U+E712" "19\U+E712" "20\U+E712"  
"2 \U+E712" "3 \U+E712" "4 \U+E712" "5 \U+E712" "6 \U+E712" "7 \U+E712" "8 \U+E712" "9 \U+E712" "10 \U+E712" "11 \U+E712" "12 \U+E712" "13 \U+E712" "14 \U+E712" "15 \U+E712" "16 \U+E712" "17 \U+E712" "18 \U+E712" "19 \U+E712" "20 \U+E712"))

(setq lst (filtr lst)) ; можно и просто оставить в первом setq - но чтоб было понятней.
);end of test

1. Теперь о продолжении.
На пример, в результате фильтрации мы получили такой список.

Код:

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

(("1" "-10х100x200") ("1" "-10х100x200") ("2" "Швеллер 12, L=1000, шаг 1000") ("2" "Швеллер 12, L=1000") ("2" "Швеллер 12") ("3" "12 Ас1, ΣL=10000") ("3" "12 Ас1") ("4" "20 Ас1") ("5" "8 20 А500c, L=1000") ("5" "8 20 А500c"))

А. Необходимо удалить дублирующие элементы.
Видно, что некоторые элементы дублируются абсолютно идентично.
("1" "-10х100x200") ("1" "-10х100x200)
А у некоторых одинаков только номер позиции
("2" "Швеллер 12, L=1000, шаг 1000") ("2" "Швеллер 12, L=1000") ("2" "Швеллер 12")
("5" "8 20 А500c, L=1000") ("5" "8 20 А500c")
Для правильной фильтрации дублирующих элементов Необходимо произвести сравнение первых и вторых элементов подсписка.
Если оба элемента идентичны, то оставляем только один подсписок.
Если идентичны только номера позиций, а содержание разное, то надо оставить на первом этапе более длинный подсписок.
Таким образом наш список превратится в

Код:

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

( ("1" "-10х100x200") ("2" "Швеллер 12, L=1000, шаг 1000") ("3" "12 Ас1, ΣL=10000") ("3" "12 Ас1") ("4" "20 Ас1") ("5" "8 20 А500c, L=1000"))

B. Теперь из подсписков надо удалить информацию, которая в спецификации непригодна.
Вот такие подсписки, которые содержат лишнюю информацию.
("2" "Швеллер 12, L=1000, шаг 1000")
("5" "8 20 А500c")
B.1 Алгоритм должен отслеживать есть ли во второй строке запятые . Не уверен, но если в русской и английской раскладке запятым соответствуют разные символы, то надо учесть оба. Если в строке больше одной запятой, то надо удалить все что идет после второй (вместе с запятой).
B.2 Алгоритм должен также проверить начинается ли вторая строка с “цифра пробел диаметр”, или с “цифра диаметр” где диаметр может писаться двумя кодами. Вот список всех возможных комбинаций:

Код:

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

(list "2%%c" "3%%c" "4%%c" "5%%c" "6%%c" "7%%c" "8%%c" "9%%c" "10%%c" "11%%c" "12%%c" "13%%c" "14%%c" "15%%c" "16%%c" "17%%c" "18%%c" "19%%c" "20%%c" 
 "2 %%c" "3 %%c" "4 %%c" "5 %%c" "6 %%c" "7 %%c" "8 %%c" "9 %%c" "10 %%c" "11 %%c" "12 %%c" "13 %%c" "14 %%c" "15 %%c" "16 %%c" "17 %%c" "18 %%c" "19 %%c" "20 %%c" 
"2\U+E712" "3\U+E712" "4\U+E712" "5\U+E712" "6\U+E712" "7\U+E712" "8\U+E712" "9\U+E712" "10\U+E712" "11\U+E712" "12\U+E712" "13\U+E712" "14\U+E712" "15\U+E712" "16\U+E712" "17\U+E712" "18\U+E712" "19\U+E712" "20\U+E712"  
"2 \U+E712" "3 \U+E712" "4 \U+E712" "5 \U+E712" "6 \U+E712" "7 \U+E712" "8 \U+E712" "9 \U+E712" "10 \U+E712" "11 \U+E712" "12 \U+E712" "13 \U+E712" "14 \U+E712" "15 \U+E712" "16 \U+E712" "17 \U+E712" "18 \U+E712" "19 \U+E712" "20 \U+E712")

Если вторая строка начинается с этих элементов, то надо удалить все до знака диаметр.

Список должен после этого стать таким

Код:

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

( ("1" "-10х100x200") ("2" "Швеллер 12, L=1000") ("3" "12 Ас1, ΣL=10000") ("3" "12 Ас1") ("4" "20 Ас1") ("5" "20 А500c, L=1000"))

2. Вопросы
Топик все же обучающий. И хотя мне подсознательно очень хочется получить готовый лисп, я все же хотел бы и сам что-то сделать. Размышлял как самому написать фильтры условия А и В. Для этого сначала надо понять каков принцип работы check3
Попытаюсь разобраться вот в этом.

Код:

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

....
(check3 (cadr tmp) spisok)
....
(defun check3 (var lst / flag) 
(foreach tmp lst
(if (= tmp (substr var 1 (strlen tmp))) (setq flag T))
)
flag 
);end of check3

Ясно что (check3 (cadr tmp) spisok) должен вернуть либо T либо nil.
(substr var 1 (strlen tmp))
Из справки я знаю что strlen вернет количество символов в списке tmp а substr должен вернуть то что получится если от значения var обрубить все что длиннее чем tmp. А вот чему равно var я не знаю.
Прошу объяснить.

[Red Nova]

CB,
Ошибка уже нашлась. Теперь все работает. Поскольку со многими вариантами мне не совладать, решил продолжать с алгоритмом от Димы, Если еще не надоело помогать, почитай пожалуйста мой предыдущий пост. Там я описал продолжение, и вопрос про алгоритм Димы.

[Дима_]

Ну Семен Семенович:
(check3 (cadr tmp) spisok)
....
(defun check3 (var lst / flag)

var - это аргумент который передается функции, насчет запятой она в обоих раскладках одинаковая.
Пилите Шура (я про варианты а и б), что не будет получаться пиши.

[Red Nova]

Дима_,
Эх коротковато ты объясняешь. Чайник как я не поймет.
Прошу пошагово объяснить вот это

Код:

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

....
(check3 (cadr tmp) spisok)
....
(defun check3 (var lst / flag) 
(foreach tmp lst
(if (= tmp (substr var 1 (strlen tmp))) (setq flag T))
)
flag 
);end of check3

[Дима_]

Сообщение от Red Nova Дима_, Эх коротковато ты объясняешь. Чайник как я не поймет. Прошу пошагово объяснить вот это Код: [Выделить все] .... (check3 (cadr tmp) spisok) .... (defun check3 (var lst / flag) (foreach tmp lst ; создает переменную циклично принимающию значения элементов списка lst (if (= tmp (substr var 1 (strlen tmp))) (setq flag T)); если первые буквы переданного параметра var совпадают с значением tmp устанавливаем переменную flag );конец цикла foreach flag ; таким образом если было хотя бы одно совпадение функция check3 вернет значение T );end of check3

Вобще если есть желание потренироваться, попробуй сам написать аналогичную функцию, но которая не проверяет весь список (как эта), а заканчивается при первом совпадении - не проверяя список до конца, если сам смогешь ИХМО - будет неплохая практика.

[Кулик Алексей aka kpblc]

Дима_, простыми вариантами в лиспе такое не реализовывается, по-моему. В лиспе нет ведь принудительного выхода из списка (в отличие от VB(A), C++, C# etc) без выхода из функции. (exit) и (quit), по-моему, здесь не сработают. Единственный вариант - использовать set вместо setq, но и он вряд ли даст ожидаемый эффект.
P.S. мне лениво разбираться с кодом и пытаться выяснить, что передается в качестве параметров вызова check3, но вот 3 варианта кода:

Код:

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

(defun fun_check3_1 (var lst / flag)
  (foreach tmp lst
    (if (and (not flag)
             (= tmp (substr var 1 (strlen tmp)))
             ) ;_ end of and
      (setq flag t)
      ) ;_ end of if
    ) ;_ end of foreach
  flag
  ) ;_ end of defun

(defun fun_check3_2 (var lst / flag)
  (foreach tmp lst
    (if (= tmp (substr var 1 (strlen tmp)))
      (progn
        (setq flag t)
        (quit)
        ) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of foreach
  flag
  ) ;_ end of defun

(defun fun_check3_3 (var lst res)
; Пример вызова:
; (fun_check3_3 var lst 'result)
; Обрати внимание на апостроф перед последним параметром
; В этой переменной будет храниться результат выполнения
; fun_check_3
  (foreach tmp lst
    (if (and (not res)
             (= tmp (substr var 1 (strlen tmp)))
             ) ;_ end of and
      (progn
        (set res t)
        (quit)
        ) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of foreach
  ) ;_ end of defun

Анализ кода оставлю вам

[VVA]

Сообщение от Кулик Алексей aka kpblc Дима_, простыми вариантами в лиспе такое не реализовывается, по-моему. В лиспе нет ведь принудительного выхода из списка (в отличие от VB(A), C++, C# etc) без выхода из функции.

Не претендую на оригинальность, но можно попробовать перебрать список через while

Код:

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

;;;Возвращает T если элемент var есть в списке lst
(defun check_VVA (var lst / flag tmp)
  (while (and (not flag) lst)
    (setq tmp (car lst) lst (cdr lst))
    (if (equal var tmp 1e-6)(setq flag t))
    )
  flag
  )

Benchmark

Код:

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

(setq lst '("0" "11" "2" "3" "1" "2" "3"))
          (BenchMark
             '(
               (check_VVA "1" lst)
	       (fun_check3_1 "1" lst)
	       (fun_check3_3 "1" lst 'ret)
              )
          )

Benchmarking ..................Elapsed milliseconds / relative speed for 32768 iteration(s): (CHECK_VVA "1" LST)....................1593 / 1.28 <fastest> (FUN_CHECK3_3 "1" LST (QUOTE RET)).....1703 / 1.19 (FUN_CHECK3_1 "1" LST).................2032 / 1 <slowest>

[Кулик Алексей aka kpblc]

Нда, что-то я про while забыл напрочь ) Вай-вай, виноват по самое не могу!

[Дима_]

А так хотелось чтоб Red Nova сам что-то изобразил.
P.S. А кстати если вставишь в (parsing) вместо check3 check_vva, у тебя появиться логическая ошибка - работать будет но неправильно - попробуй опредили почему, а если и сам исправишь...
P.P.S. Искать естественно внутри check_vva надо.

[VVA]

Пока Red Nova занят домашними заданиями, немного модифицированные ф-ции

Код:

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

;;;Возвращает T если элемент var есть в списке lst
;;;Все переменные string
(defun check_VVA_v1 (var lst / flag tmp)
  (setq var (strcat var "*"))
  (while (and (not flag) lst)
    (setq tmp (car lst) lst (cdr lst))
    (if (wcmatch tmp var)(setq flag t))
    )
  flag
  )

;;;Возвращает T если элемент var есть в списке lst
;;;Все переменные string
;;;Вариант 2
(defun check_VVA_v2 (var lst / flag tmp)
  (setq var (strcat var "*")
        tmp (car lst)
        lst (cdr lst))
  (while (and (not(setq flag (wcmatch tmp var))) lst)
    (setq tmp (car lst) lst (cdr lst))
    )
  flag
  )


(defun check3 (var lst / flag) 
(foreach tmp lst
(if (= tmp (substr var 1 (strlen tmp))) (setq flag T))
)
flag 
);end of check3


(defun fun_check3_1 (var lst / flag)
  (foreach tmp lst
    (if (and (not flag)
             (= tmp (substr var 1 (strlen tmp)))
             ) ;_ end of and
      (setq flag t)
      ) ;_ end of if
    ) ;_ end of foreach
  flag
  ) ;_ end of defun


(defun fun_check3_3 (var lst res)
; Пример вызова:
; (fun_check3_3 var lst 'result)
; Обрати внимание на апостроф перед последним параметром
; В этой переменной будет храниться результат выполнения
; fun_check_3
  (foreach tmp lst
    (if (and (not res)
             (= tmp (substr var 1 (strlen tmp)))
             ) ;_ end of and
      (progn
        (set res t)
        (quit)
        ) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of foreach
  ) ;_ end of defun

Проверка

Код:

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

(setq lst '("0" "11" "2" "3" "1CT" "2" "3"))
          (BenchMark
             '(
               (check_VVA_v1 "1C" lst)
               (check_VVA_v2 "1C" lst)
	       (fun_check3_1 "1C" lst)
	       (fun_check3_3 "1C" lst 'ret)
              )
          )

Benchmarking .................Elapsed milliseconds / relative speed for 16384 iteration(s): (CHECK_VVA_V2 "1C" LST).................1109 / 1.24 <fastest> (CHECK_VVA_V1 "1C" LST).................1141 / 1.21 (FUN_CHECK3_3 "1C" LST (QUOTE RET)).....1172 / 1.17 (CHECK3 "1C" LST).......................1328 / 1.04 (FUN_CHECK3_1 "1C" LST).................1375 / 1 <slowest>

[Red Nova]

VVA, Сегодня на работе все с ума сошли. Не получится самому что-то попробовать, душат со всех сторон. Не успею даже толком ознакомится с твоим кодом, но если это то о чем я говорил в посте #445, то прошу соеденить это с главным кодом, последняя версия которого находится на #445 (первый код)

[Кулик Алексей aka kpblc]

А, еще один момент - (member) можно посмотреть )

[VVA]

По поводу #445 A.
Здесь 1001 алгоритм удаления дублирующих элементов. Форум требует регистрации.
Приведу первые 2 по скорости алгоритма:
Алгоритм MP1

Код:

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

(defun RemoveDuplicates-mp1 ( lst / foo temp )
    (defun foo (x)
        (cond
            ((vl-position x temp) t)
            ((setq temp (cons x temp)) nil)
        )
    )
    (vl-remove-if 'foo lst)
)

Алгоритм gile

Код:

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

(defun remove_doubles (lst)
  (if lst
    (cons (car lst) (remove_doubles (vl-remove (car lst) lst)))
  )
)

Ну и мой алгоритм. Не самый быстрый, но адаптирован для сравнения вещественных чисел, когда должно выполняться равенство 0.99999999=1

Код:

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

;;;Удаляет одинаковые (дубликаты) элементы из списка
;;; На основе http://www.theswamp.org/index.php?topic=19128.0
;;; Изменено для сравнения вещественных чисел (equal ... 1e-6)
(defun mip_MakeUniqueMembersOfList  ( lst / OutList head)
  (while lst
    (setq head (car lst)
          lst (vl-remove-if '(lambda(pt)(equal pt head 1e-6))(cdr lst))
          OutList (append OutList (list head))))
  OutList
  )

[CB]

>Red Nova #453
Прежде чем помогать дальше, лично я хотел бы для начала разобраться со списком spisok, а именно:
1. Что есть такое - "\U+E72E" "\U+E720" "\U+E729" "\U+E725" (у меня все они отображаются как знак квадрата). Хотя наверняка это символы уголка, двутавра и т.д. из СПДС?
2. Почему список ограничен номером 20 - "20%%c", "20 %%c", "20\U+E712", "20 \U+E712"? Что "25%%c" или "120%%c"не может быть?
Ну и еще одна ф-ция для удаления дубликатов:

Код:

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

 
(defun while-remove-lst (lst / temp)
  (while lst
    (setq temp (cons (car lst) temp))
    (setq lst (vl-remove (car lst) (cdr lst)))
  ) ;_ end of while
  (reverse temp)
) ;_ end of defun
;;;(while-remove-lst lst)

[Дима_]

Сообщение от VVA Пока Red Nova занят домашними заданиями, немного модифицированные ф-ции

Под словом модифицированные я понимаю "оптимизированные" , это моя слабость, ни что так не оптимизирует процесс, как алгоритм
"Скорострельность" проверять на больших списках (например из #445), предварительно отсортированных - (setq spisok (vl-sort spisok '<))

Код:

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

(defun check3_1 (var lst / i tmp flag start end)
(setq start -1 end (length lst))
(while (and (/= (1+ start) end) (not flag))
(setq i (+ start (/ (- end start) 2)) tmp (nth i lst))
(if 	(= tmp (substr var 1 (strlen tmp)))
	(setq flag T)
	(if (< tmp var) (setq start i) (setq end i))
)
)
flag
)

P.S. Red Nova - прости что глумимся в твоей ветке.

[VVA]

Дима_,
Даже на больших и отсортированных списках benchmark дает

Код:

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

(setq lst (list "-" "Фл." "Фл." "Фланец" "Лист" "Полоса" "\U+E72E" "Тр" "\U+E720" "Уголок" "\U+E729" "Двутавр" "\U+E725" "Швеллер" 
"%%c" "\U+E712" "2%%c" "3%%c" "4%%c" "5%%c" "6%%c" "7%%c" "8%%c" "9%%c" "10%%c" "11%%c" "12%%c" "13%%c" "14%%c" "15%%c" "16%%c" "17%%c" "18%%c" "19%%c" "20%%c" 
 "2 %%c" "3 %%c" "4 %%c" "5 %%c" "6 %%c" "7 %%c" "8 %%c" "9 %%c" "10 %%c" "11 %%c" "12 %%c" "13 %%c" "14 %%c" "15 %%c" "16 %%c" "17 %%c" "18 %%c" "19 %%c" "20 %%c" 
"2\U+E712" "3\U+E712" "4\U+E712" "5\U+E712" "6\U+E712" "7\U+E712" "8\U+E712" "9\U+E712" "10\U+E712" "11\U+E712" "12\U+E712" "13\U+E712" "14\U+E712" "15\U+E712" "16\U+E712" "17\U+E712" "18\U+E712" "19\U+E712" "20\U+E712"  
"2 \U+E712" "3 \U+E712" "4 \U+E712" "5 \U+E712" "6 \U+E712" "7 \U+E712" "8 \U+E712" "9 \U+E712" "10 \U+E712" "11 \U+E712" "12 \U+E712" "13 \U+E712" "14 \U+E712" "15 \U+E712" "16 \U+E712" "17 \U+E712" "18 \U+E712" "19 \U+E712" "20 \U+E712"))
(setq lst (vl-sort lst '<))
          (BenchMark
             '(
               (check_VVA_v1 "16 %%c" lst)
               (check_VVA_v2 "16 %%c" lst)
	       (fun_check3_1 "16 %%c" lst)
               (check3_1 "16 %%c" lst)
               (check3 "16 %%c" lst)
	       (fun_check3_3 "16 %%c" lst 'ret)
              )
          )

Benchmarking .................Elapsed milliseconds / relative speed for 16384 iteration(s): (CHECK_VVA_V2 "16 %%c" LST).................1703 / 3.53 <fastest> (CHECK_VVA_V1 "16 %%c" LST).................1750 / 3.44 (CHECK3_1 "16 %%c" LST).....................2219 / 2.71 (FUN_CHECK3_3 "16 %%c" LST (QUOTE RET)).....2984 / 2.02 (FUN_CHECK3_1 "16 %%c" LST).................3484 / 1.73 (CHECK3 "16 %%c" LST).......................6016 / 1 <slowest>

Можешь погонять сам. Код benchmark можно взять, например, отсюда (требуется регистрация) или отсюда

[Елпанов Евгений]

вроде, так проще и быстрее...

Код:

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

(defun test (var lst)
 (vl-some (function (lambda (a) (= var a))) lst)
)

[Red Nova]

CB,

1. Что есть такое - "\U+E72E" "\U+E720" "\U+E729" "\U+E725" (у меня все они отображаются как знак квадрата). Хотя наверняка это символы уголка, двутавра и т.д. из СПДС?

Все как ты и предположил. Прикрепляю этот шрифт.

2. Почему список ограничен номером 20 - "20%%c", "20 %%c", "20\U+E712", "20 \U+E712"? Что "25%%c" или "120%%c"не может быть?

\U+E712 и 20%%c означают диаметр, это используется, когда на сечении балки или колонны ставят на одну позицию выноску, и заодно пишут сколько там такой арматуры. На пример 8 \U+E712 12 AIII, означает, что там 8 арматур диаметром 12. Ввиду того, что балки и колонны не армируются очень большим количеством стержней я ввел ограничение.
Дима_,

P.S. Red Nova - прости что глумимся в твоей ветке.

Глумитесь на здоровье.

[Дима_]

То VVA чем меньше список тем быстрее "простой перебор", его можно оптимизировать экономя байты - но эта оптимизация в пределах нескольких процентов, а check3_1 - это совсем другой алгоритм, он не быстро "все подряд" перебирает, а интелектуально! А если spisok до тысячи дорастет? Как тогда Benchmarking'и будут выглядеть, а до 10 тыс.?

[Red Nova]

Товарищи программисты. Когда выдастся свободная от дискуссий минутка не могли бы ли вы добавить в наш код условия с #445? У меня все равно умений не хватит самому сотворить.

[VVA]

По условиям #445 A, B.1, B.2 Изменения выделены красным

Код:

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

(vl-load-com)
(defun parsing (tmp)
(and
(= (length tmp) 2); длина списка равна 2
(/= (car tmp) ""); Первый элемент не равен ""
(/= (cadr tmp) ""); то же со вторым
(check2 (car tmp)); проверка второго условия к первой строке
(check3 (cadr tmp) spisok); проверка первых символов второй строки
);блок условий который надо расширять до твоих требований
);end of parsing
 
(defun filtr (lst / newlst)
(foreach tmp lst
(if (parsing tmp)
  (setq newlst
         (append newlst
           (list
             (mapcar 'prep-str tmp)))
    )
  )
);end of foreach
(while-remove-lst newlst)
);end filtr

ПОЛНЫЙ ТЕКСТ ВО ВЛОЖЕНИИ 445.lsp

Обращаю внимение, что в списке lisp'a символы юникода должны писаться с двойным слэшем
(setq spisok (list "\\U+E72E" )

*** Добавлено
Автоматически приклеились ссылки, прикрепляю файл. Проверка-функция test2

[Red Nova]

VVA, Спасибо, но пока не все гладко.
При загрузке пишет

Код:

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

Command: _appload test.lsp successfully loaded.

Command: ; error: extra right paren on input

Пробовал фильтровать такой список выносок.

Код:

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

(("1" "-10х100x100") ("1" "-10х100x100") ("2" "Швеллер 12") 
("2" "Швеллер 12, L=1000") ("2" "Швеллер 12, L=1000, шаг 1000") 
("3" "12 Ас1, ΣL=10000")  ("3" "12 Ас1") ("4" "20 Ас1") ("5" "20 А500c")
 ("5" "20 А500c, L=1000"))

Вернуло вот что

Код:

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

(("1" "-10х100x100") ("2" "Швеллер 12") ("2" "Швеллер 12, L=1000") 
("5" "20 А500c") ("5" "20 А500c, L=1000"))

Если заметил, полностью пропали позиции 3 и 4. А позиции 2 и 5 не отфильтровались полностью

[Red Nova]

VVA,

Обращаю внимение, что в списке lisp'a символы юникода должны писаться с двойным слэшем (setq spisok (list "\\U+E72E" )

А у меня и с одним слешом предыдущяя версия с #445 работала корректно.

[VVA]

Red Nova, В #465 я писал

*** Добавлено Автоматически приклеились ссылки, прикрепляю файл. Проверка-функция test2

Грузить надо его

[Red Nova]

Только дошел смысл этих строк.
Пробовал (test)
Вот результат работы этого лиспа для списка с #466

Код:

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

(("1" "-10х100x200") ("2" "Швеллер 12, L=1000") ("2" "Швеллер 12") ("3" "12 
Ас1, ΣL=10000") ("3" "12 Ас1") ("4" "20 Ас1") ("5" "20 А500c, L=1000") ("5" 
"20 А500c"))

Позиции 2 и 5 не отфильтровались до конца, от каждого надо оставить более длинный список, если длина равна, то брать можно любой (даже если содержания разные)
(test2) выдает

Код:

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

(("1" "-10х100x200") ("2" "Швеллер 12, L=1000") ("2" "Швеллер 12") ("3" "∅12 
Ас1, ?L=10000"))

Ты не ответил на #467.
У тебя в коде есть также символы с тремя слешами, типа

Код:

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

"\\\U+E729"

Это опечатка?

[VVA]

Это опечатка?

Да

А у меня и с одним слешом предыдущяя версия с #445 работала корректно

А у меня выдавала в списке так "U+E729"

Позиции 2 и 5 не отфильтровались до конца

Из пункта A #445 я сделал только

Необходимо удалить дублирующие элементы

[Vov.Ka]

предлагаю свой вариант для BenchMarkа

Код:

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

(defun check_vk_v1 (var lst /)
  (setq var (strcat var "*"))
  (and (vl-member-if
	 (function (lambda (e) (wcmatch e var)))
	 lst
       )
  )
)

[Кулик Алексей aka kpblc]

К вопросу о фильтрации других СПДС-объектов (точнее, выносок)
Голова что-то соображает достаточно хреново, поэтому только такой код смог "родить":

Код:

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

(defun _dwgru-get-spds-text-and-range (/ selset lst)
                                      ;|
*    Возвращает список строк выделенных выносок. В набор попадают узловые выноски,
* позиционные выноски, цепные и гребенчатые.
*    Параметры вызова:
	нет
*    Примеры вызова:
(_dwgru-get-spds-text)
	;
|;
  (if
    (and
      (= (type (setq selset (vl-catch-all-apply
                              (function (lambda () (ssget)))
                              ) ;_ end of vl-catch-all-apply
                     ) ;_ end of setq
               ) ;_ end of type
         'pickset
         ) ;_ end of =
      (setq selset
             (vl-remove-if-not
               (function
                 (lambda (x)
                   (member (cdr (assoc 0 x))
                           '("spdsNotePosition"
                             "spdsNoteKnot"
                             "spdsNoteComb"
                             "spdsNoteChain"
                             )
                           ) ;_ end of member
                   ) ;_ end of lambda
                 ) ;_ end of function
               (mapcar
                 (function (lambda (a)
                             (vl-remove-if-not
                               '(lambda (b) (member (car b) '(0 300 301 90)))
                               (entget a)
                               ) ;_ end of vl-remove-if-not
                             ) ;_ end of lambda
                           ) ;_ end of function
                 (_dwgru-conv-pickset-to-list selset)
                 ) ;_ end of mapcar
               ) ;_ end of vl-remove-if-not
            ) ;_ end of setq
      ) ;_ end of and
     (setq
       lst
        (mapcar
          (function
            (lambda (item)
              (cond
                ((= (cdr (assoc 0 item)) "spdsNoteKnot")
                 (append (mapcar
                           (function cdr)
                           (vl-remove-if-not
                             (function
                               (lambda (x)
                                 (= (car x) 300)
                                 ) ;_ end of lambda
                               ) ;_ end of function
                             (reverse
                               (member '(301 . "Выравнивание текста")
                                       (reverse (member '(301 . "Номер узла") item))
                                       ) ;_ end of member
                               ) ;_ end of reverse
                             ) ;_ end of vl-remove-if-not
                           ) ;_ end of mapcar
                         (list 1)
                         ) ;_ end of append
                 )
                ((= (cdr (assoc 0 item)) "spdsNotePosition")
                 (append (mapcar
                           (function cdr)
                           (vl-remove-if-not
                             (function
                               (lambda (x)
                                 (= (car x) 300)
                                 ) ;_ end of lambda
                               ) ;_ end of function
                             (member '(301 . "Первая строка") item)
                             ) ;_ end of vl-remove-if-not
                           ) ;_ end of mapcar
                         (list 1)
                         ) ;_ end of append
                 )
                ((member (cdr (assoc 0 item))
                         '("spdsNoteComb" "spdsNoteChain")
                         ) ;_ end of member
                 (append
                   (mapcar
                     (function cdr)
                     (vl-remove-if-not
                       (function
                         (lambda (x)
                           (= (car x) 300)
                           ) ;_ end of lambda
                         ) ;_ end of function
                       (reverse
                         (member '(301 . "Выравнивание текста")
                                 (reverse (member '(301 . "Первая строка") item))
                                 ) ;_ end of member
                         ) ;_ end of reverse
                       ) ;_ end of vl-remove-if-not
                     ) ;_ end of mapcar
                   (list (cdr (assoc 90 (reverse item))))
                   ) ;_ end of cons
                 )
                ) ;_ end of cond
              ) ;_ end of lambda
            ) ;_ end of function
          selset
          ) ;_ end of mapcar
       ) ;_ end of setq
     ) ;_ end of if
  lst
  ) ;_ end of defun

Хотя на самом деле там можно просто собирать (cdr(assoc 300 (member '(301 . "Info") (entget <Элемент набора, преобразованного в список>)))) - там же полная (практически) информация о выноске! Одной строкой! Преобразовать ее в список не так уж и сложно...

[Red Nova]

Кулик Алексей aka kpblc, Спасибо большое. Наконец и другие выноски можно добавить к списку. (к стати в коде указан неверный пример вызова команды)
Вот пример полученного таким путем списка.

(("Узел" "" "1" 1) ("Цепная" "Выноска" 2) ("Греб" "Выноска" 2) ("Поз" "Выноска" 1))

Список захватил кроме Позиционных, Гребенчатых и Цепных также и Узловую выноску. Она не очень нужна, (по крайней мере ею у нас позиции не ставят) но проблем с ее присутствием быть не должно, информация все равно должна отфильтроваться.
В список так же стали приписываться цифры 1 и 2 (наверное количество стрелок)
("Узел" "" "1" 1) ("Греб" "Выноска" 2)
Поскольку часть алгоритма для фильтров уже написана для списка не учитывая количество стрелок (да и вряд ли это нужно), думаю от этого нужно избавиться. Если не затруднит, то прошу это сделать.

VVA,

Из пункта A #445 я сделал только Цитата: Необходимо удалить дублирующие элементы

Тогда все нормально. А можно продолжить по требованиям понкта А и дальше?

[Кулик Алексей aka kpblc]

Red Nova, я количество сознательно сделал. В качестве задания: у тебя есть список вида

Код:

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

'(("Узел" "" "1" 1) ("Цепная" "Выноска" 2) ("Греб" "Выноска" 2) ("Поз" "Выноска" 1))

Надо из каждого подсписка удалить элементы, не являющиеся строками и получить на выходе

Код:

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

'(("Узел" "" "1") ("Цепная" "Выноска") ("Греб" "Выноска") ("Поз" "Выноска"))

Используемые функции: type. Возможно, понадобятся mapcar и vl-remoму-if или vl-remove-if-not.

[Елпанов Евгений]

Провел сравнительный анализ, скорости выполнения разных вариантов программы. Результаты выкладываю.

Коды для сравнения:

Код:

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

(defun check_vk_v1 (var lst /)
 (setq var (strcat var "*"))
 (and
  (vl-member-if (function (lambda (e) (wcmatch e var))) lst)
 ) ;_  and
) ;_  defun
(defun check_eea_v1 (var lst)
 (vl-some (function (lambda (a) (= var a))) lst)
) ;_  defun
;;;Возвращает T если элемент var есть в списке lst
;;;Все переменные string
(defun check_VVA_v1 (var lst / flag tmp)
 (setq var (strcat var "*"))
 (while (and (not flag) lst)
  (setq tmp (car lst)
        lst (cdr lst)
  ) ;_  setq
  (if (wcmatch tmp var)
   (setq flag t)
  ) ;_  if
 ) ;_  while
 flag
) ;_  defun
;;;Возвращает T если элемент var есть в списке lst
;;;Все переменные string
;;;Вариант 2
(defun check_VVA_v2 (var lst / flag tmp)
 (setq var (strcat var "*")
       tmp (car lst)
       lst (cdr lst)
 ) ;_  setq
 (while (and (not (setq flag (wcmatch tmp var))) lst)
  (setq tmp (car lst)
        lst (cdr lst)
  ) ;_  setq
 ) ;_  while
 flag
) ;_  defun
(defun check3 (var lst / flag)
 (foreach tmp lst
  (if (= tmp (substr var 1 (strlen tmp)))
   (setq flag T)
  ) ;_  if
 ) ;_  foreach
 flag
) ;end of check3
(defun fun_check3_1 (var lst / flag)
 (foreach tmp lst
  (if (and (not flag) (= tmp (substr var 1 (strlen tmp)))) ;_ end of and
   (setq flag t)
  ) ;_ end of if
 ) ;_ end of foreach
 flag
) ;_ end of defun
(defun fun_check3_3 (var lst res) ; Пример вызова:
  ; (fun_check3_3 var lst 'result)
  ; Обрати внимание на апостроф перед последним параметром
  ; В этой переменной будет храниться результат выполнения
  ; fun_check_3
 (foreach tmp lst
  (if (and (not res) (= tmp (substr var 1 (strlen tmp)))) ;_ end of and
   (progn (set res t) (quit)) ;_ end of progn
  ) ;_ end of if
 ) ;_ end of foreach
) ;_ end of defun

Тестовый список:

Код:

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

(setq lst (list "-"           "Фл."         "Фл."
                "Фланец"      "Лист"        "Полоса"
                "\U+E72E"     "Тр"          "\U+E720"
                "Уголок"      "\U+E729"     "Двутавр"
                "\U+E725"     "Швеллер"     "%%c"
                "\U+E712"     "2%%c"        "3%%c"
                "4%%c"        "5%%c"        "6%%c"
                "7%%c"        "8%%c"        "9%%c"
                "10%%c"       "11%%c"       "12%%c"
                "13%%c"       "14%%c"       "15%%c"
                "16%%c"       "17%%c"       "18%%c"
                "19%%c"       "20%%c"       "2 %%c"
                "3 %%c"       "4 %%c"       "5 %%c"
                "6 %%c"       "7 %%c"       "8 %%c"
                "9 %%c"       "10 %%c"      "11 %%c"
                "12 %%c"      "13 %%c"      "14 %%c"
                "15 %%c"      "16 %%c"      "17 %%c"
                "18 %%c"      "19 %%c"      "20 %%c"
                "2\U+E712"    "3\U+E712"    "4\U+E712"
                "5\U+E712"    "6\U+E712"    "7\U+E712"
                "8\U+E712"    "9\U+E712"    "10\U+E712"
                "11\U+E712"   "12\U+E712"   "13\U+E712"
                "14\U+E712"   "15\U+E712"   "16\U+E712"
                "17\U+E712"   "18\U+E712"   "19\U+E712"
                "20\U+E712"   "2 \U+E712"   "3 \U+E712"
                "4 \U+E712"   "5 \U+E712"   "6 \U+E712"
                "7 \U+E712"   "8 \U+E712"   "9 \U+E712"
                "10 \U+E712"  "11 \U+E712"  "12 \U+E712"
                "13 \U+E712"  "14 \U+E712"  "15 \U+E712"
                "16 \U+E712"  "17 \U+E712"  "18 \U+E712"
                "19 \U+E712"  "20 \U+E712"
               )
)

Результаты сравнения - каждый раз указывался разный элемент списка...


первый элемент из 92

Код:

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

Benchmarking ...................Elapsed milliseconds / relative speed for 65536 iteration(s):

    (CHECK_VVA_V2 "-" LST)..................1437 / 8.47 <fastest>
    (CHECK_VVA_V1 "-" LST)..................1453 / 8.38
    (CHECK_EEA_V1 "-" LST)..................1594 / 7.64
    (CHECK_VK_V1 "-" LST)...................1609 / 7.56
    (FUN_CHECK3_3 "-" LST (QUOTE RET))......4641 / 2.62
    (FUN_CHECK3_1 "-" LST)..................4719 / 2.58
    (CHECK3 "-" LST).......................12172 / 1 <slowest>

21 элемент из 92

Код:

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

Benchmarking ...................Elapsed milliseconds / relative speed for 65536 iteration(s):

    (CHECK_EEA_V1 "6%%c" LST)..................1968 / 6.26 <fastest>
    (CHECK_VK_V1 "6%%c" LST)...................2329 / 5.29
    (CHECK_VVA_V1 "6%%c" LST)..................2891 / 4.26
    (CHECK_VVA_V2 "6%%c" LST)..................2891 / 4.26
    (FUN_CHECK3_3 "6%%c" LST (QUOTE RET))......4656 / 2.64
    (FUN_CHECK3_1 "6%%c" LST)..................6578 / 1.87
    (CHECK3 "6%%c" LST).......................12313 / 1 <slowest>

41 элемент из 92

Код:

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

Benchmarking ..................Elapsed milliseconds / relative speed for 32768 iteration(s):

    (CHECK_EEA_V1 "7 %%c" LST).................1203 / 5.1 <fastest>
    (CHECK_VK_V1 "7 %%c" LST)..................1485 / 4.14
    (CHECK_VVA_V1 "7 %%c" LST).................2062 / 2.98
    (CHECK_VVA_V2 "7 %%c" LST).................2094 / 2.93
    (FUN_CHECK3_3 "7 %%c" LST (QUOTE RET)).....2328 / 2.64
    (FUN_CHECK3_1 "7 %%c" LST).................4265 / 1.44
    (CHECK3 "7 %%c" LST).......................6141 / 1 <slowest>

71 элемент из 92

Код:

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

Benchmarking ..................Elapsed milliseconds / relative speed for 32768 iteration(s):

    (CHECK_EEA_V1 "18\U+E712" LST)...............1500 / 4.14 <fastest>
    (CHECK_VK_V1 "18\U+E712" LST)................2032 / 3.05
    (FUN_CHECK3_3 "18\U+E712" LST (QUOTE...).....2328 / 2.66
    (CHECK_VVA_V1 "18\U+E712" LST)...............3125 / 1.98
    (CHECK_VVA_V2 "18\U+E712" LST)...............3172 / 1.96
    (FUN_CHECK3_1 "18\U+E712" LST)...............5781 / 1.07
    (CHECK3 "18\U+E712" LST).....................6203 / 1 <slowest>

92 элемент из 92

Код:

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

Benchmarking ..................Elapsed milliseconds / relative speed for 32768 iteration(s):

    (CHECK_EEA_V1 "20 \U+E712" LST)..............1703 / 4 <fastest>
    (FUN_CHECK3_3 "20 \U+E712" LST (QUOT...).....2312 / 2.95
    (CHECK_VK_V1 "20 \U+E712" LST)...............2406 / 2.83
    (CHECK_VVA_V1 "20 \U+E712" LST)..............3860 / 1.77
    (CHECK_VVA_V2 "20 \U+E712" LST)..............3922 / 1.74
    (CHECK3 "20 \U+E712" LST)....................6156 / 1.11
    (FUN_CHECK3_1 "20 \U+E712" LST)..............6813 / 1 <slowest>

[Дима_]

Сообщение от Елпанов Евгений Провел сравнительный анализ, скорости выполнения разных вариантов программы. Результаты выкладываю. Коды для сравнения: Код: [Выделить все] (defun check_vk_v1 (var lst /) (setq var (strcat var "*")) (and (vl-member-if (function (lambda (e) (wcmatch e var))) lst) ) ;_ and ) ;_ defun (defun check_eea_v1 (var lst) (vl-some (function (lambda (a) (= var a))) lst) ) ;_ defun ;;;Возвращает T если элемент var есть в списке lst ;;;Все переменные string (defun check_VVA_v1 (var lst / flag tmp) (setq var (strcat var "*")) (while (and (not flag) lst) (setq tmp (car lst) lst (cdr lst) ) ;_ setq (if (wcmatch tmp var) (setq flag t) ) ;_ if ) ;_ while flag ) ;_ defun ;;;Возвращает T если элемент var есть в списке lst ;;;Все переменные string ;;;Вариант 2 (defun check_VVA_v2 (var lst / flag tmp) (setq var (strcat var "*") tmp (car lst) lst (cdr lst) ) ;_ setq (while (and (not (setq flag (wcmatch tmp var))) lst) (setq tmp (car lst) lst (cdr lst) ) ;_ setq ) ;_ while flag ) ;_ defun (defun check3 (var lst / flag) (foreach tmp lst (if (= tmp (substr var 1 (strlen tmp))) (setq flag T) ) ;_ if ) ;_ foreach flag ) ;end of check3 (defun fun_check3_1 (var lst / flag) (foreach tmp lst (if (and (not flag) (= tmp (substr var 1 (strlen tmp)))) ;_ end of and (setq flag t) ) ;_ end of if ) ;_ end of foreach flag ) ;_ end of defun (defun fun_check3_3 (var lst res) ; Пример вызова: ; (fun_check3_3 var lst 'result) ; Обрати внимание на апостроф перед последним параметром ; В этой переменной будет храниться результат выполнения ; fun_check_3 (foreach tmp lst (if (and (not res) (= tmp (substr var 1 (strlen tmp)))) ;_ end of and (progn (set res t) (quit)) ;_ end of progn ) ;_ end of if ) ;_ end of foreach ) ;_ end of defun [/code]

А что-ж check3_1 из #459 не добавил? Тоже хочу в соревновании побыть, правда для нее список маловат конечно.

[CB]

А что, простой member уже снят со счетов? Или я чего-то не понял

Код:

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

(if (member var lst) t)

[Кулик Алексей aka kpblc]

Похоже http://dwg.ru/f/showpost.php?p=290538&postcount=456

[Елпанов Евгений]

Сообщение от Дима_ А что-ж check3_1 из #459 не добавил? Тоже хочу в соревновании побыть, правда для нее список маловат конечно.

Приношу свои извинения.
Но советую исправить ошибки в своей программе check3_1...

Код:

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

(defun check3_1 (var lst / i tmp flag start end)
 (setq start -1
       end   (length lst)
 ) ;_  setq
 (while (and (/= (1+ start) end) (not flag))
  (setq i   (+ start (/ (- end start) 2))
        tmp (nth i lst)
  ) ;_  setq
  (if (= tmp (substr var 1 (strlen tmp)))
   (setq flag T)
   (if (< tmp var)
    (setq start i)
    (setq end i)
   ) ;_  if
  ) ;_  if
 ) ;_  while
 flag
)

список:

Код:

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

(setq lst (list "-"           "Фл."         "Фл."
                "Фланец"      "Лист"        "Полоса"
                "\U+E72E"     "Тр"          "\U+E720"
                "Уголок"      "\U+E729"     "Двутавр"
                "\U+E725"     "Швеллер"     "%%c"
                "\U+E712"     "2%%c"        "3%%c"
                "4%%c"        "5%%c"        "6%%c"
                "7%%c"        "8%%c"        "9%%c"
                "10%%c"       "11%%c"       "12%%c"
                "13%%c"       "14%%c"       "15%%c"
                "16%%c"       "17%%c"       "18%%c"
                "19%%c"       "20%%c"       "2 %%c"
                "3 %%c"       "4 %%c"       "5 %%c"
                "6 %%c"       "7 %%c"       "8 %%c"
                "9 %%c"       "10 %%c"      "11 %%c"
                "12 %%c"      "13 %%c"      "14 %%c"
                "15 %%c"      "16 %%c"      "17 %%c"
                "18 %%c"      "19 %%c"      "20 %%c"
                "2\U+E712"    "3\U+E712"    "4\U+E712"
                "5\U+E712"    "6\U+E712"    "7\U+E712"
                "8\U+E712"    "9\U+E712"    "10\U+E712"
                "11\U+E712"   "12\U+E712"   "13\U+E712"
                "14\U+E712"   "15\U+E712"   "16\U+E712"
                "17\U+E712"   "18\U+E712"   "19\U+E712"
                "20\U+E712"   "2 \U+E712"   "3 \U+E712"
                "4 \U+E712"   "5 \U+E712"   "6 \U+E712"
                "7 \U+E712"   "8 \U+E712"   "9 \U+E712"
                "10 \U+E712"  "11 \U+E712"  "12 \U+E712"
                "13 \U+E712"  "14 \U+E712"  "15 \U+E712"
                "16 \U+E712"  "17 \U+E712"  "18 \U+E712"
                "19 \U+E712"  "20 \U+E712"
               )
)

результаты тестирования:

первый элемент из 92

Код:

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

    (CHECK_VVA_V2 "-" LST)................1469 / 8.51 <fastest>
    (CHECK_VVA_V1 "-" LST)................1500 / 8.33
    (CHECK_EEA_V1 "-" LST)................1610 / 7.76
    (CHECK_VK_V1 "-" LST).................1656 / 7.55
    (CHECK3_1 "-" LST)....................2812 / 4.45
    (FUN_CHECK3_3 "-" LST (QUOTE A))......4796 / 2.61
    (FUN_CHECK3_1 "-" LST)................4828 / 2.59
    (CHECK3 "-" LST).....................12500 / 1 <slowest>

;(FUN_CHECK3_3 "-" LST (QUOTE A)) ; A = nil

;; 11 элемент из 92

Код:

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

    (CHECK_EEA_V1 "\U+E729" LST)................1859 / 6.77 <fastest>
    (CHECK_VK_V1 "\U+E729" LST).................2078 / 6.05
    (CHECK_VVA_V1 "\U+E729" LST)................2281 / 5.51
    (CHECK_VVA_V2 "\U+E729" LST)................2281 / 5.51
    (CHECK3_1 "\U+E729" LST)....................3266 / 3.85
    (FUN_CHECK3_3 "\U+E729" LST (QUOTE A))......4812 / 2.61
    (FUN_CHECK3_1 "\U+E729" LST)................5796 / 2.17
    (CHECK3 "\U+E729" LST).....................12579 / 1 <slowest>

;(CHECK3_1 "\U+E729" LST) =>> nil
;(FUN_CHECK3_3 "\U+E729" LST (QUOTE A)) ; A = nil

;; 21 элемент из 92

Код:

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

    (CHECK_EEA_V1 "6%%c" LST)...............1047 / 6.06 <fastest>
    (CHECK_VK_V1 "6%%c" LST)................1219 / 5.2
    (CHECK_VVA_V1 "6%%c" LST)...............1484 / 4.27
    (CHECK_VVA_V2 "6%%c" LST)...............1500 / 4.23
    (CHECK3_1 "6%%c" LST)...................1516 / 4.18
    (FUN_CHECK3_3 "6%%c" LST (QUOTE A)).....2406 / 2.64
    (FUN_CHECK3_1 "6%%c" LST)...............3406 / 1.86
    (CHECK3 "6%%c" LST).....................6344 / 1 <slowest>

;(CHECK3_1 "6%%c" LST) =>> nil
;(FUN_CHECK3_3 "6%%c" LST (QUOTE A)) ; A = nil

;; 31 элемент из 92

Код:

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

    (CHECK_EEA_V1 "16%%c" LST)...............1157 / 5.48 <fastest>
    (CHECK_VK_V1 "16%%c" LST)................1391 / 4.56
    (CHECK3_1 "16%%c" LST)...................1609 / 3.94
    (CHECK_VVA_V1 "16%%c" LST)...............1813 / 3.5
    (CHECK_VVA_V2 "16%%c" LST)...............1843 / 3.44
    (FUN_CHECK3_3 "16%%c" LST (QUOTE A)).....2406 / 2.64
    (FUN_CHECK3_1 "16%%c" LST)...............3891 / 1.63
    (CHECK3 "16%%c" LST).....................6344 / 1 <slowest>

;(CHECK3_1 "16%%c" LST) =>> nil
;(FUN_CHECK3_3 "16%%c" LST (QUOTE A)) ; A = nil

;; 41 элемент из 92

Код:

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

    (CHECK_EEA_V1 "7 %%c" LST)...............1250 / 5.09 <fastest>
    (CHECK3_1 "7 %%c" LST)...................1516 / 4.19
    (CHECK_VK_V1 "7 %%c" LST)................1531 / 4.15
    (CHECK_VVA_V1 "7 %%c" LST)...............2141 / 2.97
    (CHECK_VVA_V2 "7 %%c" LST)...............2172 / 2.93
    (FUN_CHECK3_3 "7 %%c" LST (QUOTE A)).....2422 / 2.63
    (FUN_CHECK3_1 "7 %%c" LST)...............4437 / 1.43
    (CHECK3 "7 %%c" LST).....................6359 / 1 <slowest>

;(CHECK3_1 "7 %%c" LST) =>> nil
;(FUN_CHECK3_3 "7 %%c" LST (QUOTE A)) ; A = nil

;; 51 элемент из 92

Код:

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

    (CHECK_EEA_V1 "17 %%c" LST)...............1375 / 4.67 <fastest>
    (CHECK3_1 "17 %%c" LST)...................1516 / 4.24
    (CHECK_VK_V1 "17 %%c" LST)................1735 / 3.7
    (FUN_CHECK3_3 "17 %%c" LST (QUOTE A)).....2406 / 2.67
    (CHECK_VVA_V1 "17 %%c" LST)...............2484 / 2.59
    (CHECK_VVA_V2 "17 %%c" LST)...............2531 / 2.54
    (FUN_CHECK3_1 "17 %%c" LST)...............4969 / 1.29
    (CHECK3 "17 %%c" LST).....................6422 / 1 <slowest>

;(CHECK3_1 "17 %%c" LST) =>> nil
;(FUN_CHECK3_3 "17 %%c" LST (QUOTE A)) ; A = nil

;; 61 элемент из 92

Код:

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

    (CHECK_EEA_V1 "8\U+E712" LST)...............1468 / 4.32 <fastest>
    (CHECK3_1 "8\U+E712" LST)...................1640 / 3.87
    (CHECK_VK_V1 "8\U+E712" LST)................1906 / 3.33
    (FUN_CHECK3_3 "8\U+E712" LST (QUOTE A)).....2407 / 2.64
    (CHECK_VVA_V1 "8\U+E712" LST)...............2860 / 2.22
    (CHECK_VVA_V2 "8\U+E712" LST)...............2922 / 2.17
    (FUN_CHECK3_1 "8\U+E712" LST)...............5407 / 1.17
    (CHECK3 "8\U+E712" LST).....................6343 / 1 <slowest>

;(CHECK3_1 "8\U+E712" LST) =>> nil
;(FUN_CHECK3_3 "8\U+E712" LST (QUOTE A)) ; A = nil

;; 71 элемент из 92

Код:

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

    (CHECK_EEA_V1 "18\U+E712" LST)...............1578 / 4.03 <fastest>
    (CHECK3_1 "18\U+E712" LST)...................1625 / 3.91
    (CHECK_VK_V1 "18\U+E712" LST)................2109 / 3.02
    (FUN_CHECK3_3 "18\U+E712" LST (QUOTE A)).....2406 / 2.64
    (CHECK_VVA_V1 "18\U+E712" LST)...............3235 / 1.97
    (CHECK_VVA_V2 "18\U+E712" LST)...............3297 / 1.93
    (FUN_CHECK3_1 "18\U+E712" LST)...............5969 / 1.07
    (CHECK3 "18\U+E712" LST).....................6359 / 1 <slowest>

;(FUN_CHECK3_3 "18\U+E712" LST (QUOTE A)) ; A = nil

;; 81 элемент из 92

Код:

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

    (CHECK3_1 "9 \U+E712" LST)...................1141 / 5.67 <fastest>
    (CHECK_EEA_V1 "9 \U+E712" LST)...............1672 / 3.87
    (CHECK_VK_V1 "9 \U+E712" LST)................2281 / 2.84
    (FUN_CHECK3_3 "9 \U+E712" LST (QUOTE A)).....2422 / 2.67
    (CHECK_VVA_V1 "9 \U+E712" LST)...............3594 / 1.8
    (CHECK_VVA_V2 "9 \U+E712" LST)...............3641 / 1.78
    (CHECK3 "9 \U+E712" LST).....................6375 / 1.01
    (FUN_CHECK3_1 "9 \U+E712" LST)...............6469 / 1 <slowest>
     
;(FUN_CHECK3_3 "9 \U+E712" LST (QUOTE A)) ; A = nil

;; 92 элемент из 92

Код:

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

    (CHECK3_1 "20 \U+E712" LST)..................1047 / 4.6 <fastest>
    (CHECK_EEA_V1 "20 \U+E712" LST)..............1360 / 3.54
    (CHECK_VK_V1 "20 \U+E712" LST)...............1734 / 2.78
    (FUN_CHECK3_3 "20 \U+E712" LST (QUOTE A)).....1969 / 2.44
    (CHECK_VVA_V2 "20 \U+E712" LST)..............3078 / 1.56
    (CHECK_VVA_V1 "20 \U+E712" LST)..............3141 / 1.53
    (CHECK3 "20 \U+E712" LST)....................4250 / 1.13
    (FUN_CHECK3_1 "20 \U+E712" LST)..............4813 / 1 <slowest>

;(CHECK3_1 "20 \U+E712" LST) =>> nil
;(FUN_CHECK3_3 "20 \U+E712" LST (QUOTE A)) ; A = nil

[Дима_]

А "простым" memberom не получиться ибо:

Код:

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

Команда: (member "12" (list "123" "456" "789"))
nil

А у нас должно быть T

[Дима_]

To Елпанов Евгений, наверное не внимательно #459 читал - список надо предварительно отсортировать - он не все подряд перебирает, как другие:
Из 459: ""Скорострельность" проверять на больших списках (например из #445), предварительно отсортированных - (setq spisok (vl-sort spisok '<))"

P.S. ну в нашем случае вместо spisok lst разумеется и будет CHECK3_1 "20 \U+E712" LST) T

[Red Nova]

Крыс
На работе до сих пор прессуют.Пока придется забыть про обучение лиспу в рабочие часы.
Прошу, если не затруднит, подправь то о чем я говорил в твоем последнем коде и соедини этот код с лиспом где присутствуют последние фильтры от VVA. (он на #465 прикреплен отдельным файлом.)

P.S. Знаю что от просьб объяснить я постепенно перешел к просьбам просто сделать за меня. Ну очень уж хочется окончательный лисп заполучить. А на нем учиться оказалось чересчур сложно. Колонну я еще лиспом чертил, а на списки не тяну.

[Кулик Алексей aka kpblc]

Red Nova, так и мне в общем-то тоже не особо вздохнуть... Я за сегодня с 8 утра еще ни строки кода не написал (а сдавать результат надо в пятницу).

[Red Nova]

kpblc Тебе и на том что сделал большое спасибо, без тебя этот код с места не сдвинулся бы.

[Red Nova]

ALL
Самому не получается скрестить новый код преобразования выносок в список (от крыса, пост #472) и последний вариант кода со старым алгоритмом преобразования выносок содержащим фильтры (последний вариант от VVA в прикрепленном файле на #465)
Приведу их по отдельности
новый код преобразования выносок в список

Код:

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

(defun _dwgru-get-spds-text-and-range (/ selset lst)
                                      ;|
*    Возвращает список строк выделенных выносок. В набор попадают узловые выноски,
* позиционные выноски, цепные и гребенчатые.
*    Параметры вызова:
	нет
*    Примеры вызова:
(_dwgru-get-spds-text)
	;
|;
  (if
    (and
      (= (type (setq selset (vl-catch-all-apply
                              (function (lambda () (ssget)))
                              ) ;_ end of vl-catch-all-apply
                     ) ;_ end of setq
               ) ;_ end of type
         'pickset
         ) ;_ end of =
      (setq selset
             (vl-remove-if-not
               (function
                 (lambda (x)
                   (member (cdr (assoc 0 x))
                           '("spdsNotePosition"
                             ;"spdsNoteKnot" закомментировал тапорно, чтобы исключить из выбора узловые выноски
                             "spdsNoteComb"
                             "spdsNoteChain"
                             )
                           ) ;_ end of member
                   ) ;_ end of lambda
                 ) ;_ end of function
               (mapcar
                 (function (lambda (a)
                             (vl-remove-if-not
                               '(lambda (b) (member (car b) '(0 300 301 90)))
                               (entget a)
                               ) ;_ end of vl-remove-if-not
                             ) ;_ end of lambda
                           ) ;_ end of function
                 (_dwgru-conv-pickset-to-list selset)
                 ) ;_ end of mapcar
               ) ;_ end of vl-remove-if-not
            ) ;_ end of setq
      ) ;_ end of and
     (setq
       lst
        (mapcar
          (function
            (lambda (item)
              (cond
                ((= (cdr (assoc 0 item)) "spdsNoteKnot")
                 (append (mapcar
                           (function cdr)
                           (vl-remove-if-not
                             (function
                               (lambda (x)
                                 (= (car x) 300)
                                 ) ;_ end of lambda
                               ) ;_ end of function
                             (reverse
                               (member '(301 . "Выравнивание текста")
                                       (reverse (member '(301 . "Номер узла") item))
                                       ) ;_ end of member
                               ) ;_ end of reverse
                             ) ;_ end of vl-remove-if-not
                           ) ;_ end of mapcar
                         (list 1)
                         ) ;_ end of append
                 )
                ((= (cdr (assoc 0 item)) "spdsNotePosition")
                 (append (mapcar
                           (function cdr)
                           (vl-remove-if-not
                             (function
                               (lambda (x)
                                 (= (car x) 300)
                                 ) ;_ end of lambda
                               ) ;_ end of function
                             (member '(301 . "Первая строка") item)
                             ) ;_ end of vl-remove-if-not
                           ) ;_ end of mapcar
                         (list 1)
                         ) ;_ end of append
                 )
                ((member (cdr (assoc 0 item))
                         '("spdsNoteComb" "spdsNoteChain")
                         ) ;_ end of member
                 (append
                   (mapcar
                     (function cdr)
                     (vl-remove-if-not
                       (function
                         (lambda (x)
                           (= (car x) 300)
                           ) ;_ end of lambda
                         ) ;_ end of function
                       (reverse
                         (member '(301 . "Выравнивание текста")
                                 (reverse (member '(301 . "Первая строка") item))
                                 ) ;_ end of member
                         ) ;_ end of reverse
                       ) ;_ end of vl-remove-if-not
                     ) ;_ end of mapcar
                   (list (cdr (assoc 90 (reverse item))))
                   ) ;_ end of cons
                 )
                ) ;_ end of cond
              ) ;_ end of lambda
            ) ;_ end of function
          selset
          ) ;_ end of mapcar
       ) ;_ end of setq
     ) ;_ end of if
  lst
  ) ;_ end of defun

последний вариант кода со старым алгоритмом преобразования выносок содержащим фильтры

Код:

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

(vl-load-com)
(defun parsing (tmp)
(and
(= (length tmp) 2); длина списка равна 2
(/= (car tmp) ""); Первый элемент не равен ""
(/= (cadr tmp) ""); то же со вторым
(check2 (car tmp)); проверка второго условия к первой строке
(check3 (cadr tmp) spisok); проверка первых символов второй строки
);блок условий который надо расширять до твоих требований
);end of parsing


(defun filtr (lst / newlst)
(foreach tmp lst
(if (parsing tmp)
  (setq newlst
         (append newlst
           (list
             (mapcar 'prep-str tmp)))
    )
  )
);end of foreach
(while-remove-lst newlst)
);end filtr

;;;Подготавливает строки
;;; Условия B1 и B2

;(PREP-STR  "21\\U+E712 12 AIII Швеллер 12, L=1000, шаг 1000")
(defun prep-str (str / tmp)
  ;;;Удаление всего после 2-й запятой условие B.1
  (setq tmp (reverse(str-str-lst str ",")))
  (while (> (length tmp) 2)
    (setq tmp(cdr tmp))
    )
  (setq str(substr (apply 'strcat (mapcar '(lambda(x)(strcat "," x))(reverse tmp))) 2))
  ;;;Удаление всего до знака диаметр
  (if (or (wcmatch str "# %%c*,#%%c*,#\\U+E712*,# \\U+E712*")
          (wcmatch str "## %%c*,##%%c*,##\\U+E712*,## \\U+E712*")
          )
    (while (wcmatch (substr str 1 1) "#, ")(setq str (substr str 2)))
    )
    str
  )
(defun check2 (tmp / i str); возращает T либо nil в зависимости от соответствия 2-му условию
(setq i 1 str tmp)
(if (or (= (substr str (strlen str)) "'") (= (substr str (strlen str)) "\"")); если последний ' или "
(setq str (substr str 1 (1- (strlen str))))); убирает последний символ
(repeat (strlen str)
(if (and (>= (substr str i 1) "0") (<= (substr str i 1) "9")); проверка цифра ли это?
(setq str (strcat (substr str 1 (1- i)) (substr str (1+ i)))); если да то убираем ее из str
(setq i (1+ i)); переход к следующими символу, если не было вычитания
);end of if
);end of repeat
; таким образом мы убрали из str все цифры и символы на конце 'и"
(<= (strlen str) 1); остался только 1 символ или меньше?
);end of check2

(defun check3 (var lst / flag) 
(foreach tmp lst
(if (= tmp (substr var 1 (strlen tmp))) (setq flag T))
)
flag 
);end of check3
  (defun _dwgru-conv-pickset-to-list (value / tab item)
    (repeat (setq tab  nil
                  item (sslength value)
                  ) ;_ end setq
      (setq tab (cons (ssname value (setq item (1- item))) tab))
      ) ;_ end repeat
    ) ;_ end defun

;;;Удаление дублирубших элементов
(defun while-remove-lst (lst / temp)
  (while lst
    (setq temp (cons (car lst) temp))
    (setq lst (vl-remove (car lst) (cdr lst)))
  ) ;_ end of while
  (reverse temp)
) ;_ end of defun
;|
* Ф-ция str-str-lst
* Сервисная ф-ция извлечения из строки данных, разделенных
* каким либо символом или строкой символов
* Возвращает список строк
* Аргументы [Type]:
  str - строка для разбора [STRING]
  pat - разделитель [STRING]
*  Пример запуска
  (setq str "мы;изучаем;рекурсии" pat ";")
  (setq str "мы — изучаем — рекурсии" pat " — ")
  (str-str-lst str pat)
* Читать подробнее http://www.autocad.ru/cgi-bin/f1/board.cgi?t=25113OT
|;
(defun str-str-lst (str pat / i)
  (cond ((= str "") nil)
        ((setq i (vl-string-search pat str))
         (cons (substr str 1 i)
               (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)
         ) ;_  cons
        )
        (t (list str))
  ) ;_  cond
) ;_  defun


(defun test (/ lst selset spisok)
  (if
    (and (setq selset (ssget))
         (setq
           selset (vl-remove-if-not
                    (function (lambda (x)
                                (= (cdr (assoc 0 (entget x))) "spdsNotePosition")
                                ) ;_ end of LAMBDA
                              ) ;_ end of function
                    (_dwgru-conv-pickset-to-list selset)
                    ) ;_ end of vl-remove-if-not
           ) ;_ end of setq
         ) ;_ end of and
     (setq
       lst
        (vl-sort
          (vl-remove-if
            (function
              (lambda (a)
                (= (cadr a) "")
                ) ;_ end of lambda
              ) ;_ end of function
            (mapcar (function
                      (lambda (obj)
                        (mapcar (function cdr)
                                (vl-remove-if-not
                                  (function
                                    (lambda (x)
                                      (= (car x) 300)
                                      ) ;_ end of lambda
                                    ) ;_ end of function
                                  (member '(301 . "Первая строка") (entget obj))
                                  ) ;_ end of vl-remove-if-not
                                ) ;_ end of mapcar
                        ) ;_ end of LAMBDA
                      ) ;_ end of function
                    selset
                    ) ;_ end of mapcar
            ) ;_ end of vl-remove-if
          (function (lambda (a b) (< (car a) (car b))))
          ) ;_ end of vl-sort
       ) ;_ end of setq
     ) ;_ end of if
  (setq spisok (list "-" "Фл." "Фл." "Фланец" "Лист" "Полоса" "\\U+E72E" "Тр" "\\U+E720" "Уголок" "\\U+E729" "Двутавр" "\\U+E725" "Швеллер" 
"%%c" "\\U+E712" "2%%c" "3%%c" "4%%c" "5%%c" "6%%c" "7%%c" "8%%c" "9%%c" "10%%c" "11%%c" "12%%c" "13%%c" "14%%c" "15%%c" "16%%c" "17%%c" "18%%c" "19%%c" "20%%c" 
 "2 %%c" "3 %%c" "4 %%c" "5 %%c" "6 %%c" "7 %%c" "8 %%c" "9 %%c" "10 %%c" "11 %%c" "12 %%c" "13 %%c" "14 %%c" "15 %%c" "16 %%c" "17 %%c" "18 %%c" "19 %%c" "20 %%c" 
"2\\U+E712" "3\\U+E712" "4\\U+E712" "5\\U+E712" "6\\U+E712" "7\\U+E712" "8\\U+E712" "9\\U+E712" "10\\U+E712" "11\\U+E712" "12\\U+E712" "13\\U+E712" "14\\U+E712" "15\\U+E712" "16\\U+E712" "17\\U+E712" "18\\U+E712" "19\\U+E712" "20\\U+E712"  
"2 \\U+E712" "3 \\U+E712" "4 \\U+E712" "5 \\U+E712" "6 \\U+E712" "7 \\U+E712" "8 \\U+E712" "9 \\U+E712" "10 \\U+E712" "11 \\U+E712" "12 \\U+E712" "13 \\U+E712" "14 \\U+E712" "15 \\U+E712" "16 \\U+E712" "17 \\U+E712" "18 \\U+E712" "19 \\U+E712" "20 \\U+E712"))

(setq lst (filtr lst)) ; можно и просто оставить в первом setq - но чтоб было понятней.
  
);end of test


(defun test2 ()
  (setq spisok (list "-" "Фл." "Фл." "Фланец" "Лист" "Полоса" "\\\U+E72E" "Тр" "\\U+E720" "Уголок" "\\\U+E729" "Двутавр" "\\\U+E725" "Швеллер" 
"%%c" "\\U+E712" "2%%c" "3%%c" "4%%c" "5%%c" "6%%c" "7%%c" "8%%c" "9%%c" "10%%c" "11%%c" "12%%c" "13%%c" "14%%c" "15%%c" "16%%c" "17%%c" "18%%c" "19%%c" "20%%c" 
 "2 %%c" "3 %%c" "4 %%c" "5 %%c" "6 %%c" "7 %%c" "8 %%c" "9 %%c" "10 %%c" "11 %%c" "12 %%c" "13 %%c" "14 %%c" "15 %%c" "16 %%c" "17 %%c" "18 %%c" "19 %%c" "20 %%c" 
"2\\U+E712" "3\\U+E712" "4\\U+E712" "5\\U+E712" "6\\U+E712" "7\\U+E712" "8\\U+E712" "9\\U+E712" "10\\U+E712" "11\\U+E712" "12\\U+E712" "13\\U+E712" "14\\U+E712" "15\\U+E712" "16\\U+E712" "17\\U+E712" "18\\U+E712" "19\\U+E712" "20\\U+E712"  
"2 \\U+E712" "3 \\U+E712" "4 \\U+E712" "5 \\U+E712" "6 \\U+E712" "7 \\U+E712" "8 \\U+E712" "9 \\U+E712" "10 \\U+E712" "11 \\U+E712" "12 \\U+E712" "13 \\U+E712" "14 \\U+E712" "15 \\U+E712" "16 \\U+E712" "17 \\U+E712" "18 \\U+E712" "19 \\U+E712" "20 \\U+E712"))
  
(setq lst '(("1" "-10х100x200") ("1" "-10х100x200") ("2" "Швеллер 12, L=1000, шаг 1000") ("2" "Швеллер 12, L=1000")
            ("2" "Швеллер 12") ("3" "8 %%c12 Ас1, ?L=10000") ("3" "?12 Ас1") ("4" "?20 Ас1")
            ("5" "8 ?20 А500c, L=1000") ("5" "8 ?20 А500c")))
(setq lst (filtr lst)) ; можно и просто оставить в первом setq - но чтоб было понятней.
)

Пытался просто переставить местами коды выбора вот так

Код:

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

(vl-load-com)
(defun parsing (tmp)
(and
(= (length tmp) 2); длина списка равна 2
(/= (car tmp) ""); Первый элемент не равен ""
(/= (cadr tmp) ""); то же со вторым
(check2 (car tmp)); проверка второго условия к первой строке
(check3 (cadr tmp) spisok); проверка первых символов второй строки
);блок условий который надо расширять до твоих требований
);end of parsing


(defun filtr (lst / newlst)
(foreach tmp lst
(if (parsing tmp)
  (setq newlst
         (append newlst
           (list
             (mapcar 'prep-str tmp)))
    )
  )
);end of foreach
(while-remove-lst newlst)
);end filtr

;;;Подготавливает строки
;;; Условия B1 и B2

;(PREP-STR  "21\\U+E712 12 AIII Швеллер 12, L=1000, шаг 1000")
(defun prep-str (str / tmp)
  ;;;Удаление всего после 2-й запятой условие B.1
  (setq tmp (reverse(str-str-lst str ",")))
  (while (> (length tmp) 2)
    (setq tmp(cdr tmp))
    )
  (setq str(substr (apply 'strcat (mapcar '(lambda(x)(strcat "," x))(reverse tmp))) 2))
  ;;;Удаление всего до знака диаметр
  (if (or (wcmatch str "# %%c*,#%%c*,#\\U+E712*,# \\U+E712*")
          (wcmatch str "## %%c*,##%%c*,##\\U+E712*,## \\U+E712*")
          )
    (while (wcmatch (substr str 1 1) "#, ")(setq str (substr str 2)))
    )
    str
  )
(defun check2 (tmp / i str); возращает T либо nil в зависимости от соответствия 2-му условию
(setq i 1 str tmp)
(if (or (= (substr str (strlen str)) "'") (= (substr str (strlen str)) "\"")); если последний ' или "
(setq str (substr str 1 (1- (strlen str))))); убирает последний символ
(repeat (strlen str)
(if (and (>= (substr str i 1) "0") (<= (substr str i 1) "9")); проверка цифра ли это?
(setq str (strcat (substr str 1 (1- i)) (substr str (1+ i)))); если да то убираем ее из str
(setq i (1+ i)); переход к следующими символу, если не было вычитания
);end of if
);end of repeat
; таким образом мы убрали из str все цифры и символы на конце 'и"
(<= (strlen str) 1); остался только 1 символ или меньше?
);end of check2

(defun check3 (var lst / flag) 
(foreach tmp lst
(if (= tmp (substr var 1 (strlen tmp))) (setq flag T))
)
flag 
);end of check3
  (defun _dwgru-conv-pickset-to-list (value / tab item)
    (repeat (setq tab  nil
                  item (sslength value)
                  ) ;_ end setq
      (setq tab (cons (ssname value (setq item (1- item))) tab))
      ) ;_ end repeat
    ) ;_ end defun

;;;Удаление дублирубших элементов
(defun while-remove-lst (lst / temp)
  (while lst
    (setq temp (cons (car lst) temp))
    (setq lst (vl-remove (car lst) (cdr lst)))
  ) ;_ end of while
  (reverse temp)
) ;_ end of defun
;|
* Ф-ция str-str-lst
* Сервисная ф-ция извлечения из строки данных, разделенных
* каким либо символом или строкой символов
* Возвращает список строк
* Аргументы [Type]:
  str - строка для разбора [STRING]
  pat - разделитель [STRING]
*  Пример запуска
  (setq str "мы;изучаем;рекурсии" pat ";")
  (setq str "мы — изучаем — рекурсии" pat " — ")
  (str-str-lst str pat)
* Читать подробнее http://www.autocad.ru/cgi-bin/f1/board.cgi?t=25113OT
|;
(defun str-str-lst (str pat / i)
  (cond ((= str "") nil)
        ((setq i (vl-string-search pat str))
         (cons (substr str 1 i)
               (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)
         ) ;_  cons
        )
        (t (list str))
  ) ;_  cond
) ;_  defun




(defun _dwgru-get-spds-text-and-range (/ selset lst)
                                      ;|
*    Возвращает список строк выделенных выносок. В набор попадают узловые выноски,
* позиционные выноски, цепные и гребенчатые.
*    Параметры вызова:
	нет
*    Примеры вызова:
(_dwgru-get-spds-text)
	;
|;
  (if
    (and
      (= (type (setq selset (vl-catch-all-apply
                              (function (lambda () (ssget)))
                              ) ;_ end of vl-catch-all-apply
                     ) ;_ end of setq
               ) ;_ end of type
         'pickset
         ) ;_ end of =
      (setq selset
             (vl-remove-if-not
               (function
                 (lambda (x)
                   (member (cdr (assoc 0 x))
                           '("spdsNotePosition"
                             "spdsNoteKnot"
                             "spdsNoteComb"
                             "spdsNoteChain"
                             )
                           ) ;_ end of member
                   ) ;_ end of lambda
                 ) ;_ end of function
               (mapcar
                 (function (lambda (a)
                             (vl-remove-if-not
                               '(lambda (b) (member (car b) '(0 300 301 90)))
                               (entget a)
                               ) ;_ end of vl-remove-if-not
                             ) ;_ end of lambda
                           ) ;_ end of function
                 (_dwgru-conv-pickset-to-list selset)
                 ) ;_ end of mapcar
               ) ;_ end of vl-remove-if-not
            ) ;_ end of setq
      ) ;_ end of and
     (setq
       lst
        (mapcar
          (function
            (lambda (item)
              (cond
                ((= (cdr (assoc 0 item)) "spdsNoteKnot")
                 (append (mapcar
                           (function cdr)
                           (vl-remove-if-not
                             (function
                               (lambda (x)
                                 (= (car x) 300)
                                 ) ;_ end of lambda
                               ) ;_ end of function
                             (reverse
                               (member '(301 . "Выравнивание текста")
                                       (reverse (member '(301 . "Номер узла") item))
                                       ) ;_ end of member
                               ) ;_ end of reverse
                             ) ;_ end of vl-remove-if-not
                           ) ;_ end of mapcar
                         (list 1)
                         ) ;_ end of append
                 )
                ((= (cdr (assoc 0 item)) "spdsNotePosition")
                 (append (mapcar
                           (function cdr)
                           (vl-remove-if-not
                             (function
                               (lambda (x)
                                 (= (car x) 300)
                                 ) ;_ end of lambda
                               ) ;_ end of function
                             (member '(301 . "Первая строка") item)
                             ) ;_ end of vl-remove-if-not
                           ) ;_ end of mapcar
                         (list 1)
                         ) ;_ end of append
                 )
                ((member (cdr (assoc 0 item))
                         '("spdsNoteComb" "spdsNoteChain")
                         ) ;_ end of member
                 (append
                   (mapcar
                     (function cdr)
                     (vl-remove-if-not
                       (function
                         (lambda (x)
                           (= (car x) 300)
                           ) ;_ end of lambda
                         ) ;_ end of function
                       (reverse
                         (member '(301 . "Выравнивание текста")
                                 (reverse (member '(301 . "Первая строка") item))
                                 ) ;_ end of member
                         ) ;_ end of reverse
                       ) ;_ end of vl-remove-if-not
                     ) ;_ end of mapcar
                   (list (cdr (assoc 90 (reverse item))))
                   ) ;_ end of cons
                 )
                ) ;_ end of cond
              ) ;_ end of lambda
            ) ;_ end of function
          selset
          ) ;_ end of mapcar
       ) ;_ end of setq
     ) ;_ end of if
  (setq spisok (list "-" "Фл." "Фл." "Фланец" "Лист" "Полоса" "\\U+E72E" "Тр" "\\U+E720" "Уголок" "\\U+E729" "Двутавр" "\\U+E725" "Швеллер" 
"%%c" "\\U+E712" "2%%c" "3%%c" "4%%c" "5%%c" "6%%c" "7%%c" "8%%c" "9%%c" "10%%c" "11%%c" "12%%c" "13%%c" "14%%c" "15%%c" "16%%c" "17%%c" "18%%c" "19%%c" "20%%c" 
 "2 %%c" "3 %%c" "4 %%c" "5 %%c" "6 %%c" "7 %%c" "8 %%c" "9 %%c" "10 %%c" "11 %%c" "12 %%c" "13 %%c" "14 %%c" "15 %%c" "16 %%c" "17 %%c" "18 %%c" "19 %%c" "20 %%c" 
"2\\U+E712" "3\\U+E712" "4\\U+E712" "5\\U+E712" "6\\U+E712" "7\\U+E712" "8\\U+E712" "9\\U+E712" "10\\U+E712" "11\\U+E712" "12\\U+E712" "13\\U+E712" "14\\U+E712" "15\\U+E712" "16\\U+E712" "17\\U+E712" "18\\U+E712" "19\\U+E712" "20\\U+E712"  
"2 \\U+E712" "3 \\U+E712" "4 \\U+E712" "5 \\U+E712" "6 \\U+E712" "7 \\U+E712" "8 \\U+E712" "9 \\U+E712" "10 \\U+E712" "11 \\U+E712" "12 \\U+E712" "13 \\U+E712" "14 \\U+E712" "15 \\U+E712" "16 \\U+E712" "17 \\U+E712" "18 \\U+E712" "19 \\U+E712" "20 \\U+E712"))

(setq lst (filtr lst)) ; можно и просто оставить в первом setq - но чтоб было понятней.
  ) ;_ end of defun

Но не работает. Пишет

Код:

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

Command: (_dwgru-get-spds-text-and-range)

Select objects: Specify opposite corner: 19 found

Select objects:
nil

Прошу помочь скрестить правильно эти коды.

[Red Nova]

Вай, забыл. Это же из за того, что новый аглоритм крыса выдает список вот в каком виде.

Код:

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

(("Узел" "" "1" 1) ("Цепная" "Выноска" 2) ("Греб" "Выноска" 2) ("Поз" "Выноска" 1))

Надо сперва удрать последние цифры списка

[VVA]

Сообщение от Red Nova Надо сперва удрать последние цифры списка

Код:

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

(setq lst  (_dwgru-get-spds-text-and-range)) ;_Получаем список СПДС выносок
;;;Так как у меня нет СПДС, забъем список ручками
(setq lst '(("Узел" "" "1" 1) ("Цепная" "Выноска" 2) ("Греб" "Выноска" 2) ("Поз" "Выноска" 1)))
;;;Удаляем все кроме первых двух
(setq lst (mapcar '(lambda(x)(list (car x)(cadr x))) lst)) ;;;-> (("Узел" "") ("Цепная" "Выноска") ("Греб" "Выноска") ("Поз" "Выноска"))

[Кулик Алексей aka kpblc]

VVA, в выноске может быть и 3 строковых элемента )

[Red Nova]

kpblc, Ты должно быть про узловую выноску говоришь. Так я закомментировал ее на #485

Код:

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

                           '("spdsNotePosition"
                             ;"spdsNoteKnot" закомментировал тапорно, чтобы исключить из выбора узловые выноски
                             "spdsNoteComb"
                             "spdsNoteChain"
                             )

Она в общем то было не нужна.
Теперь может быть точно только 2 строковых элемента

[Кулик Алексей aka kpblc]

Сообщение от Red Nova <...>Теперь может быть точно только 2 строковых элемента

Я бы все же разрабатывал более универсальный код )

[Red Nova]

В узловых выносках я ни разу не ставил позиции, да и не видел чтобы другие ставили. Не думаю что это кому-то пригодится.
Но зато в узловых выносках я часто отмечаю номер узла и адрес страницы.
("1" "Лист-5")
Получается так, что установленные мною фильтры пропустят этот список . Так что лучше от узловых выносок держаться по дальше

[Кулик Алексей aka kpblc]

Кхе, это зависит от специфики работы. У меня, например, как раз узловые являются основными

[Red Nova]

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

[Red Nova]

А пока, учитывая последнюю заметку от VVA, код получился такой. (Работает)

Код:

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

(vl-load-com)
(defun parsing (tmp)
(and
(= (length tmp) 2); длина списка равна 2
(/= (car tmp) ""); Первый элемент не равен ""
(/= (cadr tmp) ""); то же со вторым
(check2 (car tmp)); проверка второго условия к первой строке
(check3 (cadr tmp) spisok); проверка первых символов второй строки
);блок условий который надо расширять до твоих требований
);end of parsing


(defun filtr (lst / newlst)
(foreach tmp lst
(if (parsing tmp)
  (setq newlst
         (append newlst
           (list
             (mapcar 'prep-str tmp)))
    )
  )
);end of foreach
(while-remove-lst newlst)
);end filtr

;;;Подготавливает строки
;;; Условия B1 и B2

;(PREP-STR  "21\\U+E712 12 AIII Швеллер 12, L=1000, шаг 1000")
(defun prep-str (str / tmp)
  ;;;Удаление всего после 2-й запятой условие B.1
  (setq tmp (reverse(str-str-lst str ",")))
  (while (> (length tmp) 2)
    (setq tmp(cdr tmp))
    )
  (setq str(substr (apply 'strcat (mapcar '(lambda(x)(strcat "," x))(reverse tmp))) 2))
  ;;;Удаление всего до знака диаметр
  (if (or (wcmatch str "# %%c*,#%%c*,#\\U+E712*,# \\U+E712*")
          (wcmatch str "## %%c*,##%%c*,##\\U+E712*,## \\U+E712*")
          )
    (while (wcmatch (substr str 1 1) "#, ")(setq str (substr str 2)))
    )
    str
  )
(defun check2 (tmp / i str); возращает T либо nil в зависимости от соответствия 2-му условию
(setq i 1 str tmp)
(if (or (= (substr str (strlen str)) "'") (= (substr str (strlen str)) "\"")); если последний ' или "
(setq str (substr str 1 (1- (strlen str))))); убирает последний символ
(repeat (strlen str)
(if (and (>= (substr str i 1) "0") (<= (substr str i 1) "9")); проверка цифра ли это?
(setq str (strcat (substr str 1 (1- i)) (substr str (1+ i)))); если да то убираем ее из str
(setq i (1+ i)); переход к следующими символу, если не было вычитания
);end of if
);end of repeat
; таким образом мы убрали из str все цифры и символы на конце 'и"
(<= (strlen str) 1); остался только 1 символ или меньше?
);end of check2

(defun check3 (var lst / flag) 
(foreach tmp lst
(if (= tmp (substr var 1 (strlen tmp))) (setq flag T))
)
flag 
);end of check3
  (defun _dwgru-conv-pickset-to-list (value / tab item)
    (repeat (setq tab  nil
                  item (sslength value)
                  ) ;_ end setq
      (setq tab (cons (ssname value (setq item (1- item))) tab))
      ) ;_ end repeat
    ) ;_ end defun

;;;Удаление дублирубших элементов
(defun while-remove-lst (lst / temp)
  (while lst
    (setq temp (cons (car lst) temp))
    (setq lst (vl-remove (car lst) (cdr lst)))
  ) ;_ end of while
  (reverse temp)
) ;_ end of defun
;|
* Ф-ция str-str-lst
* Сервисная ф-ция извлечения из строки данных, разделенных
* каким либо символом или строкой символов
* Возвращает список строк
* Аргументы [Type]:
  str - строка для разбора [STRING]
  pat - разделитель [STRING]
*  Пример запуска
  (setq str "мы;изучаем;рекурсии" pat ";")
  (setq str "мы — изучаем — рекурсии" pat " — ")
  (str-str-lst str pat)
* Читать подробнее http://www.autocad.ru/cgi-bin/f1/board.cgi?t=25113OT
|;
(defun str-str-lst (str pat / i)
  (cond ((= str "") nil)
        ((setq i (vl-string-search pat str))
         (cons (substr str 1 i)
               (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)
         ) ;_  cons
        )
        (t (list str))
  ) ;_  cond
) ;_  defun




(defun test (/ selset lst)
                                      ;|
*    Возвращает список строк выделенных выносок. В набор попадают узловые выноски,
* позиционные выноски, цепные и гребенчатые.
*    Параметры вызова:
	нет
*    Примеры вызова:
(_dwgru-get-spds-text)
	;
|;
  (if
    (and
      (= (type (setq selset (vl-catch-all-apply
                              (function (lambda () (ssget)))
                              ) ;_ end of vl-catch-all-apply
                     ) ;_ end of setq
               ) ;_ end of type
         'pickset
         ) ;_ end of =
      (setq selset
             (vl-remove-if-not
               (function
                 (lambda (x)
                   (member (cdr (assoc 0 x))
                           '("spdsNotePosition"
                             ;"spdsNoteKnot" 
                             "spdsNoteComb"
                             "spdsNoteChain"
                             )
                           ) ;_ end of member
                   ) ;_ end of lambda
                 ) ;_ end of function
               (mapcar
                 (function (lambda (a)
                             (vl-remove-if-not
                               '(lambda (b) (member (car b) '(0 300 301 90)))
                               (entget a)
                               ) ;_ end of vl-remove-if-not
                             ) ;_ end of lambda
                           ) ;_ end of function
                 (_dwgru-conv-pickset-to-list selset)
                 ) ;_ end of mapcar
               ) ;_ end of vl-remove-if-not
            ) ;_ end of setq
      ) ;_ end of and
     (setq
       lst
        (mapcar
          (function
            (lambda (item)
              (cond
                ((= (cdr (assoc 0 item)) "spdsNoteKnot")
                 (append (mapcar
                           (function cdr)
                           (vl-remove-if-not
                             (function
                               (lambda (x)
                                 (= (car x) 300)
                                 ) ;_ end of lambda
                               ) ;_ end of function
                             (reverse
                               (member '(301 . "Выравнивание текста")
                                       (reverse (member '(301 . "Номер узла") item))
                                       ) ;_ end of member
                               ) ;_ end of reverse
                             ) ;_ end of vl-remove-if-not
                           ) ;_ end of mapcar
                         (list 1)
                         ) ;_ end of append
                 )
                ((= (cdr (assoc 0 item)) "spdsNotePosition")
                 (append (mapcar
                           (function cdr)
                           (vl-remove-if-not
                             (function
                               (lambda (x)
                                 (= (car x) 300)
                                 ) ;_ end of lambda
                               ) ;_ end of function
                             (member '(301 . "Первая строка") item)
                             ) ;_ end of vl-remove-if-not
                           ) ;_ end of mapcar
                         (list 1)
                         ) ;_ end of append
                 )
                ((member (cdr (assoc 0 item))
                         '("spdsNoteComb" "spdsNoteChain")
                         ) ;_ end of member
                 (append
                   (mapcar
                     (function cdr)
                     (vl-remove-if-not
                       (function
                         (lambda (x)
                           (= (car x) 300)
                           ) ;_ end of lambda
                         ) ;_ end of function
                       (reverse
                         (member '(301 . "Выравнивание текста")
                                 (reverse (member '(301 . "Первая строка") item))
                                 ) ;_ end of member
                         ) ;_ end of reverse
                       ) ;_ end of vl-remove-if-not
                     ) ;_ end of mapcar
                   (list (cdr (assoc 90 (reverse item))))
                   ) ;_ end of cons
                 )
                ) ;_ end of cond
              ) ;_ end of lambda
            ) ;_ end of function
          selset
          ) ;_ end of mapcar
       ) ;_ end of setq
     ) ;_ end of if

  (setq spisok (list "-" "Фл." "Фл." "Фланец" "Лист" "Полоса" "\\U+E72E" "Тр" "\\U+E720" "Уголок" "\\U+E729" "Двутавр" "\\U+E725" "Швеллер" 
"%%c" "\\U+E712" "2%%c" "3%%c" "4%%c" "5%%c" "6%%c" "7%%c" "8%%c" "9%%c" "10%%c" "11%%c" "12%%c" "13%%c" "14%%c" "15%%c" "16%%c" "17%%c" "18%%c" "19%%c" "20%%c" 
 "2 %%c" "3 %%c" "4 %%c" "5 %%c" "6 %%c" "7 %%c" "8 %%c" "9 %%c" "10 %%c" "11 %%c" "12 %%c" "13 %%c" "14 %%c" "15 %%c" "16 %%c" "17 %%c" "18 %%c" "19 %%c" "20 %%c" 
"2\\U+E712" "3\\U+E712" "4\\U+E712" "5\\U+E712" "6\\U+E712" "7\\U+E712" "8\\U+E712" "9\\U+E712" "10\\U+E712" "11\\U+E712" "12\\U+E712" "13\\U+E712" "14\\U+E712" "15\\U+E712" "16\\U+E712" "17\\U+E712" "18\\U+E712" "19\\U+E712" "20\\U+E712"  
"2 \\U+E712" "3 \\U+E712" "4 \\U+E712" "5 \\U+E712" "6 \\U+E712" "7 \\U+E712" "8 \\U+E712" "9 \\U+E712" "10 \\U+E712" "11 \\U+E712" "12 \\U+E712" "13 \\U+E712" "14 \\U+E712" "15 \\U+E712" "16 \\U+E712" "17 \\U+E712" "18 \\U+E712" "19 \\U+E712" "20 \\U+E712"))

(setq lst (mapcar '(lambda(x)
                     (vl-remove-if-not '(lambda(y)(= (type y) 'STR)) x)
                    )
                  lst
           );_ end of mapcar
  );_ end of setq

(setq lst (filtr lst))

  ) ;_ end of defun

[VVA]

Вот вариант с удалением ВСЕХ НЕ СТРОК

Код:

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

(setq lst  (_dwgru-get-spds-text-and-range)) ;_Получаем список СПДС выносок
;;;Так как у меня нет СПДС, забъем список ручками
(setq lst '(("Узел" "" "1" "1") ("Цепная" "Выноска" 2) ("Греб" "Выноска" 2) ("Поз" "Выноска" 1)))
;;;Удаляем все НЕ СТРОКИ
(setq lst (mapcar '(lambda(x)
                     (vl-remove-if-not '(lambda(y)(= (type y) 'STR)) x)
                    )
                  lst
                  )
      ) ;;;->(("Узел" "" "1" "1") ("Цепная" "Выноска") ("Греб" "Выноска") ("Поз" "Выноска"))

[Кулик Алексей aka kpblc]

VVA, VVA, а я так хотел, чтобы Red Nova сам нарисовал вариант...

[Red Nova]

All
Обновил код на #494 (c учетом #495).
На данный момент имеем код, который значительно фильтрует не нужную информацию. Почти все фильтры уже готовы. Осталось вот что.

1. Отфильтровать подобные позиции
Допустим имеем такой список.

Код:

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

(("2" "Швеллер 12, L=1000") ("2" " 12, L=1000") ("2" "Швеллер 12") ("2" " 12"))

Все подсписки имеют ту же позицию, а это значит, что необходимо оставить только один из этих элементов. Для этого нужно.
А. Проверить есть ли в одном из списков запятая. Если есть, то надо удалить все, которые запятой не содержат, если ни один элемент не содержит запятых, то ничего не удаляем. На данном этапе получим

Код:

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

(("2" "Швеллер 12, L=1000") ("2" " 12, L=1000"))

Б. Проверяем который из списков самый длинный, и оставляем его, а все оставшиеся удаляем. Если длина равна, то удаляем на угад.
Получим

Код:

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

(("2" "Швеллер 12, L=1000"))

Это собственно последние фильтры. После этого каждой позиции должен соответствовать один подсписок.

2. Теперь список надо расставить по порядку. Вот на мой взгляд нужная очередность:
1, 1’, 1”, 1a, 1b, 1c, …1d, 1e, 1f, 1g, 1а, …1б, 1в, 1г, 1д, 1е, …2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, … A1, A2, A3, a1, a2, a3, a5, B1, B2, B3, b1, b2, b3, b4, b5, C1, C2, C3, c1, c2, c3, c4, c5, … A1, A2, A3, а1, а2, а3, а5, Б1, Б2, Б2, б1, б2, б3, б4, б5, в1, в2, в3, в4, в5

Как всегда прошу помочь кому не лень.

[Red Nova]

kpblc, Мне действительно лучше учиться на более простом. Я так часами могу о стенку головой биться. Вот другое дело было упражнение от VVA про колонну.
А этот лисп засел в мозгах и не выходит. Все хочиться его поскорее пощюпать в работе. Если на нем учиться, то в лучшем случае я его закончу через год-два

Добавлено
К стати, все что связанно с lambda(x) я не понемаю. Читал справку, смотрел примеры, а толку мало

Крыс Еще добавлю.О узловых выносках.
Я не знаю какую у вас в ней пишут информацию (в какой строке что пишут). Подходят ли этой информации наши фильтры?

[Кулик Алексей aka kpblc]

У тебя число обязательно присутствует в элементах списка?
P.S. Может, lambda по ходу дела рассказать?
P.P.S. Что-то я, похоже, погорячился с числами... Вариант "число сначала" делается без вопросов, а вот "сначала символ, потом число" - что-то не срослось.

[Red Nova]

У тебя число обязательно присутствует в элементах списка?

Не понял о каком ты говоришь числе

P.S. Может, lambda по ходу дела рассказать?

Если есть охота рассказать, то прошу объяснить подробно, на примерах, и типа перед тобой первокласник.

[Дима_]

Что бы было понятней, что такое lambda вначале опишу что такое apply и mapcar:
apply Fn lst - применяет функцию Fn к списку lst, например:
(apply '+ '(1 2 3)) эквивалентно (+ 1 2 3) что вернет 6.
(mapcar Fn lst1 lst2 ... lstn) - применят функцию Fn к каждому элементу из каждого списка, ответ возращает в виде списка ответов, количество списков (lst1, lst2...) должно соответствовать количеству аргументов функции Fn, например:
(mapcar '+ (list 1 2 3) (list 10 20 30)) эквивалентно (list (+ 1 10) (+ 2 20) (+ 3 30)), что вернет (11 22 33).

Если мы, в качестве функции Fn хотим использовать какую-либо свою функцию, то мы должны либо предварительно создать ее используя (defun), но тогда нам придеться придумывать ей имя, либо использовать (lambda), синтаксис точно такой-же как у (defun) только без имени - а с defun'ом мы вроде уже разбирались. Пример:
(mapcar '(lambda (a b c) (- (+ a b) c)) (list 1 2 3) (list 10 20 30) (list 4 5 6))
эквивалентно (list (- (+ 1 10) 4) (- (+ 2 20) 5) (- (+ 3 30) 6)),
что вернет (7 17 27)

[Кулик Алексей aka kpblc]

"Первоклассник" уже понимает mapcar?
---
Опа, пока я чесал репу, тут уже практически все рассказали

[CB]

>Дима_

apply Fn lst - применяет функцию Fn к списку lst, например:

Небольшое, но на мой взгляд существенное уточнение:
(apply Fn lst) - выполняется функция Fn, аргументы которой заданы списком. Например классика:
(apply 'mapcar (cons 'list '((1 2) (10 20)))) -> ((1 10) (2 20))
Что здесь lst - (cons 'list '((1 2) (10 20))) -> (LIST (1 2) (10 20))
В этом списке первый элемент, зто аргумент функция для (mapcar функция lst1 lst2...), следующие - это аргументы lst1, lst2 для нее же.

[Red Nova]

Спасибо, вроде как понял.
Значит это
(setq lst (mapcar '(lambda(x)(list (car x)(cadr x))) lst))
можно понять, как:
к каждому элементу списка lst применить функцию создающую список из первых двух элементов первоначального списка.

[Кулик Алексей aka kpblc]

К каждому элементу списка lst применить фунцию, которая создает список из первых двух элементов каждого подсписка.
Наверное, так будет правильнее.

[Red Nova]

Не у кого идей по #497 нет?

[Кулик Алексей aka kpblc]

Пока нет. Лично у меня не получилось абсолютно корректно сформировать список вида '("1" "1'" "1''" "2" "2a" "2A" "3" "4b" "10a" "A1" "A3" "A10" "A21"). Проблема (пока) именно в последних 4 элементах.

[Кулик Алексей aka kpblc]

Хотя нет, лови:

Код:

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

(setq lst-sort '("10a" "1" "A21" "2B" "1'" "A3" "1''" "2" "2a" "2A" "3" "4b"
                 "A1" "A10")
      ) ;_ end of setq

(defun fun_sort-list-string (lst / lst_int lst_sym)
  (setq lst_int (vl-sort
                  (vl-remove-if
                    (function
                      (lambda (x)
                        (= (atoi x) 0)
                        ) ;_ end of lambda
                      ) ;_ end of function
                    lst
                    ) ;_ end of vl-remove-if
                  (function (lambda (a b) (< (atoi a) (atoi b))))
                  ) ;_ end of vl-sort
        lst_sym (vl-sort
                  (vl-remove-if-not
                    (function
                      (lambda (x)
                        (= (atoi x) 0)
                        ) ;_ end of lambda
                      ) ;_ end of function
                    lst
                    ) ;_ end of vl-remove-if-not
                  (function
                    (lambda (a b / tmp_a tmp_b)
                      (apply
                        (function <)
                        (mapcar
                          (function
                            (lambda (c)
                              (atoi (vl-list->string
                                      (vl-remove-if-not
                                        (function
                                          (lambda (x)
                                            (<= 48 x 57)
                                            ) ;_ end of lambda
                                          ) ;_ end of function
                                        (vl-string->list c)
                                        ) ;_ end of vl-remove-if-not
                                      ) ;_ end of vl-list->string
                                    ) ;_ end of atoi
                              ) ;_ end of lambda
                            ) ;_ end of function
                          (list a b)
                          ) ;_ end of mapcar
                        ) ;_ end of apply
                      ) ;_ end of lambda
                    ) ;_ end of function
                  ) ;_ end of vl-sort
        ) ;_ end of setq
  (append lst_int lst_sym)
  ) ;_ end of defun

;;; (fun_sort-list-string lst-sort)
;;; '("1" "1'" "1''" "2B" "2" "2a" "2A" "3" "4b" "10a" "A1" "A3" "A10" "A21")

[Red Nova]

kpblc, Спасибо. Эту функцию можно применить, когда имеем обычный список. А как ее использовать в нашем случае, когда список парный?

[Кулик Алексей aka kpblc]

В качестве параметров в анонимные функции попадают тогда не строки, а списки. Обработка не меняется, просто подставляются первые элементы списка.
P.S. Тут задумался - может, кто более быстрый алгоритм предложит да в библиотеку такую функцию сортировки строкового списка закинет?

[Red Nova]

Если я верно понял, то можно добавить этот код в таком виде в наш лисп. Я попробовал, но пока не работает.

Код:

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

(vl-load-com)
(defun parsing (tmp)
(and
(= (length tmp) 2); длина списка равна 2
(/= (car tmp) ""); Первый элемент не равен ""
(/= (cadr tmp) ""); то же со вторым
(check2 (car tmp)); проверка второго условия к первой строке
(check3 (cadr tmp) spisok); проверка первых символов второй строки
);блок условий который надо расширять до твоих требований
);end of parsing


(defun filtr (lst / newlst)
(foreach tmp lst
(if (parsing tmp)
  (setq newlst
         (append newlst
           (list
             (mapcar 'prep-str tmp)))
    )
  )
);end of foreach
(while-remove-lst newlst)
);end filtr

;;;Подготавливает строки
;;; Условия B1 и B2

;(PREP-STR  "21\\U+E712 12 AIII Швеллер 12, L=1000, шаг 1000")
(defun prep-str (str / tmp)
  ;;;Удаление всего после 2-й запятой условие B.1
  (setq tmp (reverse(str-str-lst str ",")))
  (while (> (length tmp) 2)
    (setq tmp(cdr tmp))
    )
  (setq str(substr (apply 'strcat (mapcar '(lambda(x)(strcat "," x))(reverse tmp))) 2))
  ;;;Удаление всего до знака диаметр
  (if (or (wcmatch str "# %%c*,#%%c*,#\\U+E712*,# \\U+E712*")
          (wcmatch str "## %%c*,##%%c*,##\\U+E712*,## \\U+E712*")
          )
    (while (wcmatch (substr str 1 1) "#, ")(setq str (substr str 2)))
    )
    str
  )
(defun check2 (tmp / i str); возращает T либо nil в зависимости от соответствия 2-му условию
(setq i 1 str tmp)
(if (or (= (substr str (strlen str)) "'") (= (substr str (strlen str)) "\"")); если последний ' или "
(setq str (substr str 1 (1- (strlen str))))); убирает последний символ
(repeat (strlen str)
(if (and (>= (substr str i 1) "0") (<= (substr str i 1) "9")); проверка цифра ли это?
(setq str (strcat (substr str 1 (1- i)) (substr str (1+ i)))); если да то убираем ее из str
(setq i (1+ i)); переход к следующими символу, если не было вычитания
);end of if
);end of repeat
; таким образом мы убрали из str все цифры и символы на конце 'и"
(<= (strlen str) 1); остался только 1 символ или меньше?
);end of check2

(defun check3 (var lst / flag) 
(foreach tmp lst
(if (= tmp (substr var 1 (strlen tmp))) (setq flag T))
)
flag 
);end of check3
  (defun _dwgru-conv-pickset-to-list (value / tab item)
    (repeat (setq tab  nil
                  item (sslength value)
                  ) ;_ end setq
      (setq tab (cons (ssname value (setq item (1- item))) tab))
      ) ;_ end repeat
    ) ;_ end defun

;;;Удаление дублирубших элементов
(defun while-remove-lst (lst / temp)
  (while lst
    (setq temp (cons (car lst) temp))
    (setq lst (vl-remove (car lst) (cdr lst)))
  ) ;_ end of while
  (reverse temp)
) ;_ end of defun
;|
* Ф-ция str-str-lst
* Сервисная ф-ция извлечения из строки данных, разделенных
* каким либо символом или строкой символов
* Возвращает список строк
* Аргументы [Type]:
  str - строка для разбора [STRING]
  pat - разделитель [STRING]
*  Пример запуска
  (setq str "мы;изучаем;рекурсии" pat ";")
  (setq str "мы — изучаем — рекурсии" pat " — ")
  (str-str-lst str pat)
* Читать подробнее http://www.autocad.ru/cgi-bin/f1/board.cgi?t=25113OT
|;
(defun str-str-lst (str pat / i)
  (cond ((= str "") nil)
        ((setq i (vl-string-search pat str))
         (cons (substr str 1 i)
               (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)
         ) ;_  cons
        )
        (t (list str))
  ) ;_  cond
) ;_  defun



(defun fun_sort-list-string (lst / lst_int lst_sym) ; Cортировка по порядку  ("1" "1'" "1''" "2B" "2" "2a" "2A" "3" "4b" "10a" "A1" "A3" "A10" "A21")
  (setq lst_int (vl-sort
                  (vl-remove-if
                    (function
                      (lambda (x)
                        (= (atoi x) 0)
                        ) ;_ end of lambda
                      ) ;_ end of function
                    lst
                    ) ;_ end of vl-remove-if
                  (function (lambda (a b) (< (atoi a) (atoi b))))
                  ) ;_ end of vl-sort
        lst_sym (vl-sort
                  (vl-remove-if-not
                    (function
                      (lambda (x)
                        (= (atoi x) 0)
                        ) ;_ end of lambda
                      ) ;_ end of function
                    lst
                    ) ;_ end of vl-remove-if-not
                  (function
                    (lambda (a b / tmp_a tmp_b)
                      (apply
                        (function <)
                        (mapcar
                          (function
                            (lambda (c)
                              (atoi (vl-list->string
                                      (vl-remove-if-not
                                        (function
                                          (lambda (x)
                                            (<= 48 x 57)
                                            ) ;_ end of lambda
                                          ) ;_ end of function
                                        (vl-string->list c)
                                        ) ;_ end of vl-remove-if-not
                                      ) ;_ end of vl-list->string
                                    ) ;_ end of atoi
                              ) ;_ end of lambda
                            ) ;_ end of function
                          (list a b)
                          ) ;_ end of mapcar
                        ) ;_ end of apply
                      ) ;_ end of lambda
                    ) ;_ end of function
                  ) ;_ end of vl-sort
        ) ;_ end of setq
  (append lst_int lst_sym)
  ) ;_ end of defun


(defun test (/ selset lst)
                                      ;|
*    Возвращает список строк выделенных выносок. В набор попадают узловые выноски,
* позиционные выноски, цепные и гребенчатые.
*    Параметры вызова:
	нет
*    Примеры вызова:
(_dwgru-get-spds-text)
	;
|;
  (if
    (and
      (= (type (setq selset (vl-catch-all-apply
                              (function (lambda () (ssget)))
                              ) ;_ end of vl-catch-all-apply
                     ) ;_ end of setq
               ) ;_ end of type
         'pickset
         ) ;_ end of =
      (setq selset
             (vl-remove-if-not
               (function
                 (lambda (x)
                   (member (cdr (assoc 0 x))
                           '("spdsNotePosition"
                             ;"spdsNoteKnot" 
                             "spdsNoteComb"
                             "spdsNoteChain"
                             )
                           ) ;_ end of member
                   ) ;_ end of lambda
                 ) ;_ end of function
               (mapcar
                 (function (lambda (a)
                             (vl-remove-if-not
                               '(lambda (b) (member (car b) '(0 300 301 90)))
                               (entget a)
                               ) ;_ end of vl-remove-if-not
                             ) ;_ end of lambda
                           ) ;_ end of function
                 (_dwgru-conv-pickset-to-list selset)
                 ) ;_ end of mapcar
               ) ;_ end of vl-remove-if-not
            ) ;_ end of setq
      ) ;_ end of and
     (setq
       lst
        (mapcar
          (function
            (lambda (item)
              (cond
                ((= (cdr (assoc 0 item)) "spdsNoteKnot")
                 (append (mapcar
                           (function cdr)
                           (vl-remove-if-not
                             (function
                               (lambda (x)
                                 (= (car x) 300)
                                 ) ;_ end of lambda
                               ) ;_ end of function
                             (reverse
                               (member '(301 . "Выравнивание текста")
                                       (reverse (member '(301 . "Номер узла") item))
                                       ) ;_ end of member
                               ) ;_ end of reverse
                             ) ;_ end of vl-remove-if-not
                           ) ;_ end of mapcar
                         (list 1)
                         ) ;_ end of append
                 )
                ((= (cdr (assoc 0 item)) "spdsNotePosition")
                 (append (mapcar
                           (function cdr)
                           (vl-remove-if-not
                             (function
                               (lambda (x)
                                 (= (car x) 300)
                                 ) ;_ end of lambda
                               ) ;_ end of function
                             (member '(301 . "Первая строка") item)
                             ) ;_ end of vl-remove-if-not
                           ) ;_ end of mapcar
                         (list 1)
                         ) ;_ end of append
                 )
                ((member (cdr (assoc 0 item))
                         '("spdsNoteComb" "spdsNoteChain")
                         ) ;_ end of member
                 (append
                   (mapcar
                     (function cdr)
                     (vl-remove-if-not
                       (function
                         (lambda (x)
                           (= (car x) 300)
                           ) ;_ end of lambda
                         ) ;_ end of function
                       (reverse
                         (member '(301 . "Выравнивание текста")
                                 (reverse (member '(301 . "Первая строка") item))
                                 ) ;_ end of member
                         ) ;_ end of reverse
                       ) ;_ end of vl-remove-if-not
                     ) ;_ end of mapcar
                   (list (cdr (assoc 90 (reverse item))))
                   ) ;_ end of cons
                 )
                ) ;_ end of cond
              ) ;_ end of lambda
            ) ;_ end of function
          selset
          ) ;_ end of mapcar
       ) ;_ end of setq
     ) ;_ end of if

  (setq spisok (list "-" "Фл." "Фл." "Фланец" "Лист" "Полоса" "\\U+E72E" "Тр" "\\U+E720" "Уголок" "\\U+E729" "Двутавр" "\\U+E725" "Швеллер" 
"%%c" "\\U+E712" "2%%c" "3%%c" "4%%c" "5%%c" "6%%c" "7%%c" "8%%c" "9%%c" "10%%c" "11%%c" "12%%c" "13%%c" "14%%c" "15%%c" "16%%c" "17%%c" "18%%c" "19%%c" "20%%c" 
 "2 %%c" "3 %%c" "4 %%c" "5 %%c" "6 %%c" "7 %%c" "8 %%c" "9 %%c" "10 %%c" "11 %%c" "12 %%c" "13 %%c" "14 %%c" "15 %%c" "16 %%c" "17 %%c" "18 %%c" "19 %%c" "20 %%c" 
"2\\U+E712" "3\\U+E712" "4\\U+E712" "5\\U+E712" "6\\U+E712" "7\\U+E712" "8\\U+E712" "9\\U+E712" "10\\U+E712" "11\\U+E712" "12\\U+E712" "13\\U+E712" "14\\U+E712" "15\\U+E712" "16\\U+E712" "17\\U+E712" "18\\U+E712" "19\\U+E712" "20\\U+E712"  
"2 \\U+E712" "3 \\U+E712" "4 \\U+E712" "5 \\U+E712" "6 \\U+E712" "7 \\U+E712" "8 \\U+E712" "9 \\U+E712" "10 \\U+E712" "11 \\U+E712" "12 \\U+E712" "13 \\U+E712" "14 \\U+E712" "15 \\U+E712" "16 \\U+E712" "17 \\U+E712" "18 \\U+E712" "19 \\U+E712" "20 \\U+E712"))

(setq lst (mapcar '(lambda(x)
                     (vl-remove-if-not '(lambda(y)(= (type y) 'STR)) x)
                    )
                  lst
           );_ end of mapcar
  );_ end of setq

(setq lst (filtr lst))
(fun_sort-list-string lst)

  ) ;_ end of defun

[CB]

>Red Nova
По скорости, с которой ты выдаешь ТЗ на лисп, Benchmark наверняка бы поставил тебя на первое место. Не успеешь сделать одно, уже новое задание, сделаешь его - опять новое...
Во всяком случае протестируй пока новый лисп, в котором пока нет окончательной сортировки (над ней стоит еще подумать...)

Код:

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

(defun CB-test (/ CB-filtr lst)
  (defun CB-filtr (lst)
    (vl-remove-if
      '(lambda (x)
  (or
    (not (equal (length x) 2))
    (member "" x)
    (not
      (wcmatch
        (cadr x)
        "\\U+E72E*,Труба*,Тр.*,Лист*,Полоса*,\\U+E720*,Уголок*,\\U+E725*,Швеллер*,\\U+E729*,Двутавр*,Фланец*,Фл.*,-*,%%c*,\\U+E712*,#%%c*,# %%c*,##%%c*,## %%c*,#\\U+E712*,# \\U+E712*,##\\U+E712*,## \\U+E712*"
      ) ;_ end of wcmatch
    ) ;_ end of not
    (not
      (apply
        'and
        ((lambda (str-lst n a)
    (mapcar '(lambda (y)
        (if (<= (setq n (1- n)) a)
          (wcmatch y "[A-Za-zА-Яа-я0-9'\"]")
          (wcmatch y "#")
        ) ;_ end of if
      ) ;_ end of lambda
     str-lst
    ) ;_ end of mapcar
  ) ;_ end of lambda
   (mapcar 'chr (vl-string->list (car x)))
   (strlen (car x))
   (if
     (or (wcmatch (car x) "*'") (wcmatch (car x) "*\""))
      1
      0
   ) ;_ end of if
        )
      ) ;_ end of apply
    ) ;_ end of not
  ) ;_ end of or
       ) ;_ end of lambda
      ((lambda (lst / poz temp)
;;;Создает список позиций pat в str
;;;(reverse (poz "123,456,7 89,0" ",")) -> (3 7 12)
  (defun poz (str pat / p n)
    (while (setq n (vl-string-search pat str n))
      (setq p (cons n p)
     n (1+ n)
      ) ;_ end of setq
    ) ;_ end of while
    p
  ) ;_ end of defun
  (while lst
    (setq
      temp
       (cons
  ((lambda (lst-temp / n)
     (list
       (car lst-temp)
       (vl-string-left-trim
         "1234567890 "
         (if
    (equal
      (length (setq n (poz (cadr lst-temp) ",")))
      2
    ) ;_ end of equal
     (substr (cadr lst-temp)
      1
      (car n)
     ) ;_ end of substr
     (cadr lst-temp)
         ) ;_ end of if
       ) ;_ end of vl-string-left-trim
     ) ;_ end of list
   ) ;_ end of lambda
    (car
      (vl-sort
        (vl-remove-if-not
   '(lambda (x) (equal (caar lst) (car x)))
   lst
        ) ;_ end of vl-remove-if-not
        '(lambda (str1 str2)
    (> (length (poz (cadr str1) ","))
       (length (poz (cadr str2) ","))
    ) ;_ end of >
         ) ;_ end of lambda
      ) ;_ end of vl-sort
    ) ;_ end of car
  )
  temp
       ) ;_ end of cons
    ) ;_ end of setq
    (setq lst
    (vl-remove-if '(lambda (x) (equal (caar lst) (car x))) lst)
    ) ;_ end of setq
    (reverse temp)
  ) ;_ end of while
       ) ;_ end of lambda
 lst
      )
    ) ;_ end of vl-remove
  ) ;_ end of defun
  (setq lst
  (mapcar '(lambda (x) (list (car x) (cadr x)))
   (_dwgru-get-spds-text-and-range);из #472 
  ) ;_ end of mapcar
  ) ;_ end of setq
  (CB-filtr lst)
) ;_ end of defun

[CB]

>Кулик Алексей aka kpblc
Как ты делаешь, что у тебя здесь сохраняется форматирование, сделанное в vlide?

[Кулик Алексей aka kpblc]

CB, возможно, дело в настройках самой VLIDE:

[Supermax]

Извиняюсь, а чего это в результатах сортировки 2В перед 2 стоит?
Должно ведь быть 2, 2а, 2А, 2В? Что-то не так сортирует.

[Red Nova]

CB, Спасибо. Правда фильтрует и некоторую полезную информацию. Прикрепляю файл, в котором показано что фильтруется неверно. Зато ты добавил алгоритм удаления подобных позиций. Можно вставить его в код с #494, там все остальное работает нормально.?

По скорости, с которой ты выдаешь ТЗ на лисп, Benchmark наверняка бы поставил тебя на первое место.

Есть такой грех . Дело в том, что лисп давно продуман мною до конца. Просто я разделил его на части, чтобы вас сильно не грузить. Так что как только один этап пройден я сразу рассказываю о продолжении.

ALL
На данный момент есть три кода, которые хотелось бы объединить в один.
1. Совместный код с #494. Там все работает нормально, не хватает фильтра удаления подобных позиций и функции упорядочивания.
2. Код для упорядочивания списку от Крыса на #508.
3. Код от СВ c #512, который работает не совсем верно, но содержит фильтр удаления подобных позиций.

Возможно взять код с #494 и добавить в него Код для упорядочивания списка с #508 и фильтр подобных позиций c #512? Я сам пытался скрестить код с #494 и с #508. Пока не выходит.

Supermax, Верно подметил.

[CB]

>Red Nova #516
В принципе все ясно. Синий текст нужно сделать в одну строчку:
Имеется:

Код:

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

(wcmatch
  (setq a (cdr (assoc 1 (entget (car (entsel))))))
  "\\U+E72E*,Труба*,Тр.*,Лист*,Полоса*,\\U+E720*,Уголок*,\\U+E725*,Швеллер*,\\U+E729*,Двутавр*,Фланец*,Фл.*,
-*,%%c*,\\U+E712*,#%%c*,# %%c*,##%%c*,## %%c*,#\\U+E712*,# \\U+E712*,##\\U+E712*,## \\U+E712*"
) ;_ endwcmatch

Должно быть:

Код:

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

(wcmatch
  (setq a (cdr (assoc 1 (entget (car (entsel))))))
  "\\U+E72E*,Труба*,Тр.*,Лист*,Полоса*,\\U+E720*,Уголок*,\\U+E725*,Швеллер*,\\U+E729*,Двутавр*,Фланец*,Фл.*,-*,%%c*,\\U+E712*,#%%c*,# %%c*,##%%c*,## %%c*,#\\U+E712*,# \\U+E712*,##\\U+E712*,## \\U+E712*"
) ;_ endwcmatch

Исправил в #512

[VVA]

Сообщение от Кулик Алексей aka kpblc P.S. Тут задумался - может, кто более быстрый алгоритм предложит да в библиотеку такую функцию сортировки строкового списка закинет?

В свое время здесь (Search of Windows type Sort function ) разработал еще один вариант функции сортировки строковых списков, в которых числа должны сортироваться как числа (т.е. 8 раньше 11). Я ее давно использую. Благодаря CAB'у и Евгению Елпанову она обрела окончательный (?) вид.

Код:

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

;;Published http://www.theswamp.org/index.php?topic=16564.0
;;By VVA --  05.20.07 mods by CAB
;;Usage (SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05") nil)
;;With ignore case (SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05") t)
;;  CAB added Ignore Case Flag as an argument
;;Return ("A1" "A9" "A10" "B2" "B05" "B11")
;;;ListOfString - список строк
;;; IgnoreCase - t (игнорировать) или nil (нет) регистр символов
(defun SortStringWithNumberAsNumber (ListOfString IgnoreCase / NorStrs count)
;;;Function Normalize (add 0 befor number) number in string
;;; Count normalize symbols set in variable count
;;; CAB added count as an argument
  (defun NormalizeNumberInString (str count / ch i pat ret buf)
    (setq i   0
          pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
          ret ""
    ) ;_ end of setq
    (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
      (if (vl-position ch pat)
        (progn
          (setq buf ch) ;_ end of setq
          (while
            (vl-position (setq ch (substr str (setq i (1+ i)) 1)) pat)
             (setq buf (strcat buf ch))
          ) ;_ end of while
          (while (< (strlen buf) count) (setq buf (strcat "0" buf)))
          (setq ret (strcat ret buf))
        ) ;_ end of progn
      ) ;_ end of if
      (setq ret (strcat ret ch))
    ) ;_ end of while
    ret
  ) ;_ end of defun
  ;;-------------------------------------------------
  ;;  function to Count the longest number in string 
  ;;  CAB added to get the correct COUNT
  (defun getcount (lst / count pat)
    (setq count 0)
    (setq pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
    (mapcar
      '(lambda (str / i maxlen ch)
         (setq i 0 maxlen 0)
         (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
           (if (vl-position ch pat) ; number
             (setq maxlen (1+ maxlen))
             (setq count  (max count maxlen) maxlen 0)
           )
         )
	 (setq count  (max count maxlen)) ;_<<< ADD 21.06.2007 by 
       )
      Lst
    )
    count
  )
  ;;===============================================
  (setq count   (GetCount ListOfString)
        NorStrs (mapcar '(lambda (x) (NormalizeNumberInString x count))
                        ListOfString)
  )
  (and IgnoreCase (setq NorStrs (mapcar 'strcase NorStrs)))
  (mapcar '(lambda (x) (nth x ListOfString)) (vl-sort-i NorStrs '<))
)

Кстати она корректнее сортирует списки

Код:

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

(setq lst-sort '("A9" "A1" "A10" "B11" "B2" "B05"))
(fun_sort-list-string lst-sort) ;_("A1" "B2" "B05" "A9" "A10" "B11") 
(SortStringWithNumberAsNumber lst-sort t) ;_("A1" "A9" "A10" "B2" "B05" "B11")

[Red Nova]

CB,
Пока не корректно работает.
Если к примеру имею выноски с содержанием
("3" "Фл. 300х8") ("3" "Фланец 300х8")
то отфильтровывается верно
("3" "Фланец 300х8")
Но если имеем
("3" "Фл. 300х8") ("3" "Фланец 300х8") ("3" "дверь")
То возвращяет nil.

VVA, Код с #518 пойдет для нашего лиспа? Может его как-то надо адаптировать к парному списку?

[VVA]

Сообщение от Red Nova CB, VVA, Код с #518 пойдет для нашего лиспа? Может его как-то надо адаптировать к парному списку?

Адаптировать нет необходимости. Заодно mapcar и lambda проанализируй

Код:

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

;;;Список
(setq lst '(("2" "Швеллер") ("2a" "Двутавр")("1" "Полоса")("1'" "Полоска")("2b" "Уголок")))
;;;Список-шаблон
(setq tmp (SortStringWithNumberAsNumber (mapcar 'car lst) t))
(setq lst (mapcar '(lambda(x)(assoc x lst)) tmp)) ;_(("1" "Полоса") ("1'" "Полоска") ("2" "Швеллер") ("2a" "Двутавр") ("2b" "Уголок"))

[Red Nova]

Пока СВ размышляет над исправлением #512 хочу напомнить остальным про мою просьбу написать фильтр подобных позиций.

Допустим имеем такой список.

Код:

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

(("2" "Швеллер 12, L=1000") ("2" " 12, L=1000") ("2" "Швеллер 12") ("2" " 12"))

Все подсписки имеют ту же позицию, а это значит, что необходимо оставить только один из этих элементов. Для этого нужно.
А. Проверить есть ли в одном из списков запятая. Если есть, то надо удалить все, которые запятой не содержат, если ни один элемент не содержит запятых, то ничего не удаляем. На данном этапе получим

Код:

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

(("2" "Швеллер 12, L=1000") ("2" " 12, L=1000"))

Б. Проверяем который из списков самый длинный, и оставляем его, а все оставшиеся удаляем. Если длина равна, то удаляем на угад.
Получим

Код:

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

(("2" "Швеллер 12, L=1000"))

[CB]

А чего там размышлять, пробуй:

Код:

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

(defun CB-test (/ CB-filtr lst)
  (defun CB-filtr (lst)
    (setq lst
    (vl-remove-if
      '(lambda (x)
  (or
    (not (equal (length x) 2))
    (member "" x)
    (not
      (wcmatch
        (cadr x)
        "\\U+E72E*,Труба*,Тр.*,Лист*,Полоса*,\\U+E720*,Уголок*,\\U+E725*,Швеллер*,\\U+E729*,Двутавр*,Фланец*,Фл.*,-*,%%c*,\\U+E712*,#%%c*,# %%c*,##%%c*,## %%c*,#\\U+E712*,# \\U+E712*,##\\U+E712*,## \\U+E712*"
      ) ;_ end of wcmatch
    ) ;_ end of not
    (not
      (apply
        'and
        ((lambda (str-lst n a)
    (mapcar '(lambda (y)
        (if (<= (setq n (1- n)) a)
          (wcmatch y "[A-Za-zА-Яа-я0-9'\"]")
          (wcmatch y "#")
        ) ;_ end of if
      ) ;_ end of lambda
     str-lst
    ) ;_ end of mapcar
         ) ;_ end of lambda
   (mapcar 'chr (vl-string->list (car x)))
   (strlen (car x))
   (if
     (or (wcmatch (car x) "*'") (wcmatch (car x) "*\""))
      1
      0
   ) ;_ end of if
        )
      ) ;_ end of apply
    ) ;_ end of not
  ) ;_ end of or
       ) ;_ end of lambda
      lst
    ) ;_ end of vl-remove-if
    ) ;_ end of setq
    (setq lst
    ((lambda (lst / poz temp)
;;;Создает список позиций pat в str
;;;(reverse (poz "123,456,7 89,0" ",")) -> (3 7 12)
       (defun poz (str pat / p n)
  (while (setq n (vl-string-search pat str n))
    (setq p (cons n p)
   n (1+ n)
    ) ;_ end of setq
  ) ;_ end of while
  p
       ) ;_ end of defun
       (while lst
  (setq
    temp
     (cons
       ((lambda (lst-temp / n)
   (list
     (car lst-temp)
     (vl-string-left-trim
       "1234567890 "
       (if
         (equal
    (length (setq n (poz (cadr lst-temp) ",")))
    2
         ) ;_ end of equal
          (substr (cadr lst-temp)
           1
           (car n)
          ) ;_ end of substr
          (cadr lst-temp)
       ) ;_ end of if
     ) ;_ end of vl-string-left-trim
   ) ;_ end of list
        ) ;_ end of lambda
         (car
    (vl-sort
      (vl-remove-if-not
        '(lambda (x) (equal (caar lst) (car x)))
        lst
      ) ;_ end of vl-remove-if-not
      '(lambda (str1 str2)
         (> (length (poz (cadr str1) ","))
     (length (poz (cadr str2) ","))
         ) ;_ end of >
       ) ;_ end of lambda
    ) ;_ end of vl-sort
         ) ;_ end of car
       )
       temp
     ) ;_ end of cons
  ) ;_ end of setq
  (setq lst
         (vl-remove-if '(lambda (x) (equal (caar lst) (car x))) lst)
  ) ;_ end of setq
  (reverse temp)
       ) ;_ end of while
     ) ;_ end of lambda
      lst
    )
    ) ;_ end of setq
  ) ;_ end of defun
  (setq lst
  (mapcar '(lambda (x) (list (car x) (cadr x)))
   (_dwgru-get-spds-text-and-range) ; из #472 
  ) ;_ end of mapcar
  ) ;_ end of setq
  (CB-filtr lst)
) ;_ end of defun

[Red Nova]

CB,
Спасибо. То о чем я говорил исправленно, но заметил, что при испытании не вошли в список следующие выноски
("а1" "-10х100х200")
("а2" "-10х100х300")

[CB]

Надеюсь теперь все нормально:

Код:

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

(defun CB-test (/ CB-filtr lst)
  (defun CB-filtr (lst)
    (setq lst
           (vl-remove-if
             '(lambda (x)
                (or
                  (not (equal (length x) 2))
                  (member "" x)
                  (not
                    (wcmatch
                      (cadr x)
                      "\\U+E72E*,Труба*,Тр.*,Лист*,Полоса*,\\U+E720*,Уголок*,\\U+E725*,Швеллер*,\\U+E729*,Двутавр*,Фланец*,Фл.*,-*,%%c*,\\U+E712*,#%%c*,# %%c*,##%%c*,## %%c*,#\\U+E712*,# \\U+E712*,##\\U+E712*,## \\U+E712*"
                    ) ;_ end of wcmatch
                  ) ;_ end of not
                  (not
                    ((lambda (f str)
                       (or
                         (wcmatch str "@,#")
                         (and (wcmatch str "@*") (f (substr str 2)))
                         (and (wcmatch str "*@,*#")
                              (f (substr str 1 (1- (strlen str))))
                         ) ;_ end of and
                       ) ;_ end of or
                     ) ;_ end of lambda
                      (lambda (str)
                        (apply 'and
                               (mapcar
                                 '(lambda (el)
                                    (wcmatch el "#")
                                  ) ;_ end of lambda
                                 (mapcar 'chr
                                         (vl-string->list str)
                                 ) ;_ end of mapcar
                               ) ;_ end of mapcar
                        ) ;_ end of apply
                      ) ;_ end of lambda
                      (if (or (wcmatch (car x) "*'") (wcmatch (car x) "*\""))
                        (substr (car x) 1 (1- (strlen (car x))))
                        (car x)
                      ) ;_ end of if
                    )
                  ) ;_ end of not
                ) ;_ end of or
              ) ;_ end of lambda
             lst
           ) ;_ end of vl-remove-if
    ) ;_ end of setq
    (setq lst
           ((lambda (lst / poz temp)
              (defun poz (str pat / p n)
                (while (setq n (vl-string-search pat str n))
                  (setq p (cons n p)
                        n (1+ n)
                  ) ;_ end of setq
                ) ;_ end of while
                p
              ) ;_ end of defun
              (while lst
                (setq
                  temp
                   (cons
                     ((lambda (lst-temp / n)
                        (list
                          (car lst-temp)
                          (vl-string-left-trim
                            "1234567890 "
                            (if
                              (equal
                                (length (setq n (poz (cadr lst-temp) ",")))
                                2
                              ) ;_ end of equal
                               (substr (cadr lst-temp)
                                       1
                                       (car n)
                               ) ;_ end of substr
                               (cadr lst-temp)
                            ) ;_ end of if
                          ) ;_ end of vl-string-left-trim
                        ) ;_ end of list
                      ) ;_ end of lambda
                       (car
                         (vl-sort
                           (vl-remove-if-not
                             '(lambda (x) (equal (caar lst) (car x)))
                             lst
                           ) ;_ end of vl-remove-if-not
                           '(lambda (str1 str2)
                              (> (length (poz (cadr str1) ","))
                                 (length (poz (cadr str2) ","))
                              ) ;_ end of >
                            ) ;_ end of lambda
                         ) ;_ end of vl-sort
                       ) ;_ end of car
                     )
                     temp
                   ) ;_ end of cons
                ) ;_ end of setq
                (setq lst
                       (vl-remove-if '(lambda (x) (equal (caar lst) (car x))) lst)
                ) ;_ end of setq
                (reverse temp)
              ) ;_ end of while
            ) ;_ end of lambda
             lst
           )
    ) ;_ end of setq
  ) ;_ end of defun
  (setq lst
         (mapcar '(lambda (x) (list (car x) (cadr x)))
                 (_dwgru-get-spds-text-and-range) ; из #472 
         ) ;_ end of mapcar
  ) ;_ end of setq
  (CB-filtr lst)
) ;_ end of defun

[Red Nova]

CB, Спасибо. Теперь заработало. Правда я тебя не собираюсь оставлять в покое.
Соеденив твой код с сортирующим кодом от VVA я получил

Код:

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

;;Published http://www.theswamp.org/index.php?topic=16564.0
;;By VVA --  05.20.07 mods by CAB
;;Usage (SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05") nil)
;;With ignore case (SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05") t)
;;  CAB added Ignore Case Flag as an argument
;;Return ("A1" "A9" "A10" "B2" "B05" "B11")
;;;ListOfString - список строк
;;; IgnoreCase - t (игнорировать) или nil (нет) регистр символов
(defun SortStringWithNumberAsNumber (ListOfString IgnoreCase / NorStrs count)
;;;Function Normalize (add 0 befor number) number in string
;;; Count normalize symbols set in variable count
;;; CAB added count as an argument
  (defun NormalizeNumberInString (str count / ch i pat ret buf)
    (setq i   0
          pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
          ret ""
    ) ;_ end of setq
    (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
      (if (vl-position ch pat)
        (progn
          (setq buf ch) ;_ end of setq
          (while
            (vl-position (setq ch (substr str (setq i (1+ i)) 1)) pat)
             (setq buf (strcat buf ch))
          ) ;_ end of while
          (while (< (strlen buf) count) (setq buf (strcat "0" buf)))
          (setq ret (strcat ret buf))
        ) ;_ end of progn
      ) ;_ end of if
      (setq ret (strcat ret ch))
    ) ;_ end of while
    ret
  ) ;_ end of defun
  ;;-------------------------------------------------
  ;;  function to Count the longest number in string 
  ;;  CAB added to get the correct COUNT
  (defun getcount (lst / count pat)
    (setq count 0)
    (setq pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
    (mapcar
      '(lambda (str / i maxlen ch)
         (setq i 0 maxlen 0)
         (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
           (if (vl-position ch pat) ; number
             (setq maxlen (1+ maxlen))
             (setq count  (max count maxlen) maxlen 0)
           )
         )
	 (setq count  (max count maxlen)) ;_<<< ADD 21.06.2007 by 
       )
      Lst
    )
    count
  )
  ;;===============================================
  (setq count   (GetCount ListOfString)
        NorStrs (mapcar '(lambda (x) (NormalizeNumberInString x count))
                        ListOfString)
  )
  (and IgnoreCase (setq NorStrs (mapcar 'strcase NorStrs)))
  (mapcar '(lambda (x) (nth x ListOfString)) (vl-sort-i NorStrs '<))
)





(defun CB-test (/ CB-filtr lst)
  (defun CB-filtr (lst)
    (setq lst
           (vl-remove-if
             '(lambda (x)
                (or
                  (not (equal (length x) 2))
                  (member "" x)
                  (not
                    (wcmatch
                      (cadr x)
                      "\\U+E72E*,Труба*,Тр.*,Лист*,Полоса*,\\U+E720*,Уголок*,\\U+E725*,Швеллер*,\\U+E729*,Двутавр*,Фланец*,Фл.*,-*,%%c*,\\U+E712*,#%%c*,# %%c*,##%%c*,## %%c*,#\\U+E712*,# \\U+E712*,##\\U+E712*,## \\U+E712*"
                    ) ;_ end of wcmatch
                  ) ;_ end of not
                  (not
                    ((lambda (f str)
                       (or
                         (wcmatch str "@,#")
                         (and (wcmatch str "@*") (f (substr str 2)))
                         (and (wcmatch str "*@,*#")
                              (f (substr str 1 (1- (strlen str))))
                         ) ;_ end of and
                       ) ;_ end of or
                     ) ;_ end of lambda
                      (lambda (str)
                        (apply 'and
                               (mapcar
                                 '(lambda (el)
                                    (wcmatch el "#")
                                  ) ;_ end of lambda
                                 (mapcar 'chr
                                         (vl-string->list str)
                                 ) ;_ end of mapcar
                               ) ;_ end of mapcar
                        ) ;_ end of apply
                      ) ;_ end of lambda
                      (if (or (wcmatch (car x) "*'") (wcmatch (car x) "*\""))
                        (substr (car x) 1 (1- (strlen (car x))))
                        (car x)
                      ) ;_ end of if
                    )
                  ) ;_ end of not
                ) ;_ end of or
              ) ;_ end of lambda
             lst
           ) ;_ end of vl-remove-if
    ) ;_ end of setq
    (setq lst
           ((lambda (lst / poz temp)
              (defun poz (str pat / p n)
                (while (setq n (vl-string-search pat str n))
                  (setq p (cons n p)
                        n (1+ n)
                  ) ;_ end of setq
                ) ;_ end of while
                p
              ) ;_ end of defun
              (while lst
                (setq
                  temp
                   (cons
                     ((lambda (lst-temp / n)
                        (list
                          (car lst-temp)
                          (vl-string-left-trim
                            "1234567890 "
                            (if
                              (equal
                                (length (setq n (poz (cadr lst-temp) ",")))
                                2
                              ) ;_ end of equal
                               (substr (cadr lst-temp)
                                       1
                                       (car n)
                               ) ;_ end of substr
                               (cadr lst-temp)
                            ) ;_ end of if
                          ) ;_ end of vl-string-left-trim
                        ) ;_ end of list
                      ) ;_ end of lambda
                       (car
                         (vl-sort
                           (vl-remove-if-not
                             '(lambda (x) (equal (caar lst) (car x)))
                             lst
                           ) ;_ end of vl-remove-if-not
                           '(lambda (str1 str2)
                              (> (length (poz (cadr str1) ","))
                                 (length (poz (cadr str2) ","))
                              ) ;_ end of >
                            ) ;_ end of lambda
                         ) ;_ end of vl-sort
                       ) ;_ end of car
                     )
                     temp
                   ) ;_ end of cons
                ) ;_ end of setq
                (setq lst
                       (vl-remove-if '(lambda (x) (equal (caar lst) (car x))) lst)
                ) ;_ end of setq
                (reverse temp)
              ) ;_ end of while
            ) ;_ end of lambda
             lst
           )
    ) ;_ end of setq
  ) ;_ end of defun
  (setq lst
         (mapcar '(lambda (x) (list (car x) (cadr x)))
                 (_dwgru-get-spds-text-and-range) ; из #472 
         ) ;_ end of mapcar
  ) ;_ end of setq
  (CB-filtr lst)


(setq tmp (SortStringWithNumberAsNumber (mapcar 'car lst) t)) 
(setq lst (mapcar '(lambda(x)(assoc x lst)) tmp))


) ;_ end of defun

VVA При упорядочивании возникла одна проблема. Поскольку "1"" в списках записывается как "1\"", то при сортировке он попадает не после "1’" а до.

Теперь очередная просьба:
1. Во первых я кое о чем забыл. В самом начале фильтрации списка нужно удалить первые и последние пробелы элементов подсписка, если таковые есть, на пример ("1 " " -10х100x100"), тут после позиции и до знака – есть такие пробелы. Часто бывает поставишь лишний пробел, а он потом не виден. Не хотелось бы из за этого терять некоторые позиции. Удаление лишних пробелов нам понадобится еще раз, но чуть позже.
2. Следующим шагом я наметил раздел списка на три части. Напомню что вторая строка некоторых позиций содержит запятую.
На пример
("7" "-4х50, L=1000")
А некоторые позиции запятой не содержат вовсе.
Нужно определить содержит ли вторая строка запятую, если да, то надо взять все то что идет после запятой, и записать в новый, третий элемент подсписка. Если вторая строка не содержит запятых, то нужно записать в новый, третий элемент подсписка знак –
Пример. Имеем.
(("7" "-4х50х1000") ("8" "Уголок 50х5, L=1000"))
Получим
(("7" "-4х50х1000" "-") ("8" "Уголок 50х5" " L=1000"))
3. К полученному тройному списку опять применяем функцию удаление лишних пробелов.

[VVA]

VVA При упорядочивании возникла одна проблема. Поскольку "1"" в списках записывается как "1\"", то при сортировке он попадает не после "1’" а до.

Символ " (ASCII код 34) в кодовой таблице он находится раньше чем ' (ASCII код 34). Соответственно и при сортировке ставится будет на 1-е место.
Выход:
1.Не использовать " (заменить, например, буквами)
2. Вместо " использовать '' (два символа ')

По п.1
Этот фрагмент

Код:

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

 (setq lst
         (mapcar '(lambda (x) (list (car x) (cadr x)))
                 (_dwgru-get-spds-text-and-range) ; из #472 
         ) ;_ end of mapcar
  ) ;_ end of setq

Замени этим

Код:

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

 (setq lst
         (mapcar '(lambda (x) (list (vl-string-trim " \t\n" (car x))
				    (vl-string-trim " \t\n"(cadr x))
				    )
		    )
                 (_dwgru-get-spds-text-and-range) ; из #472 
         ) ;_ end of mapcar
  ) ;_ end of setq

*** Добавлено
По п.2,3
Дополнительны ф-ции

Код:

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

;;;Сервисные ф-ции
;|
* Ф-ция str-str-lst
* Сервисная ф-ция извлечения из строки данных, разделенных
* каким либо символом или строкой символов
* Возвращает список строк
* Аргументы [Type]:
  str - строка для разбора [STRING]
  pat - разделитель [STRING]
*  Пример запуска
  (setq str "мы;изучаем;рекурсии" pat ";")
  (setq str "мы — изучаем — рекурсии" pat " — ")
  (str-str-lst str pat)
* Читать подробнее http://www.autocad.ru/cgi-bin/f1/board.cgi?t=25113OT
|;
(defun str-str-lst (str pat / i)
  (cond ((= str "") nil)
        ((setq i (vl-string-search pat str))
         (cons (substr str 1 i)
               (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)
         ) ;_  cons
        )
        (t (list str))
  ) ;_  cond
) ;_  defun
(defun red-trim (str)(vl-string-trim " \t\n" str))

Реализация

Код:

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

(setq lst '(("7" "-4х50х1000")
	    ("8" "Уголок 50х5, L=1000")
	    ("7" "Уголок 60х5")
	   )
) ;_ end of setq
(setq lst
       (mapcar
	 '(lambda (y)
	    (setq y (mapcar 'red-trim y))
	    (if	(nth 2 y)
	      y
	      (progn
		(if (wcmatch (nth 1 y) "-*,Лист*,Фл*")
		  (append y '("-"))
		  (append y '("L="))
		) ;_ end of if
	      ) ;_ end of progn
	    ) ;_ end of if
	  ) ;_ end of lambda
	 (mapcar '(lambda (x) (cons (car x) (str-str-lst (cadr x) ",")))
		 lst
	 ) ;_ end of mapcar
       ) ;_ end of mapcar
) ;_ end of setq

[Red Nova]

VVA, Спасибо. Сделал так как ты говоришь.
Код получился такой

Код:

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

;;Published http://www.theswamp.org/index.php?topic=16564.0
;;By VVA --  05.20.07 mods by CAB
;;Usage (SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05") nil)
;;With ignore case (SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05") t)
;;  CAB added Ignore Case Flag as an argument
;;Return ("A1" "A9" "A10" "B2" "B05" "B11")
;;;ListOfString - список строк
;;; IgnoreCase - t (игнорировать) или nil (нет) регистр символов
(defun SortStringWithNumberAsNumber (ListOfString IgnoreCase / NorStrs count)
;;;Function Normalize (add 0 befor number) number in string
;;; Count normalize symbols set in variable count
;;; CAB added count as an argument
  (defun NormalizeNumberInString (str count / ch i pat ret buf)
    (setq i   0
          pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
          ret ""
    ) ;_ end of setq
    (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
      (if (vl-position ch pat)
        (progn
          (setq buf ch) ;_ end of setq
          (while
            (vl-position (setq ch (substr str (setq i (1+ i)) 1)) pat)
             (setq buf (strcat buf ch))
          ) ;_ end of while
          (while (< (strlen buf) count) (setq buf (strcat "0" buf)))
          (setq ret (strcat ret buf))
        ) ;_ end of progn
      ) ;_ end of if
      (setq ret (strcat ret ch))
    ) ;_ end of while
    ret
  ) ;_ end of defun
  ;;-------------------------------------------------
  ;;  function to Count the longest number in string 
  ;;  CAB added to get the correct COUNT
  (defun getcount (lst / count pat)
    (setq count 0)
    (setq pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
    (mapcar
      '(lambda (str / i maxlen ch)
         (setq i 0 maxlen 0)
         (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
           (if (vl-position ch pat) ; number
             (setq maxlen (1+ maxlen))
             (setq count  (max count maxlen) maxlen 0)
           )
         )
	 (setq count  (max count maxlen)) ;_<<< ADD 21.06.2007 by 
       )
      Lst
    )
    count
  )
  ;;===============================================
  (setq count   (GetCount ListOfString)
        NorStrs (mapcar '(lambda (x) (NormalizeNumberInString x count))
                        ListOfString)
  )
  (and IgnoreCase (setq NorStrs (mapcar 'strcase NorStrs)))
  (mapcar '(lambda (x) (nth x ListOfString)) (vl-sort-i NorStrs '<))
)


* Ф-ция str-str-lst
* Сервисная ф-ция извлечения из строки данных, разделенных
* каким либо символом или строкой символов
* Возвращает список строк
* Аргументы [Type]:
  str - строка для разбора [STRING]
  pat - разделитель [STRING]
*  Пример запуска
  (setq str "мы;изучаем;рекурсии" pat ";")
  (setq str "мы — изучаем — рекурсии" pat " — ")
  (str-str-lst str pat)
* Читать подробнее http://www.autocad.ru/cgi-bin/f1/board.cgi?t=25113OT
|;
(defun str-str-lst (str pat / i)
  (cond ((= str "") nil)
        ((setq i (vl-string-search pat str))
         (cons (substr str 1 i)
               (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)
         ) ;_  cons
        )
        (t (list str))
  ) ;_  cond
) ;_  defun


 ; Удаление лишних пробелов
(defun red-trim (str)(vl-string-trim " \t\n" str))







(defun CB-test (/ CB-filtr lst)
  (defun CB-filtr (lst)
    (setq lst
           (vl-remove-if
             '(lambda (x)
                (or
                  (not (equal (length x) 2))
                  (member "" x)
                  (not
                    (wcmatch
                      (cadr x)
                      "\\U+E72E*,Труба*,Тр.*,Лист*,Полоса*,\\U+E720*,Уголок*,\\U+E725*,Швеллер*,\\U+E729*,Двутавр*,Фланец*,Фл.*,-*,%%c*,\\U+E712*,#%%c*,# %%c*,##%%c*,## %%c*,#\\U+E712*,# \\U+E712*,##\\U+E712*,## \\U+E712*"
                    ) ;_ end of wcmatch
                  ) ;_ end of not
                  (not
                    ((lambda (f str)
                       (or
                         (wcmatch str "@,#")
                         (and (wcmatch str "@*") (f (substr str 2)))
                         (and (wcmatch str "*@,*#")
                              (f (substr str 1 (1- (strlen str))))
                         ) ;_ end of and
                       ) ;_ end of or
                     ) ;_ end of lambda
                      (lambda (str)
                        (apply 'and
                               (mapcar
                                 '(lambda (el)
                                    (wcmatch el "#")
                                  ) ;_ end of lambda
                                 (mapcar 'chr
                                         (vl-string->list str)
                                 ) ;_ end of mapcar
                               ) ;_ end of mapcar
                        ) ;_ end of apply
                      ) ;_ end of lambda
                      (if (or (wcmatch (car x) "*'") (wcmatch (car x) "*\""))
                        (substr (car x) 1 (1- (strlen (car x))))
                        (car x)
                      ) ;_ end of if
                    )
                  ) ;_ end of not
                ) ;_ end of or
              ) ;_ end of lambda
             lst
           ) ;_ end of vl-remove-if
    ) ;_ end of setq
    (setq lst
           ((lambda (lst / poz temp)
              (defun poz (str pat / p n)
                (while (setq n (vl-string-search pat str n))
                  (setq p (cons n p)
                        n (1+ n)
                  ) ;_ end of setq
                ) ;_ end of while
                p
              ) ;_ end of defun
              (while lst
                (setq
                  temp
                   (cons
                     ((lambda (lst-temp / n)
                        (list
                          (car lst-temp)
                          (vl-string-left-trim
                            "1234567890 "
                            (if
                              (equal
                                (length (setq n (poz (cadr lst-temp) ",")))
                                2
                              ) ;_ end of equal
                               (substr (cadr lst-temp)
                                       1
                                       (car n)
                               ) ;_ end of substr
                               (cadr lst-temp)
                            ) ;_ end of if
                          ) ;_ end of vl-string-left-trim
                        ) ;_ end of list
                      ) ;_ end of lambda
                       (car
                         (vl-sort
                           (vl-remove-if-not
                             '(lambda (x) (equal (caar lst) (car x)))
                             lst
                           ) ;_ end of vl-remove-if-not
                           '(lambda (str1 str2)
                              (> (length (poz (cadr str1) ","))
                                 (length (poz (cadr str2) ","))
                              ) ;_ end of >
                            ) ;_ end of lambda
                         ) ;_ end of vl-sort
                       ) ;_ end of car
                     )
                     temp
                   ) ;_ end of cons
                ) ;_ end of setq
                (setq lst
                       (vl-remove-if '(lambda (x) (equal (caar lst) (car x))) lst)
                ) ;_ end of setq
                (reverse temp)
              ) ;_ end of while
            ) ;_ end of lambda
             lst
           )
    ) ;_ end of setq
  ) ;_ end of defun
(setq lst
         (mapcar '(lambda (x) (list (vl-string-trim " \t\n" (car x)) ; Удаление лишних пробелов
				    (vl-string-trim " \t\n"(cadr x)) ; Удаление лишних пробелов
				    )
		    )
                 (_dwgru-get-spds-text-and-range) ; из #472 
         ) ;_ end of mapcar
  ) ;_ end of setq
  (CB-filtr lst)



(setq tmp (SortStringWithNumberAsNumber (mapcar 'car lst) t)) 
(setq lst (mapcar '(lambda(x)(assoc x lst)) tmp))



(setq lst
       (mapcar
	 '(lambda (y)(setq y (mapcar 'red-trim y))
	    (if (nth 2 y) y (append y '("-"))))
	 (mapcar '(lambda (x) (cons (car x) (str-str-lst (cadr x) ",")))
		 lst
	 ) ;_ end of mapcar
       ) ;_ end of mapcar
) ;_ end of setq



) ;_ end of defun CB-test

Удаление пробелов работает.
1. Третий элемент подсписка создается, но только для тех позиций, которые содержат запятую. Нужно чтобы и для элементов без запятой создавался третий элемент, с минусом в содержании "-". Хотя может и без этого дальше можно обойтись, но лучше чтобы это было реализовано на этом этапе.
Добавлено.
Знак “-” должен приписываться третьим элементом только для позиций, вторая строка которых начинается на
“-” “Лист” “Фл”
Для остальных позиций третьим элементом должно приписываться “L=”

2. К сожелению некоторые фильтры перестали работать. Вот например не отфильтровались данные позиции.
("АС" "Двутавр") ("Торец" "фрезеровать") ("1АС" "Швеллер")

Добавлено
Обнаружил, что указанные в пункте 2 неполадки появились когда я в #525 пытался скрестить код от СВ с кодом сортировки от VVA, опять напортачил ...

[VVA]

Red Nova, А что будет, если ни в одной строке не будет запятой? Мне кажется, что минус не нужет. Признаком отсутствия третьего элемента может быть длина списка или nil при попытке вдять третий элемент списка.

[Red Nova]

VVA,

А что будет, если ни в одной строке не будет запятой?

В таком случае все новые третьи элементы подсписка должны содержать либо “-” либо “L=”.

Мне кажется, что минус не нужен.

Все элементы подсписка, (когда добавим гост их будет 4) должны в дальнейшем вписаться в четыре текстовых примитива, которые составляют строку одной позиции в спецификации, которую в дальнейшем нужно рассчитать командой SPEC5D. То есть рамкой отметим шаблон спецификации, в котором 4 столбца (номер поз, ГОСТ, профиль, длина) и N-ное количество строк, и весь список перейдет в спецификацию. То есть в конце нужно иметь для каждой позиции содержание всех граф (в том числе и графы длина). Именно для этого и нужно вписывать туда для позиций не содержащих информацию о длине значения “-” (для листовых позиций) и “L=” (для профильных позиций, чтобы потом добавить вручную нужное значение).

[VVA]

Red Nova, Обновил #526 Выделил синим

[Red Nova]

VVA, Обновил #527
Теперь для всех элементов не содержащих информации о длине создается третий элемент “-”.
1. А можно удовлетворить и это требование

Знак “-” должен приписываться третьим элементом только для позиций, вторая строка которых начинается на “-”, “Лист”, “Фл” Для остальных позиций третьим элементом должно приписываться “L=”

2. Посмотри пожалуйста что я в #527 сделал не так, от чего слетели некоторые фильтры.

К сожалению некоторые фильтры перестали работать. Вот например не отфильтровались данные позиции. ("АС" "Двутавр") ("Торец" "фрезеровать") ("1АС" "Швеллер") это появилось когда я в #525 пытался скрестить код от СВ с кодом сортировки от VVA, опять напортачил ...

[VVA]

По п.1. изменил #526
по п.2 нет времени, еду в командировку.

[Red Nova]

VVA,
Спасибо,
Приятного времяпровождения

All
Кто знает как правильно соединить код от CB c #524 и код сортировки списка от VVA c #518? Я в #527 пытался это сделать, чета напортачил, и лисп перестал работать корректно.

[CB]

>Red Nova
Окончательная сортировка сделана по тому же алгориту, что и у VVA #518, только по другому реализовано, соответственно остались и те же недостатки...

Код:

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

(defun CB-test (/ CB-filtr lst)
  (defun CB-filtr (lst)
    (setq lst
           (vl-remove-if
             '(lambda (x)
                (or
                  (not (equal (length x) 2))
                  (member "" x)
                  (not
                    (wcmatch
                      (cadr x)
                      "\\U+E72E*,Труба*,Тр.*,Лист*,Полоса*,\\U+E720*,Уголок*,\\U+E725*,Швеллер*,\\U+E729*,Двутавр*,Фланец*,Фл.*,-*,%%c*,\\U+E712*,#%%c*,# %%c*,##%%c*,## %%c*,#\\U+E712*,# \\U+E712*,##\\U+E712*,## \\U+E712*"
                    ) ;_ end of wcmatch
                  ) ;_ end of not
                  (not
                    (or
                      (and
                        (wcmatch (car x) "@*")
                        (wcmatch (vl-string-right-trim "1234567890'\"" (car x))
                                 "@"
                        ) ;_ end of wcmatch
                      ) ;_ end of and
                      (and (wcmatch (car x) "#*")
                           (wcmatch (vl-string-left-trim "1234567890" (car x))
                                    ",@,@',@\",',\""
                           ) ;_ end of wcmatch
                      ) ;_ end of and
                    ) ;_ end of or
                  ) ;_ end of not
                ) ;_ end of or
              ) ;_ end of lambda
             lst
           ) ;_ end of vl-remove-if
    ) ;_ end of setq
    (setq lst
           ((lambda (lst / poz temp)
              (defun poz (str pat / p n)
                (while (setq n (vl-string-search pat str n))
                  (setq p (cons n p)
                        n (1+ n)
                  ) ;_ end of setq
                ) ;_ end of while
                p
              ) ;_ end of defun
              (while lst
                (setq
                  temp
                   (cons
                     ((lambda (lst-temp / n)
                        (list
                          (car lst-temp)
                          (vl-string-left-trim
                            "1234567890 "
                            (if
                              (equal
                                (length (setq n (poz (cadr lst-temp) ",")))
                                2
                              ) ;_ end of equal
                               (substr (cadr lst-temp)
                                       1
                                       (car n)
                               ) ;_ end of substr
                               (cadr lst-temp)
                            ) ;_ end of if
                          ) ;_ end of vl-string-left-trim
                        ) ;_ end of list
                      ) ;_ end of lambda
                       (car
                         (vl-sort
                           (vl-remove-if-not
                             '(lambda (x) (equal (caar lst) (car x)))
                             lst
                           ) ;_ end of vl-remove-if-not
                           '(lambda (str1 str2)
                              (> (length (poz (cadr str1) ","))
                                 (length (poz (cadr str2) ","))
                              ) ;_ end of >
                            ) ;_ end of lambda
                         ) ;_ end of vl-sort
                       ) ;_ end of car
                     )
                     temp
                   ) ;_ end of cons
                ) ;_ end of setq
                (setq lst
                       (vl-remove-if '(lambda (x) (equal (caar lst) (car x))) lst)
                ) ;_ end of setq
                (reverse temp)
              ) ;_ end of while
            ) ;_ end of lambda
             lst
           )
    ) ;_ end of setq
  ) ;_ end of defun
  (setq lst (mapcar '(lambda (x)
                       (list (vl-string-trim " " (car x))
                             (vl-string-trim " " (cadr x))
                       ) ;_ end of list
                     ) ;_ end of lambda
                    (_dwgru-get-spds-text-and-range) ; из #472 
            ) ;_ end of mapcar
        lst (CB-filtr lst)
        lst (mapcar '(lambda (x / p)
                       (if (setq p (vl-string-position (ascii ",") (cadr x)))
                         (list (car x)
                               (substr (cadr x) 1 p)
                               (vl-string-left-trim " " (substr (cadr x) (+ 2 p)))
                         ) ;_ end of list
                         (append x '("-"))
                       ) ;_ end of if
                     ) ;_ end of lambda
                    lst
            ) ;_ end of mapcar
  ) ;_ end of setq
  (mapcar
    '(lambda (x) (nth x lst))
    (vl-sort-i
      ((lambda (lst)
         (mapcar
           '(lambda (str1 str2)
              (if (wcmatch str2 "@*")
                (strcat (substr str2 1 1) str1 (substr str2 2))
                (strcat str1 str2)
              ) ;_ end of if
            ) ;_ end of lambda
           (mapcar
             '(lambda (x / str)
                (setq str "0")
                (repeat x
                  (setq str (strcat str "0"))
                ) ;_ end of repeat
                str
              ) ;_ end of lambda
             ((lambda (a)
                (mapcar '(lambda (x) (- (apply 'max a) x)) a)
              ) ;_ end of lambda
               (mapcar
                 '(lambda (str)
                    (length
                      (vl-remove-if-not
                        '(lambda (x)
                           (wcmatch x "#")
                         ) ;_ end of lambda
                        (mapcar 'chr (vl-string->list str))
                      ) ;_ end of vl-remove-if-not
                    ) ;_ end of length
                  ) ;_ end of lambda
                 lst
               ) ;_ end of mapcar
             )
           ) ;_ end of mapcar
           lst
         ) ;_ end of mapcar
       ) ;_ end of lambda
        (mapcar ' strcase (mapcar 'car lst))
      )
      '<
    ) ;_ end of vl-sort-i
  ) ;_ end of mapcar
) ;_ end of defun

[Red Nova]

CB, Как всегда большое спасибо .
Почти все работает корректно.
1. Один только баг нашел. Выноски с содержанием типа (“a2” “-10x100x100”) (“a3” “-10x100x200”) не попадают в список. Хотя (“a1” “-10x100x300”) попадает. То есть проблема с выбором позиций, у которых в первой строке после буквы идет цифра отличная от единицы.
2. Еще одна просьба. Я похоже не учел еще один необходимый фильтр. Часто во второй строке позиции после запятой пишут не длину профиля, а его шаг. К примеру (“1” “12 АIII, шаг 200”). Нашими имеющимися фильтрами эта строка может пройти в спецификацию. А она там не нужна. Чтобы это исправить нужен вот какой фильтр.
В том месте, когда мы уже отфильтровали все выноски, получили парный список, но еще не удалили подобные позиции нужно вклинить такой алгоритм.
Проверяем есть ли во второй строке запятая. Если нет, то ничего не делаем. Если запятая есть, то проверяем что идет после запятой (Пробелы не учитываем). Если после запятой написано (L=…..) или (\\U+03A3L=…..), где \\U+03A3 – это знак сигма, то позицию оставляем в покое, если после запятой идет что-то другое, то удаляем все что идет после запятой вместе с ней же. В (\\U+03A3L=…..) и (L=…..) между буквани добускается ставить пробелы.

[CB]

>Red Nova
По первому пункту - совершенно не понятно что у тебя за списки
(“a2” “-10x100x100”) (“a3” “-10x100x200”) - чего это у тебя кавычки в разные стороны
Проверил нормальный список - все корректно:

Код:

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

(setq lst '(("a2" "-10x100x100") ("a3" "-10x100x200") ("a1" "-10x100x300")))
-> (("a1" "-10x100x300" "-") ("a2" "-10x100x100" "-") ("a3" "-10x100x200" "-"))

[Red Nova]

На кавычки не обращай внимания, это от шрифта в котором я набирал сообщение. Я то проверял на выносках а не на готовом списке. Вообще что-то странное. На работе все заработало корректно, а дома a2, a3 не вписывались. Ну да ладно. Потом проверю опять. Пока забудем это.

[CB]

По п.2.

В том месте, когда мы уже отфильтровали все выноски, получили парный список, но еще не удалили подобные позиции

В зтот момент список может быть таким:

Код:

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

(setq lst '(("2" "Швеллер 12, L=1000, шаг 1000") ("3" "Швеллер 12, L=1000") ("4" "Швеллер 12, шаг 1000") ("5" "Швеллер 12")))

И что будет по твоему алгоритму?
Короче, если "камень преткновения" это слово "шаг", все можно было бы сделать гораздо проще:

Код:

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

(setq lst '(("2" "Швеллер 12, L=1000, шаг 1000") ("3" "Швеллер 12, L=1000") ("4" "Швеллер 12, шаг 1000") ("5" "Швеллер 12")))
(mapcar '(lambda (x / a)
           (if (setq a (vl-string-search "шаг" (cadr x)))
             (list (car x) (vl-string-right-trim " ," (substr (cadr x) 1 a)))
             x
           ) ;_ end of if
         ) ;_ end of lambda
        lst
) ;_ end of mapcar
-> (("2" "Швеллер 12, L=1000") ("3" "Швеллер 12, L=1000") ("4" "Швеллер 12") ("5" "Швеллер 12"))

[Red Nova]

В принципе так тоже пойдет, если только шаг брать в расчет. Но тогда нужно кроме "шаг" добавить и "ш.".
Моим алгоритмом отфильтровалось бы все лишнее, если кто-то написал бы после запятой любое свое примечание. К примеру
("4" "Швеллер 12, сверху") ("4" "Швеллер 12, шаг 1000")...

В зтот момент список может быть таким: Код: Код: [Выделить все] (setq lst '(("2" "Швеллер 12, L=1000, шаг 1000").......) И что будет по твоему алгоритму?

По моему алгоритму этот элемент списка остался бы нетронутым. Но дальше у нас есть алгоритм отрезающий все после второй запятой, и все пришло бы в норму.
("2" "Швеллер 12, L=1000")
Но ты прав, я описал принцип не очень точно.
Нужно проверить есть ли во второй строчке запятые. Если есть, то смотрим что идет за первой запятой, если это не (L=…..) или (\\U+03A3L=…..), то все что идет после первой запятой удаляем вместе с ней.
Таким образом если список такой
(setq lst '(("2" "Швеллер 12, L=1000, шаг 1000") ("3" "Швеллер 12, L=1000") ("4" "Швеллер 12, шаг 1000") ("5" "Швеллер 12")))
то станет таким
(setq lst '(("2" "Швеллер 12, L=1000, шаг 1000") ("3" "Швеллер 12, L=1000") ("4" "Швеллер 12,") ("5" "Швеллер 12")))
А далше уже будут работать ранее написанные фильтры.
Если надумаешь написать этот алгоритм, то внедри его пожалйста сразу в основной лисп, а-то я опять перепутаю куда его сувать .

[CB]

Попробуй заменить в #534 код, который я выделил красным на такой:

Код:

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

(if (or
      (equal (length
               (setq n (poz (cadr lst-temp) ","))
             ) ;_ end of length
             2
      ) ;_ end of equal
      (not (wcmatch (cadr lst-temp) "*L=*"))
    ) ;_ end of or
  (substr (cadr lst-temp) 1 (car n))
  (cadr lst-temp)
) ;_ end of if

Если будет все нормально (а я надеюсь на это) - изменю в #534

[Red Nova]

Тестирую выноски с таким содержанием вторых строк
Швеллер 12, шаг 1000
Швеллер 12, шаг 1000, 2000
возвращяет
(("1" "Швеллер 12" "-") ("2" "Швеллер 12" "шаг 1000"))

[CB]

Ну тогда так:

Код:

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

(if (or
      (equal (length
               (setq n (poz (cadr lst-temp) ","))
             ) ;_ end of length
             2
      ) ;_ end of equal
      (not (wcmatch (cadr lst-temp) "*L=*"))
    ) ;_ end of or
  (substr (cadr lst-temp)
          1
          (if (wcmatch (cadr lst-temp) "*L=*")
            (car n)
            (car (reverse n))
          ) ;_ end of if
  ) ;_ end of substr
  (cadr lst-temp)
) ;_ end of if

[Red Nova]

Теперь заработало.
Заметил что одно условие надо доработать. Я уже писал это для VVA, он делал исправление в своем коде, но ты его наверное не использовал.

Знак “-” должен приписываться третьим элементом только для позиций, вторая строка которых начинается на “-”, “Лист”, “Фл” Для остальных позиций третьим элементом должно приписываться “L=”

[CB]

Код:

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

(defun CB-test ( / CB-filtr lst)
  (defun CB-filtr (lst)
    (setq lst
           (vl-remove-if
             '(lambda (x)
                (or
                  (not (equal (length x) 2))
                  (member "" x)
                  (not
                    (wcmatch
                      (cadr x)
                      "\\U+E72E*,Труба*,Тр.*,Лист*,Полоса*,\\U+E720*,Уголок*,\\U+E725*,Швеллер*,\\U+E729*,Двутавр*,Фланец*,Фл.*,-*,%%c*,\\U+E712*,#%%c*,# %%c*,##%%c*,## %%c*,#\\U+E712*,# \\U+E712*,##\\U+E712*,## \\U+E712*"
                    ) ;_ end of wcmatch
                  ) ;_ end of not
                  (not
                    (or
                      (and
                        (wcmatch (car x) "@*")
                        (wcmatch (vl-string-right-trim "1234567890'\"" (car x))
                                 "@"
                        ) ;_ end of wcmatch
                      ) ;_ end of and
                      (and (wcmatch (car x) "#*")
                           (wcmatch (vl-string-left-trim "1234567890" (car x))
                                    ",@,@',@\",',\""
                           ) ;_ end of wcmatch
                      ) ;_ end of and
                    ) ;_ end of or
                  ) ;_ end of not
                ) ;_ end of or
              ) ;_ end of lambda
             lst
           ) ;_ end of vl-remove-if
    ) ;_ end of setq
    (setq lst
           ((lambda (lst / poz temp)
              (defun poz (str pat / p n)
                (while (setq n (vl-string-search pat str n))
                  (setq p (cons n p)
                        n (1+ n)
                  ) ;_ end of setq
                ) ;_ end of while
                p
              ) ;_ end of defun
              (while lst
                (setq
                  temp
                   (cons
                     ((lambda (lst-temp / n)
                        (list
                          (car lst-temp)
                          (vl-string-left-trim
                            "1234567890 "
                            (if (or
                                  (equal (length
                                           (setq n (poz (cadr lst-temp) ","))
                                         ) ;_ end of length
                                         2
                                  ) ;_ end of equal
                                  (not (wcmatch (cadr lst-temp) "*L=*"))
                                ) ;_ end of or
                              (substr (cadr lst-temp)
                                      1
                                      (if (wcmatch (cadr lst-temp) "*L=*")
                                        (car n)
                                        (car (reverse n))
                                      ) ;_ end of if
                              ) ;_ end of substr
                              (cadr lst-temp)
                            ) ;_ end of if
                          ) ;_ end of vl-string-left-trim
                        ) ;_ end of list
                      ) ;_ end of lambda
                       (car
                         (vl-sort
                           (vl-remove-if-not
                             '(lambda (x) (equal (caar lst) (car x)))
                             lst
                           ) ;_ end of vl-remove-if-not
                           '(lambda (str1 str2)
                              (> (length (poz (cadr str1) ","))
                                 (length (poz (cadr str2) ","))
                              ) ;_ end of >
                            ) ;_ end of lambda
                         ) ;_ end of vl-sort
                       ) ;_ end of car
                     )
                     temp
                   ) ;_ end of cons
                ) ;_ end of setq
                (setq lst
                       (vl-remove-if '(lambda (x) (equal (caar lst) (car x))) lst)
                ) ;_ end of setq
                (reverse temp)
              ) ;_ end of while
            ) ;_ end of lambda
             lst
           )
    ) ;_ end of setq
  ) ;_ end of defun
  (setq lst (mapcar '(lambda (x)
                       (list (vl-string-trim " " (car x))
                             (vl-string-trim " " (cadr x))
                       ) ;_ end of list
                     ) ;_ end of lambda
;;;                    lst
                    (_dwgru-get-spds-text-and-range) ; из #472 
            ) ;_ end of mapcar
        lst (CB-filtr lst)
        lst (mapcar
              '(lambda (x / p)
                 (if (setq p (vl-string-position (ascii ",") (cadr x)))
                   (list
                     (car x)
                     (substr (cadr x) 1 p)
                     (vl-string-left-trim " " (substr (cadr x) (+ 2 p)))
                   ) ;_ end of list
                   (if (wcmatch (cadr x) "-*,Лист*,Фл*")
                     (append x '("-"))
                     (append x '("L="))
                   ) ;_ end of if
                 ) ;_ end of if
               ) ;_ end of lambda
              lst
            ) ;_ end of mapcar
  ) ;_ end of setq
  (mapcar
    '(lambda (x) (nth x lst))
    (vl-sort-i
      ((lambda (lst)
         (mapcar
           '(lambda (str1 str2)
              (if (wcmatch str2 "@*")
                (strcat (substr str2 1 1) str1 (substr str2 2))
                (strcat str1 str2)
              ) ;_ end of if
            ) ;_ end of lambda
           (mapcar
             '(lambda (x / str)
                (setq str "0")
                (repeat x
                  (setq str (strcat str "0"))
                ) ;_ end of repeat
                str
              ) ;_ end of lambda
             ((lambda (a)
                (mapcar '(lambda (x) (- (apply 'max a) x)) a)
              ) ;_ end of lambda
               (mapcar
                 '(lambda (str)
                    (length
                      (vl-remove-if-not
                        '(lambda (x)
                           (wcmatch x "#")
                         ) ;_ end of lambda
                        (mapcar 'chr (vl-string->list str))
                      ) ;_ end of vl-remove-if-not
                    ) ;_ end of length
                  ) ;_ end of lambda
                 lst
               ) ;_ end of mapcar
             )
           ) ;_ end of mapcar
           lst
         ) ;_ end of mapcar
       ) ;_ end of lambda
        (mapcar 'strcase (mapcar 'car lst))
      )
      '<
    ) ;_ end of vl-sort-i
  ) ;_ end of mapcar
) ;_ end of defun

[Red Nova]

Код:

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

Command: (cb-test)
; error: too few arguments

[CB]

Это из-за того, что у меня нет СПДС, так я для себя сделал ввод списка...
Исправлено в #544

[Red Nova]

CB,
Отлично. Спасибо. Теперь все оно.
Осталось совсем мало. Добавить ГОСТы и вписать все в заранее подготовленный шаблон.
Во первых подспискам нужно приписать новый четвертый элемент, причем сначала. Этот элемент будет содержать информацию о ГОСТе.
Алгоритм такой.
-Проверяем на какие символы начинается второй элемент, и в зависимости от этого приписываем спереди различные госты.
Вот список возможных профилей и гостов.

ГОСТ 19903-74 соответствует профилям начинающимся на символы “-”, “лист -”, “лист-”, “Фл”, Причем если профиль начинается на “-”, то должно проверяться условие, что третья строка подсписка содержит только “-”, если она содержат что-то другое, то это другой гост, о нем далее.

ГОСТ 103-76 соответствует профилям начинающимся на символы “-”, “Полоса”, сюда для символа “-” попадают все позиции не вошедши в предыдущий гост.
К примеру
("1" "-10х100x100" "-") ("2" "-5х50" "L=1000")
("ГОСТ 19903-74" "1" "-10х100x100" "-") ("ГОСТ 103-76" "2" "-5х50" "L=1000")

ГОСТ 8568-77 соответствует профилям начинающимся на символы “ Лист ромб”, “Лист чечевица”

ГОСТ 30245-03 соответствует профилям начинающимся на символ “\\U+E72E” (символ квадрата)

ГОСТ 10704-91 соответствует профилям начинающимся на “Тр” (В англ и рус правописании)

ГОСТ 8509-93 соответствует профилям начинающимся на “Уголок”, “\\U+E720”, и содержащим далее в тексте только один символ “х” (В англ и рус правописании)

ГОСТ 8510-86 соответствует профилям начинающимся на “Уголок”, “\\U+E720”, и содержащим далее в тексте два символа “х” (В англ и рус правописании)
К примеру
("1" "Уголок 75х5" "-") ("2" "Уголок 80х50х5" "-")
Станет
("ГОСТ 8509-93" "1" "Уголок 75х5" "-") ("ГОСТ 8510-86" "2" "Уголок 80х50х5" "-")

ГОСТ 8239-89 соответствует профилям начинающимся на “Двутавр”, “\\U+E729”

ГОСТ 8240-97 соответствует профилям начинающимся на “Швеллер”, “\\U+E725”

ГОСТ 5781-82 соответствует профилям начинающимся на “%%c”, “\\U+E712”

[ShaggyDoc]

Что-то мне кажется, что тема научите лиспу разлилась по древу и ушла в частности. Начиная с поста #397 прицепились к позиционным выноскам СПДС и далее пошли многочисленные разборки. Конечно, по ходу были и очень хорошие примеры, которые будут полезны всем, но всё же....

Red Nova еще долго будет сообщать "осталось совсем мало". Типа, только все ГОСТ добавить (а все не добавить). Какой ГОСТ чему соответствует и т.д.

А ведь задачу надо решать в общем виде и универсально. Сводится-то к тому, что надо записать в спецификацию. Частный случай (пока) из выносок СПДС. Потом появятся множество других вариантов (из простых текстов, из атрибутов, из Leader, из MLeader, из черта рогатого, из дьявола хвостатого.

И никакой гарантии, что спецификация правильная, так как может быть что-то вообще не нарисованное, или нарисованное, но не позиционированное, или позиционированное, но не так.

Если уж учиться, то, как я уже писал где-то в начале ветки - с продумывания и постановки задачи. С тщательного продумывания, а не латания дыр на мосту, который строят вдоль реки, а не поперёк.

[CB]

>ShaggyDoc
Собственно говоря, прочитав вчера вечером #547, я пришел приблизительно к тому же выводу - это все до бесконечности и сегодня хотел предложить Red Nova продолжить программу самостоятельно, тем более, что задача в #547 не сложная - правильно составленный ассоциативный список, apply, mapcar - это практически и все. А помощь я думаю будет оказана...

[Red Nova]

ShaggyDoc

Что-то мне кажется, что тема научите лиспу разлилась по древу и ушла в частности.

Правильно все. Давно уже не о том. Можно вообще переместить все это в другую тему (тем более что она есть). В начале я пытался эту задачу сам решить, но она оказалась больно сложной. Изначальна не правильно рассчитал какую задачу тут начинать. Дальше просто пошло выпрашивание кодов у всех, больно полезная штука.

Red Nova еще долго будет сообщать "осталось совсем мало"

Я думаю, что на этот раз действительно осталось совсем мало.

Типа, только все ГОСТ добавить

Ну это не так. Задача так не стояла (если интересно). Нужно ввести только текущие ГОСТы (причем только названия). То есть каждому профилю на данный момент соответствует только один ГОСТ, надо - правь файл, и меняй к примеру гост для уголка с одного на другой. А расчет спецификации будет проводится уже совсем другим лиспом (к стати его VVA давно уже написал.)

И никакой гарантии, что спецификация правильная,

Дык стока времени фильтруем.

Частный случай (пока) из выносок СПДС. Потом появятся множество других вариантов

Не надо других вариантов. Это разработка для пользователей СПДС

Если уж учиться, то, как я уже писал где-то в начале ветки - с продумывания и постановки задачи.

С этим трудно не согласиться. Как я уже признался, я тут давно не учусь, а бесстыдно выпрашиваю то что мне надо.

CB,

сегодня хотел предложить Red Nova продолжить программу самостоятельно

Ну раз ты говоришь что задача не сложная, то буду пробовать. Ждите вопросов...

[Red Nova]

Крыс
Как смотришь на то, чтобы перенести все начиная с #397 в
Копирование данных для спецификаций из выносок СПДС в таблицу из мтекстов?
А-то темка когда-то действительно была полезной многим. Надо бы тут подчистить.

[Кулик Алексей aka kpblc]

Проблема в том, что эти темы (обе) слишком сильно переплелись. В текущей теме и обучение, и спор, и готовые коды...
У меня сейчас нет никаких шансов вдумчиво разбираться. Но если хочешь - могу перетащить все, начиная с #397 в указанную тобой тему. Только, боюсь, как бы кавардака не получилось...
У меня другое предложение: в "Копировании выносок..." ты создаешь новый пост, в котором указываешь ссылки на самые интересные и нужные коды в этой теме. Доработку продолжать в той теме. Эту (временно) закрыть. Захочешь продолжить самообучение - сообщи, открою. Как тебе такой вариант?

[Red Nova]

Согласен, но думаю тему можно и не закрывать. Просто просим всех продолжить данные дебаты в новом месте.

Объявление

Чтобы не засорять этот топик, дальнейшее обсуждение по теме о преобразовании списков переходит в топик Копирование данных для спецификаций из выносок СПДС в таблицу из мтекстов
Всех тех, кому еще не окончательно надоели мои просьбы прошу посетить эту тему. Все дальнейшие дебаты продолжим там.

[Red Nova]

Нужно сделать программу которая изменяла бы некоторые переменные при открытии файла. Как это загнать под одну команду я знаю, а вот как сделать, чтобы эта команда сама вызывалась при открытии нового файла не имею понятия. Прошу направить на путь истенный.

[Кулик Алексей aka kpblc]

Загоняй в автозагружаемый лисп и всего делов...

[DEM]

Red Nova
Acaddoc.lsp
в него все пихай

[Red Nova]

Кулик Алексей aka kpblc,
Блин, действительно.
DEM,
У меня для лиспов свой каталог, я просто недапетрил что если в файл lsp записать не команду а просто строчку к примеру типа
(setvar "mirrtext" 1)
то она будет каждый раз прогонятся при открытие нового файла.

[DEM]

Red Nova
Просто Acaddoc.lsp всегда подгружается при любых профилях.
И его проще использовать для этих целей.

[Кулик Алексей aka kpblc]

DEM, acaddoc имеет одну неприятную особенность... Если встречается первый, то все остальные acaddoc'и не грузятся.

[wetr]

Помогите. Нужна идея.
Нужно ограничить неправильный ввод точки юзером. Начальные данные - точки P1 P2 P3.
Условие такое (angle p1 p2) < (angle p1 p3) < (angle p1 p2) +180
т.е. если условие не выполняется, заново задается точка P3.
Реализую через while. Проблема в том, что условие для while задается через and. А когда какое либо из условий and не выполняется, and возвращает nil, что естественно, и цикл прекращается. Есть какой-то другой способ решить мою задачку? А то я многого не знаю... Надеюсь понятно объяснил

Код:

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

(setq 	p1 (getpoint "\nПервая точка <Выход>: ")
	           p2 (getpoint p1 " \nВторая <Выход>: ")
                      p3 (getpoint "\nТретья <Выход>:"))
    (while (and
	   ( > (angle p1 p3) (+ pi (angle p1 p2)))
	   ( < (angle p1 p3) (+ pi pi (angle p1 p2)))
	  )
     (princ "\n Неверная точка. Повторите ввод")
  (setq         p3 (getpoint "\nТретья (Опции/Помощь):"))
      );_while

[Donhuan]

Попробуй так:

Код:

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

(while 
  (if
    (not
      (and	
        ( > (angle p1 p3) (+ pi (angle p1 p2)))
        ( < (angle p1 p3) (+ pi pi (angle p1 p2)))
      )
    )
    (progn
      (princ "\n Неверная точка. Повторите ввод")
      (setq p3 (getpoint "\nТретья (Опции/Помощь):"))
    )
  )
)

P.S.
Не забывай про initget перед getpoint.

[wetr]

Donhuan, все так! Спасибо.
Но вот условие я задал изначально не совсем верно. Пытаясь скорректировать условие, нагородил забор. Вроде должно работать, а не работает.
В эту конструкцию

Код:

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

(while 
  (if
    (not
      (and	
        ( > (angle p1 p3) ( angle p1 p2))
        ( < (angle p1 p3) (+ pi (angle p1 p2)))
      )
    )
    (progn
      (princ "\n Неверная точка. Повторите ввод")
      (setq p3 (getpoint "\nТретья (Опции/Помощь):"))
    )
  )
)

Я добавил вместо

Код:

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

( > (angle p1 p3) ( angle p1 p2))

такой кусок

Код:

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

( >
	  (if
	    (and
	      (>  (angle p1 p2) (+ pi pi))
	      (< (angle p1 p3) (- (angle p1 p2) pi pi))
	    )
	    (+ (angle p1 p3) (* 4.0 pi))
	    (angle p1 p3)
	  )
	  (angle p1 p2))

Т.е. если угол 1_2 например 315, то угол 1_3 может меняться в пределах от 315 до 45 (против часовой). Но если угол 1_3 30 градусов, например, то предыдущий вариант лиспа его не пропустит. Для этого я и нагородил... Но... он меня не понимает
Получилось вот что

Код:

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

(while ; цикл, пока не введешь правильную координату
  (if
    (not
      (and	
        ( >
	  (if
	    (and
	      (>  (angle p1 p2) (+ pi pi))
	      (< (angle p1 p3) (- (angle p1 p2) pi pi))
	    )
	    (+ (angle p1 p3) (* 4.0 pi))
	    (angle p1 p3)
	  )
	  (angle p1 p2))
        ( < (angle p1 p3) (+ pi (angle p1 p2)))
      )
    )
    (progn
      (princ "\n Неверная точка. Повторите ввод")
      (setq p3 (getpoint "\nТретья <Выход>:"))
    )
  )
);_while

З.Ы. До initget надеюсь тоже дойдет

[ытя]

(> (angle p1 p2) (+ pi pi)) - всегда nil

[VVA]

wetr, Для нормализации угла ( угол в диапазоне 0 - 360 градусов) можешь использовать эту ф-цию

Код:

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

(defun NormalAngle (a)
;-------------------------------------------
;; Argument: angle in radians, any number including negative.
;; Returns: normalized angle in radians between zero and (* pi 2)
  (if (numberp a)
    (angtof (angtos a 0 14) 0))
)

Пример

Код:

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

(normalangle (* 4 pi)) ;_ Вернет 0,0

[kazax1]

Red Nova, это или дано, или не дано. Плохового ни в том, ни в другом нет. Могу посоветовать просмотреть : Н. Полещук. VisualLISP и секреты адаптации AutoCAD. - СПб. Очень доходчиво выложены основные принципы проектирования в автолиспе.

[wetr]

Спасибо всем за помощь!
Проблема решилась так

Код:

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

(setq 	p1 (getpoint "\nПервая точка <Выход>: ")
	        p2 (getpoint p1 " \nВторая <Выход>: ")
		p3 (getpoint "\nТретья <Выход>: ")
                flag T)
(while flag
   (setq ang13 (angle p1 p3)  ang12 (angle p1 p2))
   (setq beta (- ang13 ang12))
   (if (and (< beta 0) (< ang13 pi) (> ang12 pi)) (setq beta (+ beta pi pi)))
   (if 
    (not (and (> beta 0) (< beta pi)))
     (progn
      (princ "\nНеверная точка. Повторите ввод. \nТочки 1 2 3 должны задаваться против часовой стрелки!")
      (setq p3 (getpoint "\nТретья <Выход>:"))
     );progn
     (setq flag nil)
   );if
);while

благодаря VetalBY

[Makswell]

Надо получить дробную часть от числа и преобразовать её в целое число. Причём у дробной части надо взять только 1-е 4 цифры (т.е. просто усечь, а не округлить).
Вроде как надо так.

Код:

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

(defun test (arg)
  (fix (* (- arg (fix arg)) 10000))
)

Но в результате получается не совсем то:

_$ (test 567.1234) 1233 _$ (test 567.12340) 1233 _$ (test 567.12341) 1234 _$ (test 567.12349) 1234

В данном примере нужен однозначный ответ 1234.

[Donhuan]

Код:

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

(defun test (arg)
  (fix (distof (rtos (* (- arg (fix arg)) 10000))))
)

[Makswell]

Donhuan, так то оно так, но меня мучает вопрос, почему мой предыдущий код работает не корректно? Вроде там всё правильно. Глюк?

[Donhuan]

Могу ответить только дежурной фразой: такова особеность представлеия real в lisp.
Пример:

Код:

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

(defun f (x y /)
  (if (/= x y)
    (progn
      (princ (strcat "\n" (rtos (- 5.34 5) 2 x)))
      (f (1+ x) y)
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun

;(f 0 30)

выдает

Код:

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

0
0.3
0.34
0.34
0.34
0.34
0.34
0.34
0.34
0.34
0.34
0.34
0.34
0.34
0.34
0.34
0.3399999999999999
0.3399999999999998
0.3399999999999998
0.3399999999999998
0.3399999999999998
0.3399999999999998
0.3399999999999998
0.3399999999999998
0.3399999999999998
0.3399999999999998
0.3399999999999998
0.3399999999999998
0.3399999999999998
0.3399999999999998

Из моей практики: использовал не мной написанную функцию вычисления арксинуса:

Код:

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

((defun arcsin (x)
  (* 2.0
     (atan
       (/ x
	  (+ 1
	     (sqrt
	       (- 1
		  (* x x)
	       ) ;_ end of -
	     ) ;_ end of sqrt
	  ) ;_ end of +
       ) ;_ end of /
     ) ;_ end of atan
  ) ;_ end of *
)

, которая прекрасно выполняла свою задачу, но в одной из программ где происходило многократное ее использование, стала возникать ошибка. Оказалось, что выражение

Код:

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

(-1 (* x x))

, где x-синус, который не может быть больше единицы, иногда возвращало ничтожно малое, но отрицательное значение и функция (sqrt) его не восприимала. Пришлось написать в виде:

Код:

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

(abs (-1 (* x x)))

P.S. Может кто из проффесиональных программистов пояснит в чем дело.

В догонку: http://www.caduser.ru/cgi-bin/f1/board.cgi?t=21661WW

[Makswell]

Donhuan, спасибо за разъяснения. Значит всё таки глюк.

[Eximius]

Раз уж тут помогают, то я тоже хочу задать несколько вопросов, т.к. тоже считаю себя чайником.
Вопросы:
1)Что значит "тихий выход". Какая разница между тем написать функцию (princ) в конце или нет?
2)Как в лиспе нарисовать, например, параболу таким образом, чтоб она состояла не из отрезков линий а из целой линии.

Код:

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

(defun parab (/ x y shag j)
  (setq shag 0.1)
  (setq x -20)
  (setq massiv '())
  (while (<= x 20)
    (setq y (* x x))
    (setq massiv (cons (list x y) massiv))
    (setq x (+ x shag))
  );while
  (setq j 1)  
  (while (< j (1- (length massiv)))
    (command "._line" (nth (1- j) massiv) (nth j massiv) "")
    (setq j (1+ j))
  );while
);defun

Здесь massiv - список с координатами параболы, но как начертить параболу сплошной? Из одной полилинии.
Надеюсь вопрос ясен.

[Donhuan]

1. Все функции лиспа возвращают какое-либо значение, при выходе из функции в ком. строку возвращается последнее вычисленое значение ("мусор"). Функция (princ) не возвращает ничего, поэтому если ее вставить последней в тело функции, то в ком. строке ничего не появится.
2.

Код:

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

(defun parab (/ x y shag massiv old)
  (setq	shag 1
	x    -20
	old  (getvar "OSMODE")
  ) ;_ end of setq
  (setvar "OSMODE" 0)
  (while (<= x 20)
    (setq y	 (* x x)
	  massiv (cons (list x y) massiv)
	  x	 (+ x shag)
    ) ;_ end of setq
  ) ;_ end of while
  (command "._pline")
  (mapcar 'command massiv)
  (command "")
  (setvar "OSMODE" old)
) ;_ end of defun

[Eximius]

Спасибо, Donhuan, разобрался.

[acyxou]

Подскажите, пожалуйста, как мне провернуть следующее.
Составляю небольшую прогу для экспорта/импорта профилей .arg. Вот кусок кода:

Код:

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

(defun C:ExportProfile (/ username currentprofile server path fullpath)
(setq username (getvar "loginname")) ;извлечение имени пользователя чтоб назвать экспортируемый файл его именем 
(setq currentprofile (getvar "cprofile")) ;извлечение названия текущего профиля
(setq server (strcat "\\\\Server\\Proekts\\Autocad_Resources"))
(setq path (strcat "\\Profiles\\cadman.arg"))
(setq fullpath (strcat server path))
  ((lambda (currentprofile fullpath)(vla-exportprofile (vla-get-profiles (vla-get-preferences (vlax-get-acad-object))
       ) currentprofile fullpath)) currentprofile fullPath)
       )

Все классно работает, НО! Мне нужно чтоб профайл экспортировался с названием логина пользователя. А в моем коде имя жестко регламентировано. Я понимаю что нужно ввести еще одну переменную которая складывала бы текстовые строки переменной loginname и расширения ".arg". Как это сделать у вас и спрашиваю....

Всем спасибо! Сам родил

Код:

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

(defun C:ExportProfile (/ username currentprofile server path profilename fullpath)
;;;(setq username (getvar "loginname")) ;извлечение имени пользователя чтоб назвать экспортируемый файл его именем
(setq currentprofile (getvar "cprofile")) ;извлечение названия текущего профиля
(setq server (strcat "\\\\Server\\Proekts\\Autocad_Resources"))
(setq path (strcat "\\Profiles\\"))
(setq profilename (strcat (getvar "loginname") ".arg"))
(setq fullpath (strcat server path profile))
  ((lambda (currentprofile fullpath)(vla-exportprofile (vla-get-profiles (vla-get-preferences (vlax-get-acad-object))
       ) currentprofile fullpath)) currentprofile fullPath)
       )

По-крестьянски, но зато работает

[Red Nova]

Хочу кое что записать при помощи лиспа в таблицы но понятия не имею о том как с ними работать. Посоветуйте пожалуйста самые основные функции.

[Кулик Алексей aka kpblc]

Red Nova, http://arcada.com.ua/forum/viewtopic.php?t=1095
http://arcada.com.ua/forum/viewtopic.php?t=945
http://arcada.com.ua/forum/viewtopic.php?t=698
http://arcada.com.ua/forum/viewtopic.php?t=440

[Red Nova]

Спасибо.
А как создать таблицу c определенным количеством колонок и строк и записать в определенные ячейки что либо?

[Кулик Алексей aka kpblc]

Да так же, в общем-то Сначала добавляешь таблицу, задавая ей количество строк и столбцов, потом через vla-settext назначаешь указанной ячейке текст. Вроде ничего особо сложного...

[ShaggyDoc]

Вроде ничего особо сложного...

Вроде. Объектная модель достаточно простая.

Но масса нюансов, связанных с оформлением - точные размеры, вес линий, объединение ячеек шапки. Например, vla-settext может испортить оформление ячейки. И многое надо самостоятельно изобретать - где и как хранить описание таблицы, откуда брать тексты и прочее.

[Red Nova]

kpblc,

Сначала добавляешь таблицу, задавая ей количество строк и столбцов

Можно элементарный пример?

[Дима_]

Сообщение от Red Nova kpblc, Можно элементарный пример?

Да штож такое: Red Nova - ведь должен уже лучше Крыса lisp знать.

Код:

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

(vl-load-com)
(defun maketable (pt nr nc rh cw)
(vla-addtable 
	(vlax-get-property (vlax-get-property (vlax-get-acad-object) 'ActiveDocument) 'Modelspace)
	(vlax-3d-point pt)
	nr nc rh cw
);end of addtable
);end of maketable

Запускать (maketable точка_вставки количество_сток количество_колнок высота_строки ширина_колонки)
например (maketable (getpoint) 5 5 5 5)

[VVA]

Red Nova, Примеры у тебя есть. Смотри vrc, в частности пост #5. Нужное выделил красным

[Кулик Алексей aka kpblc]

> ShaggyDoc: а кому обещали, что будет легко? Естественно, что нюансов немеряно (а если еще и учитывать нововведения 2008-й версии в области авторазбиения таблиц, то можно с непривычки вообще рехнуться).
> Red Nova: А вообще-то лучше всего создавать свой стиль табличный, с ним и играться, не надеясь вообще ни на что Кстати, "простых" примеров у меня как-то не получилось "накопить".

[Red Nova]

Спасибо за ответы
Дима_,

Да штож такое: Red Nova - ведь должен уже лучше Крыса lisp знать.

А я вечный студент.
All
Успехи пока нулевые. В хелпе отсутствует информация по vla-addtable и его структуру я не понимаю.
От VVA пример больно сложный. Там все vla функции о которых я не имею понятия. А вообще можно без vla функций обойтись?
В примере от Димы мало настроек, и пока что кажется что создать таблицу с требуемой мне структурой (ведомость расхода стали по ГОСТ) будет весьма сложно. В приложенном файле есть пример такой таблицы (правда в файле она из линий и мтекстов)

[Кулик Алексей aka kpblc]

Red Nova, лично мне для начала работы очень сильно помогла статья на http://www.cad.dp.ua/stats/vla_doc.php

[Дима_]

1. Синтакис всех vla- функций находиться в хелпе по VB, там же есть инструкция по переводу синтаксиса VB в VL, да и где-то на форуме она есть на русском языке.
2. Если без vla, то либо командными методами, либо через DXF, в первом надо слишком много учесть, во втором слишком много изучить, лично мне DXF больше нравиться (позволяет во сремя создания сразу задать все параметры), но для таблиц, областей и 3Д объектов - гемор. И тут приходят на помощь готовые решения на VLA (VBA). Так что если нужны таблицы пора начинать изучать VL.

[Red Nova]

kpblc, Спасибо, статья очень полезная. В общем понял как при помощи VLA- создавать и модифицировать таблицы, даже получается.

Теперь пытаюсь подготовить нужную информацию для последующего заполнения таблицы. Есть несколько как всегда примитивных вопроса, на этот раз про работу со списками.

1. Как создать пустой список?
2. Как проверить при помощи wcmatch пуст ли он?
3. Как от элемента списка оставить только последнюю букву?
имею "Арматура d= 8", нужно оставить только "8"
4. Как сосчитать количество элементов списка?

[Кулик Алексей aka kpblc]

1. А зачем его создавать? Инициализируй любую переменную - вот тебе и пустой список.
2. С помощью wcmatch проверяется не список, а строка
3. См. subst
4. См. length

[Red Nova]

Спасибо.
Кое что уже получается. Уже рисуется таблица

Код:

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

 (defun C:ttable (/)
  
  
(setq klass '("Арматура АС1" ("ГОСТ 5781-82" ("Арматура d= 8" "4.0") ("Арматура d= 10" "0.6") ("Арматура d= 16" "0.6") ("Арматура d= 20" "0.6"))))
(setq count_Ac1 4)
(setq weight_Ac1 5.8)
  
  
(vla-addtable (lib:get-active-space)
                      (vlax-3d-point (getpoint))
                      7
                      (+ count_Ac1 3)
                      8 ;_высота строки
                      15 ;_ширина столбца
                    )
  (setq mytable (vlax-EName->vla-Object (entlast)))
  (vla-SetText mytable 0 0 "Ведомость расхода стали")
  (vla-SetText mytable 1 0 "Марка элемента")
  (vla-MergeCells mytable 1 5 0 0)
  (vla-SetText mytable 1 1 "Изделия арматурные")
  (vla-MergeCells mytable 1 1 1 (+ count_Ac1 2))
  (vla-SetText mytable 2 1 "Арматура класса")
  (vla-MergeCells mytable 2 2 1 (+ count_Ac1 1))
  (vla-SetText mytable 3 1 "Аc1")
  (vla-MergeCells mytable 3 3 1 (+ count_Ac1 1))
  (vla-SetText mytable 4 1 "ГОСТ 19903-74")
  (vla-MergeCells mytable 4 4 1 (+ count_Ac1 1))
  (setq count_Ac1_realtime 0)
  ;(vla-SetText mytable 5 1 "d= 6")
  ;(vla-SetText mytable 5 2 "d= 8")
  ;(vla-SetText mytable 5 3 "d= 10")
  (mapcar '(lambda(line)
	   (setq count_Ac1_realtime (+ 1 count_Ac1_realtime))
	   (vla-SetText mytable 5 count_Ac1_realtime (car line))
	   (vla-SetText mytable 6 count_Ac1_realtime (car (cdr line) ))
          );_end of lambda
          (cdr (cadr klass))
  )
  (vla-SetText mytable 5 (+ count_Ac1 1) "Итого")
  (vla-SetText mytable 6 (+ count_Ac1 1) weight_Ac1)
  (vla-SetText mytable 2 (+ count_Ac1 2) "Всего")
  (vla-MergeCells mytable 2 5 (+ count_Ac1 2) (+ count_Ac1 2))
  (vla-SetRowHeight mytable 1 8)
  (vla-SetColumnWidth mytable 0 40)
  
  )

Только вот с subst и с substr у меня ничего не выходит.

Вот тут

Код:

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

(vla-SetText mytable 5 count_Ac1_realtime (car line))

Нужно поменять результат “Арматура d= х” на "%%c х"
Прошу подсказать как.

[VVA]

Как вариант можно так

Код:

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

(vl-load-com)
(setq txt "Арматура d= 18")
(setq txt (vl-string-trim " \t\n" txt)) ;_На всякий случай удаляем незначащие пробелы
(setq len (strlen txt)) ;_Длина строки (Идем с конца)
(while (and (> len 0) ;_Не дошли до начала
	    (member (substr txt len 1) ;_Текущий символ цифра
		    '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
	    )
  (setq len (1- len)) ;_Смотрим предыдущий символ
  )
(setq num (substr txt (1+ len)))
(setq num (strcat "%%d" num))

[Дима_]

Немного не по теме вопроса -

Код:

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

(setq mytable (vlax-EName->vla-Object (entlast)))

ихмо лишнее действие т.к.

Код:

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

(vla-addtable...)

возращает vb-object созданной таблицы.

[Holon]

тоже немного не потеме, ИМХО такие таблицы надо создавать, как блок с атрибутами, и атрибуты можно менять програмно.

[Red Nova]

VVA,
Спасибо. Правда пока что не интегрировал в свой код, но это успеется.
Дима_,
Согласен. Ты еще в моих кодах много лишнего увидишь.
Holon, Мне бы пока с таблицами разобраться. К стати, оказывается с помощью vla их можно очень легко редактировать.

В общем пока продолжаю писать код преобразования спецификации с ведомость расхода стали, скора ждите новых вопросов.

Ну вот и вопрос.
Почему не заработала элементарная функция чтения содержимого текста или атрибута?

Код:

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

(defun izd (/)
(setq ename1 (ssget))
(setq vlaobject1
(vlax-ename->vla-object ename1))
(setq izdelie (vla-get-TextString vlaobject1))
(princ izdelie)
)

[Donhuan]

ssget возвращает набор, а не ename

Код:

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

(setq  l_vla_obj 
  (mapcar 'vlax-ename->vla-object
     (vl-remove-if 'listp (mapcar (function cadr)
        (ssnamex (ssget))))))

[Кулик Алексей aka kpblc]

Добавлю: см. в библиотеке функций _dwgru-conv-pickset-to-list : http://forum.dwg.ru/showpost.php?p=188342&postcount=21

[VVA]

Red Nova,
1. Не факт, что в ssget будет блок. Это я к тому, что ssget нужно делать с фильтром

Код:

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

;;;Запоминаем в ss набор только блоков
(setq ss (ssget '((0 . "INSERT"))))

2. Не факт, что у блока будут атрибуты. Это тоже легко проверить с помощью фильтра ssget

Код:

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

;;;Запоминаем в ss набор только блоки c атрибутами
(setq ss (ssget '((0 . "INSERT")(66 . 1))))

3. Могут выбрать объект на заблокированном слое. Тогда попытки модифицировать его приведут к ошибке. Примитивы на заблокированных слоях легко отсечь опцией ssget

Код:

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

(setq ss (ssget "_:L" '((0 . "INSERT")(66 . 1))))

Итого в преременной ss имеем набор только блоков, с атрибутами на незаблокированных слоях

[Red Nova]

Donhuan, kpblc,
Пока чтоне понял что там к чему. Опять не вышло

Код:

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

(defun izd (/)
(setq l_vla_obj 
  (mapcar 'vlax-ename->vla-object
     (vl-remove-if 'listp (mapcar (function cadr)
        (ssnamex (ssget))))))
(setq izdelie (vla-get-TextString l_vla_obj))
(princ izdelie)
)

VVA, Согласен, тогда я так думаю что включить в фильтр текст и мтекст можно так

Код:

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

(setq ss (ssget "_:L" '((0 . "INSERT")(66 . 1)) (0 . "text")(0 . "mtext")))

[VVA]

1. Red Nova, Ты отладчиком посмотри что у тебя в l_vla_obj?
2. У табя там список а ты пытаешься взять у списка свойство TextString
3. У блока НЕТ свойства TextString, оно есть у Атрибута, а Атрибут это один из элементов БЛОКА, поэтому чтобы добраться до Атрибута, нужно поковырять блок еще немного.
4. Фильтр ssget неверен. Нужно добавлять логические группы (-4 . "<OR"),
(-4 . "<AND") и т.д.
Еще про атрибуты
http://forum.dwg.ru/showthread.php?t=14230
http://www.caduser.ru/forum/index.ph...D=23&TID=35337
http://www.caduser.ru/forum/index.ph...#message243276
http://www.caduser.ru/forum/index.ph...#message148413
http://www.caduser.ru/forum/index.ph...5&FORUM_ID=23&

[Red Nova]

l_vla_obj возвращяет к примеру
(#<VLA-OBJECT IAcadMText 0bdabf24>)
Что это такое, и что с этим делать?
Поковырялся в лиспах от VVA, но бестолку, там стока всего, мне не понять...
По ссылкам тоже больно сложные лиспы, там даже ssget не используется. Мне нужно просто прочитать содержимое текста или атрибута.
ssget возвращает <Selection set: 51>
Что это? Ничего не ясно.
Можно разжевать плиз?
Как же все-таки извлечь содержимое из текста? (атрибут на время оставим)
Добавлено
1. Предположим получил в результате работы некого кода
(1 . "содержание_текста")
что это? Список или нет? Как с этим работать, и оставить только искомое содержание?
2. Почему Из списка

((-1 . <Entity name: 7ef03578>) (0 . "MTEXT") (330 . <Entity name: 7ef01cf8>) (5 . "20F") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (48 . 100.0) (100 . "AcDbMText") (10 2872.1 1792.73 0.0) (40 . 500.0) ... )

assoc выдает (1 . "содержание_текста").
Может многоточие в конце означает что я просто не вижу всего, если это так, то как увидеть все содержимое в watch window

[Donhuan]

<Selection set: 51> - набор, применяя к нему (ssnamex) (см. справку) получаем некий список, из этого списка при помощи приведенных выше манипуляций (пост 595) получаем список ename объектов, которые выбрали функцией (ssget), применяя уже к этому списку (mapcar 'vlax-ename->vla-object) получаем список vla-объектов (объекты ActiveX), к которым можно обращаться при помощи функций c префиксом vla-. Описание всех объектов vla есть в хелпе (см. объектная модель).
#<VLA-OBJECT IAcadMText 0bdabf24> - это и есть vla объект.
Открываем справку, ищем его свойства и методы, пишем (допустим он в переменной vla_obj):

Код:

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

(vla-get-textstring vla_obj)

[Red Nova]

Спасибо, но разве в посте #598 у меня не так? И не работает. А VVA говорит что

1. Red Nova, Ты отладчиком посмотри что у тебя в l_vla_obj? 2. У табя там список а ты пытаешься взять у списка свойство TextString

А разве (#<VLA-OBJECT IAcadMText 0bdabf24>) это список? Это ведь сам vla объект, почему он не реагирует на vla-get-textstring ?

[Кулик Алексей aka kpblc]

А скобки там для красоты, что ли?

[Red Nova]

Мда, ну тогда скажи как взять из списка (#<VLA-OBJECT IAcadMText 0bdabf24>) текстовое содержимое?

[Кулик Алексей aka kpblc]

(vla-get-textstring (car lst))
Где lst - твой (#<VLA-OBJECT IAcadMText 0bdabf24>)

[VVA]

1. Если не уверен, что у тебя. Используй функцию type

Команда: (setq l_vla_obj '(#<VLA-OBJECT IAcadMText 0bdabf24>)) ;;;Моделиру (#<VLA-OBJECT IACADMTEXT 0BDABF24>) Команда: Команда: (type l_vla_obj) LIST

Кстати и переменная у тебя называется l_vla_obj = List_Vla_Object

[Red Nova]

Спасибо, с текстом таки понял. А вот атрибуты пока-что нет.
Предположил что так

(setq l_vla_obj (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar (function cadr) (ssnamex (ssget)))))) (setq izdelie (vla-get-TextString (vla-getattributes (car l_vla_obj)))) (princ izdelie)

Но естественно не работает.
В отладчике показывает, что vla-getattributes возвращает
*LAST-VALUE* = #<variant 8201 ...>
Что это?
На сколько я понял чтобы работала vla-get-TextString нужно подготовить что-то типа #<VLA-OBJECT IAcadMText 0cb388a4>, это наверное название объекта, но как его получить для атрибута не предполагаю.

[Кулик Алексей aka kpblc]

DwgRuLispLib: Получение указателей на атрибуты вхождения блока

[Red Nova]

А я не знаю что такое указатель и что с ним делать.

[Кулик Алексей aka kpblc]

указатель - это нечто типа #<VLA-OBJECT IACADMTEXT 0BDABF24>
Только сам понимаешь, что текст и цифры будут другими

[Red Nova]

А что значит

указатель на вхождение блока и маска тэга атрибута

То есть что должно писаться после
_dwgru-block-get-attr-by-mask

[Кулик Алексей aka kpblc]

Список указателей на атрибуты. А потом применяешь нечто типа

Код:

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

(mapcar (function vla-get-textstring)

к этому списку и получаешь список значений атрибутов блока.

[ShaggyDoc]

Сообщение от Red Nova А я не знаю что такое указатель и что с ним делать.

Указатель - ссылка на место в памяти, где есть нечто. В данном случае, визуально, это может быть представлено в виде #<VLA-OBJECT IACADMTEXT 0BDABF24>.

Тебе, чтобы не путаться, лучше термин указатель не применять. Для себя говори "получаю объект MTEXT". Это в конкретном случае, а в общем виде указатель может указывать на что угодно.

[Eximius]

Ещё вопросик от чайника:
Как програмно написать верхний или нижний индекс в команде mtext?
Когда мы просто хотим написать 2 в степени 2, мы пишем 2^2 выделяем ^2 и жмём stack. Как нажать stack програмно?
И вообще какие есть способы програмного введения индексов?

[VVA]

Eximius, С помощью управляющих кодов. Есть в справке Автокада.
Можно еще здесь посмотреть
Твой пример в кодах выглядит так

Command: (entget(entlast)) ((-1 . <Entity name: 7ef7b180>) (0 . "MTEXT") (330 . <Entity name: 7ef61cf8>) (5 . "120") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (100 . "AcDbMText") (10 311.516 507.067 0.0) (40 . 2.5) (41 . 82.7726) (71 . 1) (72 . 5) (1 . "\\A1;2{\\H0.7x;\\S^2;}") (7 . "Standard") (210 0.0 0.0 1.0) (11 1.0 0.0 0.0) (42 . 2.83333) (43 . 2.5) (50 . 0.0) (73 . 1) (44 . 1.0))

[Red Nova]

Елкалла палкалла, я опять не въехал.
Пожалуйста покажите на примере как получают значение атрибута блока.

[VVA]

Red Nova, например так

[Red Nova]

Спасибо, правда эту ссылка я уже просматривал, и помню что так и не разобрался. Но вот поиском я нашел тему где Крыс впервые привел get-attr-by-mask, там я нашел и пример вызова

Код:

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

(mapcar (function (lambda(x) (cons (vla-get-TagString x) (vla-get-TextString x)))) (get-attr-by-mask (car (entsel "\nУкажите блок : ")) "*"))

Такой функцией можно получить все атрибуты блока, типа

Код:

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

(("МАССА" . "100") ("ИЗДЕЛИЕ" . "Балка Б-1"))

Проблема в том, что тыкаю то я в конкретный атрибут, и мне нужен именно он ("ИЗДЕЛИЕ"), причем не хочется ставить фильтр по имени атрибута. А хочется взять именно "тыкаемый" атрибут
Такое возможно?

[Кулик Алексей aka kpblc]

Возможно. Используй nentsel

[Red Nova]

Кулик Алексей aka kpblc,
Спасибо, теперь похоже нашел универсальный вариант для получения содержания текста или атрибута

Код:

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

(defun rn_get_atr_or_text (/ izdelie l_vla_obj )
(setq l_vla_obj 
  (mapcar 'vlax-ename->vla-object
     (vl-remove-if 'listp (list (car 
         (nentsel))))))
(setq izdelie (vla-get-TextString (car l_vla_obj)))
)

А можно при этом запретить выбирать объекты которые не являются текстом, мтекстом или блоком с атрибутом?

[Кулик Алексей aka kpblc]

После nentsel'a проверяй тип возвращенного объекта. По-моему, в таком режиме это единственный вариант.

[Red Nova]

1. А что такое режим?
2. Вот еще вопрос.
Пишу код функции (функция-1) в которую вставляю другую функцию (функция-2), в функции-2 объявлена локальная переменная. Далее в функции-1 нужно вернуть значение локальной переменной функции-2, но в это время функция-2 свое уже отработала, и эта локальная переменная уже не существует. Очень не хочется трогать функцию-2 и менять локальную переменную на просто переменную, так как функция-2 применяется еще во многих местах. Выход есть?

[Кулик Алексей aka kpblc]

Если по-простому:

Код:

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

(defun get-text-string-by-ent (/ ent res)
  (if (= (type (setq ent (vl-catch-all-apply
                           (function
                             (lambda ()
                               (car (nentsel "\nУкажите атрибут, текст или многострочный текст <Отмена> : "))
                               ) ;_ end of lambda
                             ) ;_ end of function
                           ) ;_ end of vl-catch-all-apply
                     ) ;_ end of setq
               ) ;_ end of type
         'ename
         ) ;_ end of =
    (if (vlax-property-available-p (setq ent (vlax-ename->vla-object ent)) 'textstring)
      (setq res (vla-get-textstring ent))
      (alert (strcat "Указанный примитив не имеет свойства TextString"
                     "\nФункция завершает работу и вернет nil"
                     ) ;_ end of strcat
             ) ;_ end of alert
      ) ;_ end of if
    ) ;_ end of if
  res
  ) ;_ end of defun

Тип примитива специально не проверяется. Если у примитива есть свойство TextString, то результат будет. Иначе - nil.
Теперь по п.2 - ищи информацию по областям видимости переменных. В качестве иллюстрации:

Код:

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

(defun func_1 (/ local)
  (setq local "func_1")
  (princ (strcat "\nExecute func_1; local=" local))
  (func_2)
  (princ (strcat "\nExecute func_1; local=" local))
  (princ)
  ) ;_ end of defun

(defun func_2 (/ local)
  (setq local "func_2")
  (princ (strcat "\nExecute func_2; local=" local))
  (princ)
  ) ;_ end of defun

[Red Nova]

По П.2
Посмотрел в инете информацию по областям видимости переменных, ничего нового для себя не узнал, все те же локальные и глобальные переменные. Как вытащить из функции значение локальной переменной не узнал. А может такое вообще невозможно?
Если на твоем примере, то мне нужно чтобы в функцие 1 значение переменной стало "func_2".

[VVA]

Red Nova,
1. Присвой значение локальной переменной глобальной

Код:

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

(defun func_1 (/ local)
  (setq local "func_1")
  (princ (strcat "\nExecute func_1; local=" local))
  (func_2)
  (princ (strcat "\nExecute func_1; local=" local))
  (princ "\nExecute func_1; local from func2=")(princ  **GLOBAL_VAR**)
  (princ)
  ) ;_ end of defun

(defun func_2 (/ local)
  (setq local "func_2")
  (setq **GLOBAL_VAR** local)
  (princ (strcat "\nExecute func_2; local=" local))
  (princ)
  ) ;_ end of defun

2. или верни функцией-2 нужное значение

Код:

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

(defun func_1 (/ local l2)
  (setq local "func_1")
  (princ (strcat "\nExecute func_1; local=" local))
  (setq l2 (func_2)) ;;;Запоминаем значение переменной
  (princ (strcat "\nExecute func_1; local=" local))
  (princ "\nExecute func_1; local from func2=")(princ  l2)
  (princ)
  ) ;_ end of defun

(defun func_2 (/ local)
  (setq local "func_2")
  (princ (strcat "\nExecute func_2; local=" local))
  (princ)
  local ;;;Возвращаем значение переменной
  ) ;_ end of defun

PS
1. Глобальным может быть и список (если нужно вернуть несколько значенией)
2. Возвращаться может список (если нужно вернуть несколько значенией)

[Red Nova]

Спасибо, значит таки придется чуток поменять твою SPECKG, поскольку мне нужно вернуть из нее список itog для таблицы ведомости расхода стали

[Red Nova]

Требуется создать цикл типа этого

Код:

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

      (setq flag_izdelie 0)
      (setq get_nil t)

      (while get_nil
      (setq izdelie (get-text-string-by-ent))
      (speckg "5D")
      (setq itog_Izdelie (list izdelie itog))
      (if (= 0 flag_izdelie)
	(setq itog_Izdelie_all (list itog_Izdelie))
	(setq itog_Izdelie_all (cons itog_Izdelie itog_Izdelie_all))
      );_end of  if	
      (setq flag_izdelie (+ 1 flag_izdelie))
      ?????
      );_end of while

Здесь используются функция от VVA speckg (найти ее можно тут), в которой правда itog стал глобальной переменной, и функция get-text-string-by-ent с поста 623.
Не могу определится со строкой с вопросами. Как выяснить нажал ли пользователь enter, и в зависимости от этого назначить “get_nil” nil ?

[VVA]

Ф-ция get-text-string-by-ent в случае нажатия enter или выбора примитива, у которого нет свойства Textstring вернет nil

Код:

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

(setq flag_izdelie 0)
      (setq get_nil t)

      (while (setq izdelie (get-text-string-by-ent))
       (speckg "5D")
      (setq itog_Izdelie (list izdelie itog))
      (if (= 0 flag_izdelie)
	(setq itog_Izdelie_all (list itog_Izdelie))
	(setq itog_Izdelie_all (cons itog_Izdelie itog_Izdelie_all))
      );_end of  if	
      (setq flag_izdelie (+ 1 flag_izdelie))
      );_end of while

[Red Nova]

Спасибо. Теперь я подошел к самой сложной для меня части создания кода для ведомости расхода стали.
В результате описанных выше преобразований я могу получить к примеру такой список.

Код:

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

((Изд 1 (Арматура АI (ГОСТ 5781-82 (Арматура d= 6 4.44) (Арматура d= 8 7.9)))) 
 (Изд 2 (Арматура АI (ГОСТ 5781-82 (Арматура d= 8 7.9))) (Арматура АIII (ГОСТ 5781-82 (Арматура d= 8 7.9)))) 
 (Изд 3 (Прокат ВСТ3КП2 (ГОСТ 19903-74 (Лист 8 3.14) (Лист 10 39.25)))))

Если представить его в виде концепции списка, то получится

Код:

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

((“Изделие” (“Вид изделия” (“ГОСТ” (“Параметр изделия” “Вес”))) (….)(….))

Для дальнейших действий мне нужно привести списки для всех изделий к одному виду.
Изделие-1 содержит только один вид изделия - Арматура АI
Изделие-2 содержит два вида изделия - Арматура АI и Арматура АIII
Изделие-1 содержит один вид изделия - Прокат ВСТ3КП2
Во первых нужно для каждого изделия проверить какие типы изделий есть в остальных изделиях и не хватают в нем, и добавить недостающие списки в его список. Затем спустится ниже уровнем и проверить наличие в других списках ГОСТов и вставить недостающие. Затем сделать тоже для каждого параметра изделия, а “вес” для них будет “0”. Думаю объяснение весьма хаотичное. Для большей ясности приведу пример того во что список должен преобразоваться.

Код:

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

((Изд 1 (Арматура АI (ГОСТ 5781-82 (Арматура d= 6 4.44) (Арматура d= 8 7.9))) (Арматура АIII (ГОСТ 5781-82 (Арматура d= 8 0))) (Прокат ВСТ3КП2 (ГОСТ 19903-74 (Лист 8 0) (Лист 10 0)))) 
 (Изд 2 (Арматура АI (ГОСТ 5781-82 (Арматура d= 6 0) (Арматура d= 8 7.9))) (Арматура АIII (ГОСТ 5781-82 (Арматура d= 8 7.9))) (Прокат ВСТ3КП2 (ГОСТ 19903-74 (Лист 8 0) (Лист 10 0)))) 
 (Изд 3 (Арматура АI (ГОСТ 5781-82 (Арматура d= 6 0) (Арматура d= 8 0))) (Арматура АIII (ГОСТ 5781-82 (Арматура d= 8 0))) (Прокат ВСТ3КП2 (ГОСТ 19903-74 (Лист 8 3.14) (Лист 10 39.25)))))

Как реализовать это не имею представления.

Добавлено
Хотя нет. Представление о возможном пути решения похоже появилось, но на столько сложное, что может лучше бы эта идея ко мне не приходила.
Поскольку важно учесть и очередность профилей, то нужно будет создать эталонный список, в котором будут все профили (а для каждого профиля все возможные толщины, диаметры или номера). Учитывая то, сколько одних только болтов dextron забил в prokat.ves, то эталонный список будет весьма длинный.
Затем нужно создать пустой список СИП (список использованных профилей)
Потом берем первый профиль эталонного списка и ищем нет ли такого профиля в исходном списке, если есть то добавляем в СИП этот профиль, потом просматриваем каждый диаметр для этого профиля, и находя хоть один, добавляем его в СИП, в результате для приведенного выше списка СИП получится такой

Код:

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

((Арматура АI (ГОСТ 5781-82 (Арматура d= 6) (Арматура d= 8))) (Арматура АIII (ГОСТ 5781-82 (Арматура d= 8))) (Прокат ВСТ3КП2 (ГОСТ 19903-74 (Лист 8) (Лист 10)))

Далее нужно пройтись по исходному списку еще раз, и сравнивать его уже с СИП-ом, добавляя по ходу в него недостающие элементы.
Если других мыслей нету, то буду делать так.

Возник вопрос. Требуется в зависимости от некого counter-а вернуть N-ный элемент списка, причем N = counter, как это сделать?

[Aminka]

Привет вам с кисточкой от чайника) Есть задачка - вставить в чертеж уже существующий блок и присвоить его аттрибутиву некоторое число. Видела на форуме примеры программок, выполняющих подобное, но с применением LISP - объектно-ориентированного. Каким образом можно выполнить эту задачку, работая с блоками, как со списками?

[Кулик Алексей aka kpblc]

Aminka, а если по-русски? Работая с блоками, как со списками, но без программирования??
Red Nova, я так подозреваю, что тебе последняя задача нужна для заполнения таблицы, верно?

[VVA]

Red Nova,

Возник вопрос. Требуется в зависимости от некого counter-а вернуть N-ный элемент списка, причем N = counter, как это сделать?

Код:

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

(nth 2 '(0 1 2 3 4)) ;;Отсчет начинается с 0

[Aminka]

Кулик Алексей aka kpblcа если по-русски? Работая с блоками, как со списками, но без программирования??

без программирования я себе это с трудом представляю. Если я правильно понимаю, в автолиспе возможно работать тремя способами: 1. использованием функции command для создания и редактирования объектов 2.с помощью функций entmake и entmod, передавая в них списки со значениями dxf-кодов объектов. 3. с помощью AktivX. Меня интересует второй метод - каким образом вставить в чертеж блок, который уже присутствует в списке блоков данного чертежа, присвоив тестовому аттрибуту этого блока некоторое значение.

[Кулик Алексей aka kpblc]

http://forum.dwg.ru/showthread.php?t=11905 ?

[Red Nova]

VVA,
Спасибо, то что надо.
Кулик Алексей aka kpblc, Нет, нужно мне было это для сравнения двух списков, в недаконченном варианте это похоже на

Код:

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

(defun ved_metal (/)
; Проверяем число изделий, и если оно больше чем 1, то преобразуем список
(setq etalon (list
'("Арматура АI" ("ГОСТ 5781-82" ("Арматура d= 3" "Арматура d= 4" "Арматура d= 5" "Арматура d= 6"
		   "Арматура d= 8" "Арматура d= 10" "Арматура d= 12" "Арматура d= 14" "Арматура d= 16"
		   "Арматура d= 18" "Арматура d= 20" "Арматура d= 25" "Арматура d= 28" "Арматура d= 32"
		   "Арматура d= 36" "Арматура d= 40" "Арматура d= 45" "Арматура d= 50" "Арматура d= 55"
		   "Арматура d= 60" "Арматура d= 70" "Арматура d= 80")))

'("Арматура АIII" ("ГОСТ 5781-82" (("Арматура d= 3") ("Арматура d= 4") ("Арматура d= 5") ("Арматура d= 6")
		   ("Арматура d= 8") ("Арматура d= 10") ("Арматура d= 12") ("Арматура d= 14") ("Арматура d= 16")
		   ("Арматура d= 18") ("Арматура d= 20") ("Арматура d= 25") ("Арматура d= 28") ("Арматура d= 32")
		   ("Арматура d= 36") ("Арматура d= 40") ("Арматура d= 45") ("Арматура d= 50") ("Арматура d= 55")
		   ("Арматура d= 60") ("Арматура d= 70") ("Арматура d= 80"))))
       ));_end of setq


  (setq count_etalon 0)
  (setq count_etalon_profil 0)
  (setq list_sip nil)
   (if (> (length itog_Izdelie_all) 1)
    (foreach itog_Izdelie itog_Izdelie_all
	(if
      		(wcmatch (car(car (cdr itog_Izdelie))) (car (nth count_etalon etalon)))
	  	(progn
		(setq count_profil 0)
		(while (nth count_etalon_profil (car (cdr (car (cdr (nth count_etalon etalon))))))
		(progn
		(if 
		  (wcmatch (car (nth count_profil (cdr (car (cdr (car (cdr itog_Izdelie))))))) (nth count_etalon_profil (car (cdr (car (cdr (nth count_etalon etalon)))))))
		  (progn
		  (if list_sip
		  (setq list_sip (cons (car list_sip) (nth count_etalon_profil (car (cdr (car (cdr (nth count_etalon etalon))))))))
		  (setq list_sip (list (nth count_etalon_profil (car (cdr (car (cdr (nth count_etalon etalon))))))))
		     );_end of if
		  (setq count_profil (+ 1 count_profil))
		    );_end of progn
		   );_end of if
		(setq count_etalon_profil (+ 1 count_etalon_profil))
		  );_end of progn
		 );_end of while
	       );_end of progn
		
	);_end of if
      );_end of foreach
    );_end of if
 )

При этом itog_Izdelie_all это что-то типа

Код:

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

((Изделие-1 (Арматура АI (ГОСТ 5781-82 (Арматура d= 5 3.08) (Арматура d= 6 4.44))))
 (Изделие-2 (Арматура АIII (ГОСТ 5781-82 (Арматура d= 8 7.9)))))

All Какая разница между списками с точкой между элементов и без?
("A" "B") и ("A" . "B")

[Кулик Алексей aka kpblc]

Red Nova, если честно, то я давно уже потерял общую нить рассуждений и способен отвечать (в лучшем случае) только на последний вопрос. Если хочешь разобраться с кодом "сравнения двух списков", то можно приложить файл, откуда твой обрабатываемый список получен; код, которым ты его получаешь; и результат выполнения. Тогда можно было бы поковыряться (кстати, про версию када не забудь - это так, на всякий случай ).
Лично я, например, вижу не самую оптимальную организацию списка как etalon, так и itog_izdelie_all. А отсюда и все остальное пляшет бог знает как.

[Red Nova]

и способен отвечать (в лучшем случае) только на последний вопрос

Но так и не ответил

Лично я, например, вижу не самую оптимальную организацию списка как etalon, так и itog_izdelie_all.

itog_izdelie_all трогать нельзя, так как он повязан с лиспом от VVA spec5d, а он по размерам напоминает "Войну и мир".

Если хочешь разобраться с кодом "сравнения двух списков", то можно приложить файл, откуда твой обрабатываемый список получен; код, которым ты его получаешь; и результат выполнения. Тогда можно было бы поковыряться .

Разработка дома, но в любом случае лучше исходить из того что уже имеем itog_izdelie_all, а дальше думать как лучше.

давно уже потерял общую нить рассуждений

Все есть в #629.

[Кулик Алексей aka kpblc]

А чего, все архиваторы сразу сказали "ква"? Хором?
Кстати, в #629, думаешь, что-то более понятно, чем в #637? Лично мне - нет
P.S. Разницу между списком и точечной парой я понимать понимаю, но объяснить не могу

[Red Nova]

А чего, все архиваторы сразу сказали "ква"? Хором?

Ничего не понял.

Кстати, в #629, думаешь, что-то более понятно, чем в #637? Лично мне - нет

Мда, выдастся свободное время попытаюсь по лучше объяснить.

P.S. Разницу между списком и точечной парой я понимать понимаю, но объяснить не могу

Я имел в виду влеяет ли наличае точки на возможные дальнейшие операции со списком?

[Кулик Алексей aka kpblc]

Ну вот, как пример:

Код:

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

_$ (setq lst1 '("A" "B") lst2 '("A" . "B"))
("A" . "B")
_$ (car lst1)
"A"
_$ (car lst2)
"A"
_$ (cdr lst1)
("B")
_$ (cdr lst2)
"B"
_$ (cadr lst1)
"B"
_$ (cadr lst2)
_1$ 
; quit after error

[Aminka]

Привет еще раз. Есть код программки для рисования блоков с тексотвыми атрибутами, значения которых считывается из файла. Блоки уже определены в текущем чертеже. Однако, не могу справиться с двумя проблемами: 1. блоки вставляются посредством (command "insert"...), но тока вставки блока на чертеж после отработки программки не соответствует задаваемой в программе. 2. На чертеже не отображается текст.
Господа гуру, объянсите, пожалуйста, что не так и как это можно исправить? Сразу оговорюсь, что это мой первый опыт знакомства с автолиспом и в дебри объектного автолиспа еще не влезала.

[VVA]

Aminka, Непонятен принцип формирования схем и отсутсвует текстовый файлик, поэтому чтение из файла закоментировал, недостающие переменные проинициалировал, ошибки выделил

Код:

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

(defun c:stpoj04 (/ Nizv i inc);в скобках указаны пременные
   (setq temp "y")  ;temp="y"-строковая переменная(да,Yes)
   (setq fname nil fileh nil) ;обнуляет две переменные
;;;!!!   (princ "\nВыберите файл с данными")
;;;!!!   (setq fname (getfiled "Output filename" "" "txt" 0));(getfiled "строка-запрос""путь" "расширение" "режим")Взятие имени файла
;;;!!!   (setq fileh (open fname "r"))
   (setq Nizv nil)
   (setq inc nil)
   (setq point nil)
   (setq point0 nil)
   (setq pointstart nil)
   (setq dpoint nil)
   (setq i nil)
   (setq j nil)
   (setq Nryad nil)
   (setq Npom nil)
   (setq Ndatch nil)
   (setq datch nil)
   (setq pppp nil)
 
   (setq j 1)
   (setq i 1)
   (setq dlx 1000)
   (setq dly 2000)
   (setq dlbl 600)
   (setq pppp (/ dlbl 2))
;;;!!!   (setq Nizv (atoi(read-line fileh)))
(setq Nizv 5)  ;;;!!! Просто проинициализировать
   (setq Nryad (atoi(getstring "\nВведите количество датчиков в ряду  ")
		    ))
  (if (>= Nryad Nizv) (setq Nryad Nizv))
   (setq pointstart (getpoint "Выберите начальную точку схемы "))
   (setq point0 pointstart)  
   (setq point (list (+ dlx (car point0)) (cadr point0)))
  
  (setq flag1 T)
  (while (<= i Nizv)
     (setq j 1)
          (while (<= j (+ Nryad 1))
            (entmake
             (list	;; формируем ассоциированный список
	      '(0 . "LWPOLYLINE");; Тип примитива
	      '(100 . "AcDbEntity");; Маркер подкласса
              '(100 . "AcDbPolyline");; Маркер подкласса
	      '(90 . 2)	;; Количество вершин
              '(43 . 0.3);; Толщина
	       (cons 10 point0);; Точка вершины 1
	       (cons 10 point);; Точка вершины 2
	     ) ;_ end of list
            ) ;_ end of entmake
                

          (if (<= j Nryad)
	  (progn  
;;; !!!!         (setq datch (read-line fileh))
;;;  !!!	  (setq Npom (read-line fileh))
(setq datch "ручник");;;!!! Просто проинициализировать	    
(setq Npom "Npom");;;!!! Просто проинициализировать	    
	(setq dpoint nil)
	(setq dpoint (list (+ 300 (car point)) (cadr point)))	  
	(setq p0 (list (- (car dpoint) 400) (- (cadr dpoint) 800)))
	(entmakex (list
		   '(0 . "TEXT")
		   '(100 . "AcDbEntity")
		   '(100 . "AcDbMText")
		   '(40 . 250.0)
                   (cons 41 0.6)
                   '(7 . "StandarD") ;_ Вопрос 2
		   '(71 . 5)
		   (cons 10 p0)
		   (cons 1 (strcat "пом." Npom))
		   )
		 )
	  	  
;;; !!!!	  (setq Ndatch (read-line fileh))
(setq Ndatch "555");;;!!! Просто проинициализировать
	  (setq dpoint nil)
	  (setq dpoint (list (+ 300 (car point)) (cadr point)))
	  
	  (command "_-INSERT" datch "_non" dpoint "" "" "")
          (command Ndatch)

	    (setq p1 (list (- (car dpoint) 400) (- (cadr dpoint) 350)))
	    (setq p2 (list (- (car dpoint) 400) (- (cadr dpoint) 500)))
	    (setq p3 (list (+ (car dpoint) 400) (- (cadr dpoint) 500)))
	    (setq p4 (list (+ (car dpoint) 400) (- (cadr dpoint) 250)))
	  
            (entmake
             (list	;; формируем ассоциированный список
	      '(0 . "LWPOLYLINE");; Тип примитива
	      '(100 . "AcDbEntity");; Маркер подкласса
              '(100 . "AcDbPolyline");; Маркер подкласса
	      '(90 . 4)	;; Количество вершин
              '(43 . 0.1);; Толщина
	       (cons 10 p1);; Точка вершины 1
	       (cons 10 p2);; Точка вершины 2
	       (cons 10 p3)
	       (cons 10 p4)
	      ) ;_ end of list
            ) ;_ end of entmake
	                
	  
	  (setq i (+ i 1))
          );end of progn
	  )  
           (setq j (+ j 1))
	    
	   (setq point0 (list (+ dlbl (car point)) (cadr point0))) 
           (setq point (list (+ dlx (car point0)) (cadr point0)))    
                   	    
           (if (AND (= i (+ Nizv 1)) (= flag1 T))
             (progn
	       (setq j (+ Nryad 1))
               (setq flag1 nil))
	     )  	       
     ) ;end of if while j
      
   (setq point0 (list (car pointstart) (- (cadr point0) dly)))
   (setq point (list (+ dlx (car point0)) (cadr point0))) 
   );end of if while i
(setq Nryad Nryadtmp)
   
);end of defun
(princ)

1. Непонятно зачем в команде INSERT использовалась опция "Base point"
2. Не отключались привязки в INSERT ("_non")
3. Учти что INSERT вставляет блоки в точки ТЕКУЩЕЙ ПСК, а entmake создает полилинии и тексты в точках МСК. Короче если текущая система координат отлична от мировой будут проблемы.

[Red Nova]

Подскажите пожалуйста как добавить элемент в конец списка, а-то я нашел только cons, а им можно только в начало добавить. Или каждый раз нужно реверс списка делать туда-сюда?

[Дима_]

(append )

[Red Nova]

Спасибо.
Не могу справится с одной задачкой. Имею список такого типа

Код:

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

(("Арматура АI" ("ГОСТ 5781-82" ("Арматура d= 6"))) 
("Арматура АIII" ("ГОСТ 5781-82" ("Арматура d= 6" "Арматура d= 8"))))

При этом элементов может быть неограниченное число.
Требуется видоизменить последний элемент и добавить к нему элемент "Арматура d= 10"
То есть в итоге должен получить.

Код:

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

(("Арматура АI" ("ГОСТ 5781-82" ("Арматура d= 6")))
 ("Арматура АIII" ("ГОСТ 5781-82" ("Арматура d= 6" "Арматура d= 8" "Арматура d= 10"))))

Как ни кручу не получается.

[Кулик Алексей aka kpblc]

Если структура списка известна заранее, то многократно вложенный subst тебе поможет. Вкупе с append

[Red Nova]

А можно на конкретном примере с #645?

[Дима_]

Я бы на твоем месте сильно призадумался насчет формта хранения данных, написать рекусривную (вызывающую саму-себя) функцию можно - но ихмо формат поменять более приваильно т.к. с неограниченной вложенностью ошибки будут лезть одна за другой, да и избыточность данных - неимоверная.

[Кулик Алексей aka kpblc]

Дима_, я уже писал #636
Red Nova, код получится практически нечитабельным (да и чертовски неустойчивым), если не применять рекурсию. Оно тебе надо?

[Дима_]

Код:

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

(defun recadd (lst el appel)
(apply 'append (mapcar '(lambda (tmp)
(if (= tmp el) (cons tmp appel) 
(if (= (type tmp) 'list) (list (recadd tmp el appel)) (list tmp)))
);end of lambda 
lst))
);end of recadd

Если тебя предыдущие посты не испугали вот рекусривная функция, добавляет элементы appel после каждого элемента el в любом подсписке списка lst. Но еще раз предупреждаю т.к. избыточность у тебя неимоверная применение ее выглядит весьма сомнительно.

То есть при запуске

Код:

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

(recadd '("Арматура АI" ("ГОСТ 5781-82" ("Арматура d= 6"))) "Арматура 
d= 6" '("Арматура d= 8" "Арматура d= 10"))

мы, как и требовалось получим:

Код:

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

("Арматура АI" ("ГОСТ 5781-82" ("Арматура d= 6" "Арматура d= 8" "Арматура d= 10")))

, но если в этом-же списке встретится и другой гост с аналогичным именем "Арматура d= 6", он тоже будет изменем на d6+d8+d10. Вобщем граблей при таком подходе больше чем кажеться на первый раз, еще раз советую менять структуру хранения данных - пока не поздно.

[Aminka]

VVA спасибо, отключение привязок помогло)). Вопрос - почему при включенных привязках игнорируется точка вставки блока, напрямую задаваемая в INSERT и какая точка используется для вставки? я пробовала перед выполнением INSERT рисовать точку, но к ней блок не "привязывался".

[VVA]

Aminka,

Вопрос - почему при включенных привязках игнорируется точка вставки блока, напрямую задаваемая в INSERT

Она не игнорируется. Это называется Грабли №1(обработка OSMODE) Почитай эту тему с поста эдак #167(можно на страничку раньше начать)

[Red Nova]

Спасибо за советы. Менять структуру хранения данных я буду только в самом тупиковом варианте. Просто уже многое сделано. Я ведь не все вам показываю.
Все таки по моему вы меня неверно поняли.
В списке структура всегда одинаковая.
Список может быть такой

Код:

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

(("Арматура АI" ("ГОСТ 5781-82" ("Арматура d= 6"))) 
("Арматура АIII" ("ГОСТ 5781-82" ("Арматура d= 6" "Арматура d= 8"))))

Или такой

Код:

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

(("Арматура АIII" ("ГОСТ 5781-82" ("Арматура d= 6" "Арматура d= 8")))
)

Но всегда "в глубину" количество подсписков одинаковое.
Так вот требуется Взять из этого списка последний подсписок, это

Код:

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

("Арматура АIII" ("ГОСТ 5781-82" ("Арматура d= 6" "Арматура d= 8")))

Потом добраться до самого глубокого списка, он всегда на одной и той же глубине.

Код:

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

("Арматура d= 6" "Арматура d= 8")

И добавить в него новый элемент. Уверен что этот путь можно пройти без грабель.


Добавлено.
Все, разобрался. Вчера меня заклинило, а сегодня получилось.

Код:

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

		      (setq list_sip
			     	(if (= (length list_sip) 1)
					(list (list (car (car list_sip))
					      (append (list (car (cadr (car list_sip))))
						      (list (append (car (cdr (cadr (car list_sip))))
							(list (nth count_etalon_profil (car (cdr (car (cdr (nth count_etalon etalon))))))))))))
				  
					(append
					  	(reverse (cdr (reverse list_sip)))
						(list (list (car (car (reverse list_sip)))
							(append (list (car (cadr (car (reverse list_sip)))))
								 (list (append (car (cdr (cadr (car (reverse list_sip))))) (list (nth count_etalon_profil (car (cdr (car (cdr (nth count_etalon etalon)))))))))))))
				       );_end of if
			    	);_end os setq

Тут
list_sip
это наш список, а
(nth count_etalon_profil (car (cdr (car (cdr (nth count_etalon etalon))))))
И есть добавляемый элемент.
Как всегда неуклюже, но работает

[Diman111]

Подскажите кодом, пожалуйста .
есть некая программка с использванием немодального OpenDCL диалога - т.е. она всегда висит на экране. программно создаются примитивы - тут все ровно. Загвоздка на этапе объединения их в безымянную группу. ранее применялся код

Код:

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

(VL-CMDF "_.-GROUP" "_C" "*" "бла бла" nabor:prim "")

И все работало. Но то было без OpenDCL окон. сейчас получаю ошибку

Код:

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

; error: invalid AutoCAD command: nil

переменная naborrim содержит набор номер такойто, вида

Код:

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

<Entity name: 7ed4cd10><Entity name: 7ed4cd10><Entity name: 7ed4cd10>

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

[CB]

>Red Nova

Код:

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

(setq lst
       '(("Арматура АI" ("ГОСТ 5781-82" ("Арматура d= 6")))
         ("Арматура АIII"
          ("ГОСТ 5781-82" ("Арматура d= 6" "Арматура d= 8"))
         )
        )
) ;_ end of setq
((lambda (a b)
   (subst
     (list (car a)
           (list (caadr a) (cons b (cadadr a)))
     ) ;_ end of list
     a
     lst
   ) ;_ end of subst
 ) ;_ end of lambda
  (last lst)
  "Арматура d= 10"; добавляемый элемент
)

[VVA]

Red Nova, Особо не проверял, но вроде работает

Код:

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

(defun test (Klass GOST Arm lst / tmp1 tmp2 tmp3)

;;;Если Нет Класса арматуры или ГОСТА, то они создаются
;;;Klass - класс арматуры, сторока вида "Арматура АI"
;;;GOST- ГОСТ арматуры, строка вида "ГОСТ 5781-82"
;;;Arm - сама арматура, строка вида "Арматура d= 12"
;;;lst - список вида
;;;(setq lst
;;;       '(("Арматура АI" ("ГОСТ 5781-82" ("Арматура d= 6")))
;;;         ("Арматура АIII"
;;;          ("ГОСТ 5781-82" ("Арматура d= 6" "Арматура d= 8"))
;;;         )
;;;        )
;;;) ;_ end of setq
;;;Пример 
;;;(setq ret (test "Арматура АIII" "ГОСТ 5781-82" "Арматура d= 10" lst))
;;;(setq ret (test "Арматура АIII" "ГОСТ YYY-YYY" "Арматура d= 12" lst))
;;;(setq ret (test "Арматура А??" "ГОСТ NNN" "Арматура d= 12" lst))

  (if (setq tmp1 (assoc Klass lst))
    (progn
      (if (setq tmp2 (assoc GOST (cdr tmp1)))
	(progn
	  (if (null (assoc arm (cdr tmp2)))
	    (setq tmp3
		   (subst (list GOST (append (cadr tmp2) (list arm)))
			  tmp2
			  (cdr tmp1)
		   )
	    )
	    (setq tmp3 (cdr tmp1))
	  )
	  (setq	lst
		 (subst	(append (list Klass) tmp3)
			(assoc Klass lst)
			lst
		 )
	  )
	)
	(progn
	  (setq tmp1 (append tmp1 (list (list GOST (list arm)))))
	  (setq	lst
		 (subst tmp1 (assoc Klass lst) lst)
	  )
	)
      )
    )
    (setq lst (append lst (list (list Klass (list GOST (list arm))))))

  )
  lst
)

Пример. Если Нет Класса арматуры или ГОСТА, то они создаются

Код:

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

(setq lst
       '(("Арматура АI" ("ГОСТ 5781-82" ("Арматура d= 6"))
	                ("ГОСТ XXX-XX" ("Арматура d= 6"))
	  )
         ("Арматура АIII"
          ("ГОСТ 5781-82" ("Арматура d= 6" "Арматура d= 8"))
	  ("ГОСТ YYY-YYY" ("Арматура d= 6" "Арматура d= 8"))
         )
	 
        )
) ;_ end of setq
;;;Добавляем d10
(setq ret (test "Арматура АIII" "ГОСТ 5781-82" "Арматура d= 10" lst))
;;;Добавляем d12
(setq ret (test "Арматура АIII" "ГОСТ YYY-YYY" "Арматура d= 12" lst))
(setq ret (test "Арматура А??" "ГОСТ NNN" "Арматура d= 12" lst))

[Кулик Алексей aka kpblc]

Diman111, попробуй найти код по очистке групп и сделай группировку некомандными методами (там на самом деле достаточно просто, насколько мне помнится)
P.S. С OpenDCL лично я не работал

[Diman111]

Кулик Алексей aka kpblc, Вот пример создания группы программным методом я бы с удовольствием посмотрел.
Если у кого в закромах найдется - поделитесь, пожалуйста.

[Кулик Алексей aka kpblc]

Как вариант, написано "на коленке" с минимумом проверок:

Код:

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

(defun create-group-by-selset (selset name / adoc groups new_group lst_groups _kpblc-conv-vla-to-list)

                              ;|
	selset	набор примитивов
	name	имя группы. Если такая группа уже есть, то выполнение прекращается
		nil недопустим. Имя со звездочкой ("*") недопустимо
|;

  (defun _kpblc-conv-vla-to-list (value / res)
                                 ;|
*    Преобразовывает vlax-variant или vlax-safearray в список.
|;
    (cond
      ((listp value)
       (mapcar '_kpblc-conv-vla-to-list value)
       )
      ((= (type value) 'variant)
       (_kpblc-conv-vla-to-list (vlax-variant-value value))
       )
      ((= (type value) 'safearray)
       (if (>= (vlax-safearray-get-u-bound value 1) 0)
         (_kpblc-conv-vla-to-list (vlax-safearray->list value))
         ) ;_ end of if
       )
      ((and (= (type value) 'vla-object)
            (vlax-property-available-p value 'count)
            ) ;_ end of and
       (vlax-for sub value
         (setq res (cons sub res))
         ) ;_ end of vlax-for
       )
      (t value)
      ) ;_ end of cond
    ) ;_ end of defun

  (vl-load-com)

  (setq adoc       (vla-get-activedocument (vlax-get-acad-object))
        groups     (vla-get-groups adoc)
        lst_groups (_kpblc-conv-vla-to-list groups)
        ) ;_ end of setq
  (if (not (setq new_group (vl-remove-if-not
                             (function
                               (lambda (x)
                                 (= (strcase (vla-get-name x)) (strcase name))
                                 ) ;_ end of lambda
                               ) ;_ end of function
                             lst_groups
                             ) ;_ end of vl-remove-if-not
                 ) ;_ end of setq
           ) ;_ end of not
    (progn
      (vla-startundomark adoc)
      (vl-catch-all-apply
        (function
          (lambda ()
            (vlax-invoke-method
              (setq new_group (vla-add groups name))
              'appenditems
              (vlax-make-variant
                (vlax-safearray-fill
                  (vlax-make-safearray
                    vlax-vbobject
                    (cons 0 (1- (sslength selset)))
                    ) ;_ end of vlax-make-safearray
                  (mapcar (function vlax-ename->vla-object)
                          ((lambda (/ tab item)
                             (repeat (setq tab  nil
                                           item (sslength selset)
                                           ) ;_ end setq
                               (setq tab (cons (ssname selset (setq item (1- item))) tab))
                               ) ;_ end repeat
                             tab
                             ) ;_ end of lambda
                           )
                          ) ;_ end of mapcar
                  ) ;_ end of vlax-safearray-fill
                ) ;_ end of vlax-make-variant
              ) ;_ end of vlax-invoke-method
            ) ;_ end of lambda
          ) ;_ end of function
        ) ;_ end of vl-catch-all-apply
      (vla-endundomark adoc)
      ) ;_ end of progn
    ) ;_ end of if
  new_group
  ) ;_ end of defun

[VVA]

Diman111, Про группы еще здесь

[Makswell]

Ещё вопрос от чайника. Почему не работает (command "_VLIDE") ?

Команда: (command "_VLIDE") _VLIDE Неизвестная команда "VLIDE". Для вызова справки нажмите F1. Команда: nil

[VVA]

Makswell, Через command вызываются стандартные команды, остальные как функции с префиксом C:
Пример:
(C:VLIDE)
(C:КАЛЬК)

[Makswell]

Ага. Понятно. Спасибо за ответ.

[acyxou]

Ребят, срочно надо, а времени изучать нет... подскажите, пожалуйста, как в лиспе извлечь выражение только если несколько условий выполняются. С помощью какой функции?
Мне, например, нужно подгрузить пользовательское меню только в том случае, если оно не подгружено (not (menugroup "Bla-bla")) и если cui-файл с заданным именем находится в путях поиска support files (findfile "Bla-bla.cui").

И еще попутный вопрос: сделал redefine сомманды _qsave так, чтоб сначала выполнялся сброс масштабов (-scalelistedit), а затем уже .qsave. Так вот, се работает прекрасно если чертеж не новый. Т.е. если создать новый чертеж и воспользоваться этой коммандой чтоб впервые его сохранить и присвоить ему имя, то чертеж не сохраняется, точнее переменная Filedia слетает в ноль и просит вручную прописать путь и имя файла. Что с этим делать, никто не знает?

[Makswell]

Сообщение от acyxou Ребят, срочно надо, а времени изучать нет... подскажите, пожалуйста, как в лиспе извлечь выражение только если несколько условий выполняются. С помощью какой функции? Мне, например, нужно подгрузить пользовательское меню только в том случае, если оно не подгружено (not (menugroup "Bla-bla")) и если cui-файл с заданным именем находится в путях поиска support files (findfile "Bla-bla.cui").

Код:

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

(and (not (menugroup "Bla-bla")) (findfile "Bla-bla.cui"))

[acyxou]

Makswell спасибо! Работает!!! А то я уже и while и cond и if перепробовал в разных связках... хотя понимал, что нужно and юзать, но в каком ключе не догадывался... Спасибо еще раз!

[Red Nova]

Наконец то на работе смягчился “каторжный режим” и есть чуток времени чтоб продолжить изучение лиспа. Продолжаю писать код для создания ведомости расхода стали при применении SPEC5D от VVA. Застрял на элементарном с первого взгляда вопросе.
Имею лист такого рода.

Код:

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

(((Арматура АII (ГОСТ 5781-82 (Арматура d= 3 1.1) (Арматура d= 4 1.98))) 
(Арматура АI (ГОСТ 5781-82 (Арматура d= 3 1.1) (Арматура d= 4 1.98)))) 
((Арматура АIII (ГОСТ 5781-82 (Арматура d= 5 3.08)))))

Элементов в каждых из красных скобок может быть сколько угодно, да и красных скобок тоже.
Требуется убрать красные скобки, чтобы лист стал таким

Код:

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

((Арматура АII (ГОСТ 5781-82 (Арматура d= 3 1.1) (Арматура d= 4 1.98))) 
(Арматура АI (ГОСТ 5781-82 (Арматура d= 3 1.1) (Арматура d= 4 1.98))) 
(Арматура АIII (ГОСТ 5781-82 (Арматура d= 5 3.08))))

Подскажите пожалуйста как.
Ясно что нужно оперировать mapcar, но я не знаю как вернуть содержимое листа без скобок. То есть не знаю как имея это

Код:

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

((Арматура АII (ГОСТ 5781-82 (Арматура d= 3 1.1) (Арматура d= 4 1.98))) 
(Арматура АI (ГОСТ 5781-82 (Арматура d= 3 1.1) (Арматура d= 4 1.98)))) 

Вернуть в функции это

Код:

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

(Арматура АII (ГОСТ 5781-82 (Арматура d= 3 1.1) (Арматура d= 4 1.98))) 
(Арматура АI (ГОСТ 5781-82 (Арматура d= 3 1.1) (Арматура d= 4 1.98)))

Заранее спасибо.

[Кулик Алексей aka kpblc]

Это так?

Код:

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

(apply 'append
       '(
         (
          ("Арматура АII" ("ГОСТ 5781-82" ("Арматура d=" 3 1.1) ("Арматура d=" 4 1.98)))
          ("Арматура АI" ("ГОСТ 5781-82" ("Арматура d=" 3 1.1) ("Арматура d=" 4 1.98)))
          )
         (
          ("Арматура АIII" ("ГОСТ 5781-82" ("Арматура d=" 5 3.08)))
          )
         )
       ) ;_ end of apply

Ты бы хоть выделял строки в кавычки, что ли

[Sleekka]

Имею лист такого рода.

Да и пиши либо список либо list а то мой мозг чуть не с фаталил...

[Red Nova]

Кулик Алексей aka kpblc, Спасибо, именно то.

[Eximius]

Подскажите где взять информацию по тегам (как это правильно называется не знаю может и не теги) у примитива mtext.
Пример: создаю mtext не пргограмно с текстом ω в степени 3, далее (entget (entlast)) и вот что мне возвращается

Код:

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

(.......................
(1 . "\\A1;{\\H0.875x;ω\\H0.7x;\\S3^;}") ....................)

Символ можно заменить в visual lisp на его код вот так \U+03C9.
\\H0.7x;\\S - это как я понял тег для индексов, дробей и прочего, создаваемого кнопкой stack.
Где взять полный список вот таких тегов (или не тегов)?

[VVA]

http://forum.dwg.ru/showthread.php?t=12717
http://docs.autodesk.com/ACD/2010/EN...mber=d0e123454
В справке раньше (по моему в 2004) была прямо таблица. В 2008 быстро не нашел

[Eximius]

Благодарю, VVA.
А возможно ли создать индекс у индекса или индекс у числа, стоящего в числителе или знаменателе такой дроби \S../..; ?

[alex8888]

Подскажите пожалуйста, как программно команде Offset показать, что новый контур нужно выполнить внутри фигуры?

(command _offset "10" object <здесь требуется указать направление вставки> "_e")

[ShaggyDoc]

Сообщение от alex8888 Подскажите пожалуйста, как программно команде Offset показать, что новый контур нужно выполнить внутри фигуры? (command _offset "10" object <здесь требуется указать направление вставки> "_e")

Выражаться надо терминами, а то "объект", "контур", "фигура" не способствуют пониманию.

Примерно так - для примитива:

Код:

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

(vl-cmdf
         "_.OFFSET"
         dist ;;Расстояние - число
         (list примитив точка_на примитиве_в_ПСК)
         точка_в_направлении_смещения ;; высчитать предварительно
         ""
)

Или вот так - объектным методом

Код:

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

(defun ru-obj-ent-offset (some dist)
 ;|
Аргументы:
some - примитив или объект
dist - величина смещения, при смещении отрицательном - влево, при положительном - вправо от направления линии

Возвращает Variant (array of objects) - созданных новых объектов.
|;
  (ru-error-catch
    (function
      (lambda ()
        (cond
          ((= 'vla-object (type some))
           (vla-offset some dist)
          )
          ((= 'ename (type some))
           (vla-offset (vlax-ename->vla-object some) dist)
          )
        ) ;_ end of cond
      ) ;_ end of lambda
    ) ;_ end of function
    (function (lambda (msg)
                (princ (strcat "\nRU-OBJ-ENT-OFFSET: " msg))
                nil
              ) ;_ end of lambda
    ) ;_ end of function
  ) ;_ end of ru-error-catch

)

[alex8888]

ShaggyDoc, большое спасибо за помощь. Тогда у меня вопрос конкретно по моему лиспу

Имеею: (фунцкцию error пока не задействовал)

(defun clate (/ *error* oldosm oldlay pl_1 pl_2)
;******* funktion error
(defun *error*(msg)
(princ msg) ;text bei error
(if oldosm (setvar "OSMODE" oldosm)) ;if oldosm - zadano -> oldosm=oldosm
(if oldalay (setvar "CLAYER" oldlay));if layer gewechselt -> zurück
); end of *error*
;***************

(initget 7)
(setq pl_L (getreal "\nLänge: ")) ;get Länge (длина рамки)
(initget 7)
(setq pl_B (getreal "\nBreite: ")) ;get Breite (ширина рамки)

(setq pl_1 (getpoint "\nInput Start Point: ")) (начальная точка)

(setq pl_2 (list (+ (car pl_1) pl_L)(+ (cadr pl_1) pl_B))) ;upper right point (верхний правый угол)
(setq pl_o (list (+ (car pl_1) 10.0)(+ (cadr pl_1) 10.0))) ;lower left point für offset (точка для оффсета)

(setq pl_rahmen (ssadd)) ; задание пустого набора

(command "_.rectangle" pl_1 pl_2 "") ; вырисовка прямоугольной рамки
(ssadd (entlast) pl_rahmen) ; добавление рамки в набор
(command "_.chprop" "_last" "" "_layer" "SF-RAHMEN" "_c" "_bylayer" "") ; смена цвета и уровня
(command "_.offset" "-t" pl_rahmen pl_o "_e") ; а вот здесь засада - никак не дойду как , надо просто отрисовать прямоугольник (пока) внутри моего уже нарисованного

(princ)


);end defun

пробовал также так:
(command "_offset" "10" pl_rahmen "1" ""), но как указать направление?

С уважением, Александр

[ShaggyDoc]

alex8888, ну зачем так-то, "молекулы на атомы" разлагать, а потом снова их синтезировать:
(setq pl_2 (list (+ (car pl_1) pl_L)(+ (cadr pl_1) pl_B)))

Используй функцию polar, и все проблемы пропадут, например

Код:

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

(setq pl_2 (polar pl_1 0 pl_L))

Не рисуй прямоугольники командой RECTANGLE - она не для программистов. Всё равно создается полилиния, вот и используй PLINE - точки можно какие угодно задавать. Точки высчитаешь функцией polar. Ей же высчитаешь любую точку, в том числе внутри контура. И внимательно читай тему - про отключение объектных привязок.

[VVA]

alex8888,
1. Не обрабатываешь привязку (грабли №1)
2. В команде _rectangle лишняя ""
3. Нет необходимости создавать набор
4. Команде OFFSET нужно передавать список такой же, какой возвращает (entsel), т.е. (имя_примитива точка_выбора)
5. Середина диагонали прямоугольника всегда лежит внутри этого прямоугольника

Код:

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

(command "_.rectangle"
 "_non"        ;;; см. №1
pl_1 
"_non"          ;;; см. №1
 pl_2
                  ;;; см. №2
) ; вырисовка прямоугольной рамки
(command "_.chprop" "_last" "" "_layer" "SF-RAHMEN" "_c" "_bylayer" "") ; смена цвета и уровня
(command "_.offset" 10
	 (list (entlast) pl_1)  ;;; см. №4
	 "_non"                   ;;; см. №1
	 (polar pl_1              ;;; см. №5
		(angle pl_1  pl_2)
		(* 0.5 (distance pl_1 pl_2)))
	 ""
	 )

[alex8888]

ShaggyDoc,

я пытался использовать _.pline, но без polar (что то его не совсем понял), бывает путаюсь в углах. И вот там нужно сперва каждую точку высчитать, а _rectangle только двумя, вот бес и попутал ее взять.
А чем плоха команда _rectangle для программистов? И можно ли использовать команды из механикла (типа AMRECT.... тыры-пыры)?
2. Отключение объектных привязок - сохранение-сбрасывание в 0 и восстановление "osmode" достаточно? Или еще какая переменная важна?

Участок кода отрисовки, так?

(setq pl_1 (getpoint "\nInput Start Point: "))

(setq pl_2 (polar pl_1 0 pl_L))
(setq pl_3 (polar pl_2 (/ pi 2) pl_B))
(setq pl_4 (polar pl_3 pi pl_L))

(command "_.pline" pl_1 pl_2 pl_3 pl_4 "_c" "")


VVA,
спасибо.
Именно про синтаксис offset я и пытался выяснить. Тяжело изучать Lisp работая в немецкой версии Autocad Mechanical (2009-2010), книжки на русском, помощь по лиспу на английском, команды все тоже надо с немецкого переводить. В справке ничего нет, там только типа выбрать мышкой и ткнуть туда то. Все опции приходится искать методом тыка.

Что касается отступа для offset, то я его попытался прописать так:

(setq pl_o (polar pl_1 (/ pi 4) (* 10 (sqrt 2.0))))
(vl-cmdf "_.offset" 10 pl_rahmen pl_o "")

Как ни странно, сработало. Может з переляху?

[ShaggyDoc]

alex8888, polar одна из самых необходимых функций. Синтаксис простой:
(polar известная_точка угол_в_радианах расстояние)
Возвращает точку, расположенную на расстояние от известная_точка по направлению угол_в_радианах.

RECTANG - это команда-обертка (так же как и POLYGON, DONUT). Она создает полилинию, причем опции этой команды уже менялись неоднократно. Используя RECTANG можешь рисовать только прямоугольник, и только в ПСК. Это частные случаи. А может быть и "кривоугольник" и различные контуры. И под разными углами поворота. Учиться надо сразу правильно.

Даже для прямоугольника координаты всех точек через polar высчитать проще, чем одной противоположной точки добавлением ординат.

[alex8888]

ShaggyDoc,
спасибо за ответ.

1. Ну а с механикловскими командами (начинаются с AM...) имеет смысл программировать? Или там тоже такие же "обертки"?
2. Можно ли при вводе запрашиваемого числа ввести буквенный символ, чтобы произошло ветвление программы, типа если вместо числа пользователь нажал "S" (например), то программа запросила бы ввести дополнительное число?

Примерно так:

(initget 1 "S")
(setq p1 (getpoint "\nВведите точку или [Stuffe]:"))

(if (= p1 "S")
(setq p2 (getpoint "\nВведите точку 2"))

); end if

;далее тело основной функции

[Кулик Алексей aka kpblc]

1. Сугубо ИМХО: команды вертикальных решений дрессировке поддаются весьма слабо.
2. См. ключи initget (конкретнее - биты).

[ShaggyDoc]

alex8888, вряд ли стоит связываться с вертикальными решениями. Там многое зависит от того, как "оформлена" команда. Там ведь не только свои дополнительные команды, но и свои объекты, отсутствующие в AutoCAD создаются.

Если у этой системы есть документированный интерфейс для программирования, тогда можно попробовать. Однако не изучив общих азов это заведомо бесполезно.

[alex8888]

ShaggyDoc, Кулик Алексей aka kpblc,
спасибо за объяснение.

В целом же чистый астокад и механикал сильно отличаются в плане программирования? Например, программы из ветки http://forum.dwg.ru/showthread.php?t=5887&page=4 по отрисовке объемных тел ни одна не пошла. Ошибки пишет разные. В основном, не нравятся какие-нибудь команды, например, _.view. Если введу _.-view, то проходит выполнение дальше, но при этом требует ввода локализованных параметров, английские берет, но определять их вслепую надо (подсказки нет).

Как можно "заставить" lisp-программу выполнить команду, записанную в другом лисп-файле? Не хочу изобретать велосипед, если есть возможность воспользоваться уже готовыми библиотеками из Ру-када, да и самому тоже хотелось бы немного пооптимизировать и не набирать в каждой программе один и тот же текст. Мысль подгружать их все при загрузке автокада не проходит - в Ру-каде слишком много функций, да и не известно на 100%, что понадобится.

[Кулик Алексей aka kpblc]

По стандартным командам: вообще-то они все должны работать. По "заставить выполнить другой lisp" - а что там сложного? Загрузить оба лиспа, и в первом вызывать функцию, определенную во втором. Ничего сложного...
P.S. Эта технология в книге "САПР на базе..." описана очень подробно, насколько я помню.
P.P.S. Сейчас уже всерьез задумываюсь о написании лиспа, который будет выдавать всю "подноготную" какой-либо lisp-функции...

[alex8888]

Эта технология в книге "САПР на базе..." описана очень подробно, насколько я помню

Изучаю потихоньку, пока наверное до этого пункта не дошел, а так очень полезная книга. Правда приходится все лиспы переделывать - ну не принимает мой кад русский язык, хоть тресни - в лучшем случае иероглифы, в худшем одни знаки вопроса. В винде поддержка русского стоит, все остальное читается нормально, а в каде - никак

Сейчас уже всерьез задумываюсь о написании лиспа, который будет выдавать всю "подноготную" какой-либо lisp-функции

Если такое случится, то я, наверное, буду самым счастливым человеком , потому как тяжко вспоминать то, что не знаешь.

Загрузить оба лиспа, и в первом вызывать функцию, определенную во втором

А если этих лиспов не два, а сотни две? Есть способ, автоматически загружаемый нужный лисп, если в выполняемом встречается функция из него? Или как то прописать?

Прошу прощения за назойливость

[Кулик Алексей aka kpblc]

Способ есть. В "Готовых программах" посмотри - там был вариант загрузки всех приложений из указанного каталога.
P.S. Насчет "подноготной"... Тот вариант, который я задумал, недостаточно универсальный - некоторые ограничения накладываются (в частности, к именам функций, которые надо отслеживать).

[VVA]

В винде поддержка русского стоит, все остальное читается нормально, а в каде - никак

Попробуй поменять номера кодовых страниц

REGEDIT4 [HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Nls\CodePage] "1250"="c_1251.nls" "1251"="c_1251.nls" "1252"="c_1251.nls" "1253"="c_1251.nls" "1254"="c_1251.nls" "1255"="c_1251.nls" "437"="c_866.nls" [HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\FontSubstitutes] "Arial,0"="Arial,204" "Arial Cyr,0"="Arial,204" "Comic Sans MS,0"="Comic Sans MS,204" "Courier,0"="Courier New,204" "Courier,204"="Courier New,204" "Courier New Cyr,0"="Courier New,204" "Fixedsys,0"="Fixedsys,204" "Helv,0"="MS Sans Serif,204" "MS Sans Serif,0"="MS Sans Serif,204" "MS Serif,0"="MS Serif,204" "Small Fonts,0"="Small Fonts,204" "Tahoma,0"="Tahoma,204" "Times New Roman,0"="Times New Roman,204" "Times New Roman Cyr,0"="Times New Roman,204" "Tms Rmn,0"="MS Serif,204" "Verdana,0"="Verdana,204" "Arial CE,238"="Arial,204" "Arial CYR,204"="Arial,204" "Courier New CE,238"="Courier New,204" "Courier New CYR,204"="Courier New,204" "Times New Roman CE,238"="Times New Roman,204" "Times New Roman CYR,204"="Times New Roman,204" "Times New Roman Cyr,0"="Times New Roman,204" "System,0"="System,204" "Fixedsys,0"="Fixedsys,204" "Small Fonts,0"="Small Fonts,204"

[alex8888]

Кулик Алексей aka kpblc, ShaggyDoc,

вот наваял:

(defun clate (/ *error* oldosm oldlay pl_1 pl_2 pl_3 pl_4 pl_o pl_h pl_v pl_L3 pl_L5 pl_B6 pl_5 pl_6 pl_7)
;************funktion error********************

(defun *error*(msg)
(princ msg) ;text bei error
(if oldosm (setvar "OSMODE" oldosm)) ;if oldosm - zadano -> oldosm=oldosm
(if oldlay (setvar "CLAYER" oldlay)) ;if layer gewechselt -> zurьck
); end of *error*


;*****************Parametry privjazki********************

(setq oldosm (getvar "osmode"))
(setvar "osmode" 0)
(setq oldlay (getvar "clayer"))

;*****************Input Znachenij***********************
(vl-load-com) ; Не знаю - надо ли? далее будет команда vl-cmdf

(initget 7)
(setq pl_L (getreal "\nLдnge: ")) ;get Lдnge
(initget 7)
(setq pl_B (getreal "\nBreite: ")) ;get Breite

(setq pl_1 (getpoint "\nInput Start Point: ")) ;lower left point

;****************Raschet********************************

(setq pl_2 (polar pl_1 0 pl_L)) ;lower right point
(setq pl_3 (polar pl_2 (/ pi 2.0) pl_B)) ;upper right point
(setq pl_4 (polar pl_3 pi pl_L)) ;upper left point
(setq pl_o (polar pl_1 (/ pi 4.0) (* 10.0 (sqrt 2.0)))) ;point fьr offset

;****************Ramen**********************************
(command "_.pline" pl_1 pl_2 pl_3 pl_4 "_c" "") ;draw rectangle
(setq pl_rahmen (entlast)) ;save rectangle


;****************Postroenie offset**********************
Как сделать, чтобы при отсутствии layer "SF-RAHMEN" он был бы создан?
(command "_.chprop" "_last" "" "_layer" "SF-RAHMEN" "_c" "_bylayer" "");change layer+color
(vl-cmdf "_.offset" 10 pl_rahmen pl_o "") ;offset

;***************Bemassung*****************************

(setq pl_h (list (+ (car pl_4) (/ pl_L 2.0))(+ (cadr pl_4) 40)))
(setq pl_v (list (- (car pl_1) 40)(+ (cadr pl_1)(/ pl_B 2.0))))
(vl-cmdf "_.layer" "_s" "AM_5" "")
(command "_.dimlinear" pl_4 pl_3 pl_h)
(command "_.dimlinear" pl_1 pl_4 pl_v)

(princ)
;**************Zurьck peremennye***********************

(setvar "osmode" oldosm)
(setvar "clayer" oldlay)

);end defun


VVA
,
а основной язык (немецкий) у меня не накроется? Ведь только связка русский-английский или немецкий-английский работают. Поддержка русского у меня стоит, но для юникода первым идет немецкий, если ставлю русский - все умляуты (д,ц,ь,Я) пропадают. Если только для меня, то особо не напрягает, а вот если для документации?

[VVA]

[quote=alex8888;389383],
Когда публикуешь код, ставь птичку "Отключить смайлы в тексте" в "Дополнительных опциях"

Код:

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

; .....
;****************Postroenie offset**********************  
;;;    Как сделать, чтобы при отсутствии layer "SF-RAHMEN" он был бы создан?
  (if (null (tblsearch "layer" "SF-RAHMEN"))
    (command "_.-LAYER" "_N" "SF-RAHMEN" ""))
  (command "_.chprop" "_last" "" "_layer" "SF-RAHMEN" "_c" "_bylayer" "");change layer+color
; .....

[Eximius]

Как создать именованную систему координат, если в текущем файле рисунка вообще нет таких систем координат?
Желательно через функцию entmakex.
Какие (по минимуму) dxf коды нужны для создания именованной ucs?
Как получить координаты текущей системы координат относительно мировой?

[VVA]

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

Команда: _setvar Имя переменной или [?]: ? Список переменных для вывода <*>: ucs* UCSAXISANG 90 UCSBASE "" UCSFOLLOW 0 UCSICON 1 UCSNAME "" (только чтение) UCSORG 0.0000,0.0000,0.0000 (только чтение) UCSORTHO 1 UCSVIEW 1 UCSVP 1 UCSXDIR 1.0000,0.0000,0.0000 (только чтение) UCSYDIR 0.0000,1.0000,0.0000 (только чтение)

А так же переменная WORLDUCS

[alex8888]

VVA,
спасибо, понял.
Насчет кодовых страниц вопрос пока открытый (У меня виста 64х бизнес немецкая).

Кулик Алексей aka kpblc,

Способ есть. В "Готовых программах" посмотри - там был вариант загрузки всех приложений из указанного каталога.

в готовых программах не нашел, можно прямую ссылочку?

[VVA]

alex8888, Ну так экспортировать сущестующие значения реестра, импортировать и посмотреть, если что вернуть назад.
По идее в этой части

REGEDIT4 [HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Contro l\Nls\CodePage] "1250"="c_1251.nls" "1251"="c_1251.nls" "1252"="c_1251.nls"

ни на что не должно повлиять

в готовых программах не нашел, можно прямую ссылочку?

Алексей немного промахнулся. Не в готовых программах, а в библиотеке функций
DwgRuLispLib: Команда. Загрузка lisp файлов из указанной папки

[alex8888]

Спасибо, ребята. Вы отвечаете быстрее, чем я "перевариваю"

[Кулик Алексей aka kpblc]

Offtop: VVA, вот и тебя "размножили"

[alex8888]

Offtop: VVA, вот и тебя "размножили"

Прошу прощения, впредь буду сдержанней в эмоциях.


VVA,
попробовал поменять кодовые страницы - результат:
1. исчезли все умляуты, вместо них русские буквы;
2. в автокаде как были иероглифы и знаки вопроса, так и остались.
То есть, системные установки кодовых страниц еа автокад не влияют. Где то спрятано глубже.

[Eximius]

VVA, спасибо что отвечаете на все вопросы которые я тут задал.
И ещё чуть-чуть:
У Кулик'a Алексея aka kpblca, в видео vlideworks он в теле функции defun создаёт ещё одну функцию типа defun. Из видео мне не понятно зачем, и как она будет работать.
В каких случаях удобно создавать такие:

Код:

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

(defun abc ()
  (defun def () .....)
  ........
)

комбинации?

[Кулик Алексей aka kpblc]

Ну это локальные функции. Особенно удобно, если надо переопределять обработчик ошибок именно внутри какой-то своей функции. Ну или рекурсию, например, применить...

[Juss_00]

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

п.с. понимаю что вопросы уже тут шумевшие не раз. Если что удалите мой пост, но получив в личку ответ был бы признателен.

[Do$]

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

Не знаю, как насчет этого форума, а в инете сегодня наткнулся вот на это:
http://aco.ifmo.ru/~nadinet/html/oth...book/lisp.html
А вообще пользуюсь книжкой Полещука и Лоскутова AutoLISP и VisualLISP в среде AutoCAD . Если мне память не изменяет - тут где-то скачал.

У меня вопрос к опытным людям по функции initget:

...
(initget "Yes No")
(setq antw (getkword "\nContinue?[Yes/No]:<Yes>"))
...

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

[VVA]

Do$, getkword не запрашивает точки, соответственно нет координат. Сравни:

Код:

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

(initget "Yes No")
(setq antw (getpoint "\nPick point or Continue?[Yes/No]:<Yes>"))

[Кулик Алексей aka kpblc]

Помимо этого, еще и биты для initget не помешают

[Do$]

Супер! Я почему-то думал, что если в запрос getpoint ввести что-то кроме координат точки, то Лисп выдаст ошибку. Опять же, в initget прописаны допустимые варианты ввода только "Yes" или "No" (ну то есть еще подойдет "Y" и "Ye" и "N"), однако, координаты точки тоже принимаются! Я думал это какими-то особыми битами указывается!
В той программе, из которой этот фрагмент, в этом месте точку указывать не надо. Там смысл именно в том, что либо "да" либо "нет" или же пустой ввод, что равносильно "да" - Пользователь выбирает пару объектов, затем выскакивает этот запрос: выбрать еще пару или выход? Если "да" или пустой ввод - то цикл повторяется, пользователь выбирает еще пару объектов.
Дело только в том, что таких пар может быть больше сотни, и рука отвалится на "enter" жать каждый раз... Наверное, лучше тогда перед выбором первого объекта из пары сделать запрос такого вида:
...
(initget "Exit")
(setq text1 (entsel "\nSelect first object or Exit?[Exit]:<Exit>"))
...

Там правда не entsel а ssget используется... Код на работе, к сожалению.
Буду пробовать, спасибо VVA!

Насчет битов, чтоб с ошибками не вылетало при неправильном вводе... Запретить пустой ввод, и ... все?

[Кулик Алексей aka kpblc]

Сейчас кад не запустить, но можно попробовать (initget 169 "Да Нет Yes No _ Y N Y N") перед getpoint.

[Aminka]

День добрый!
Подскажите, пожалуйста, как лучше реализовать следуюющее:
Есть программка на автолиспе, в которой выполняется цикл. Необходимо написать прерывание цикла по некоторой клавише или комбинации клавиш, при этом программа на автолиспе должна продолжить свою работу дальше.
Правильно ли я понимаю, что нужно писать макрокоманду для "привязки" некоторого действия к комбинации клавиш, причем писать макрокоманду нужно внутри той же программы?
И еще вопрос: во многих языках программмирования имеется возможность устанавливать "метки" на строчки и при необходимости перейти к необходимой строчке, которую пометили, из любой точки программы. Есть ли такая возможность в автолисп?
Поскольку с автолиспом я на "Вы", буду благодарна за простые и понятные новичку ссылки по теме)

Если не очень хорошо объяснила, что нужно, то вот:

(начало программы()

(начало функции "клавиша"()
(если нажаты клавиши "ST" (setq условие2 nil))
)

(while (условие1)
(программа что-то делает в цикле 1)
(setq условие2 T)
(while (условие2)
(программа что-то делает в цикле 2)
)
)
)
Т.е. если в процессе выполнения цикла2 будут нажаты клавишы ST, произойдет выход из цикла.

[Do$]

Насчет меток: тоже озадачился этим вопросом, когда начинал изучение ЛИСПа. В фортране: goto <метка> и переход на нужную строку. Тут такого нет, поэтому программы по другому приходится выстраивать. Честно говоря, особых сложностей из-за отсутствия такого оператора безусловного перехода не возникало.
Насчет цикла : делал похожую программу, выкрутиться можно так - в процессе выполнения цикла 2 выводится запрос: введите "Да" или "Нет" (к примеру). Если "Да" - условию 2 присваивается Т, если Нет - присваивается nil и цикл завершается.

[vovkam]

сории за офф топ
объясните пожалуйста почему вот этот код не хочет работать?

Код:

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

(setq 
 	E 8872
 	F 8652
 	J 2322
 	H 93720
 	I 91398
 	tx 15
 	ty 15
)
(setq 
 	;K (- H (sqrt(- (sqr(H)) (sqr(/ E 2)) ) ) )	;105
 	;L (- I (sqrt(- (sqr(I)) (sqr(/ F 2)) ) ) )	;102
 	;G (+ J L) ;2425
	 A1x tx
	 A1y (+ (- H (sqrt(- (sqr(H)) (sqr(/ E 2)) ) ) ) ty)
	 A2x (+ E tx)
	 A2y (+ (- H (sqrt(- (sqr(H)) (sqr(/ E 2)) ) ) ) ty)
	 B1x (+ tx (/ (- E F) 2))
	 B1y (+ (+ J (- I (sqrt(- (sqr(I)) (sqr(/ F 2)) ) ) )) ty )
	 B2x (+ tx (/ (+ E F) 2))
	 B2y (+ (+ J (- I (sqrt(- (sqr(I)) (sqr(/ F 2)) ) ) )) ty )
	 ARx (+ tx (/ E 2))
	 ARy (+ H ty)
	 BRx (+ tx (/ E 2))
	 BRy (- (+ I G ty) (- I (sqrt(- (sqr(I)) (sqr(/ F 2)) ) ) ) )
 	 LA E
	 LB F
	 n1 (fix (/ E 400))
	 n2 (fix (/ F 400))
)

(entmakex (list '(0 . "point") (list 10 A1x A1y)))

(setq c  (list ARx ARy)
      p  (list A1x A1y 0.)
      r  (distance c p)
      a1 (angle c p)
      a2 (+ a1 (/ E r))
) ;_  setq
(entmakex (list '(0 . "ARC")
                (cons 10 c)
                (cons 40 r)
                (cons 50 a1)
                (cons 51 a2)
          ) ;_  list
) ;_  entmakex

а в данном случае работает

Код:

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

(setq 
           E 8872
 	F 8652
 	J 2322
 	H 93720
 	I 91398
 	tx 15
 	ty 15
)
(setq 
 	 K 105	;(- H (sqrt(- (sqr(H)) (sqr(/ E 2)) ) ) )	;105
 	 L 102  ;(- I (sqrt(- (sqr(I)) (sqr(/ F 2)) ) ) )	;102
 	 G 2425	;(+ J L) ;2425
	 A1x tx
	 A1y (+ K ty)
	 A2x (+ E tx)
	 A2y (+ K ty)
	 B1x (+ tx (/ (- E F) 2))
	 B1y (+ G ty )
	 B2x (+ tx (/ (+ E F) 2))
	 B2y (+ G ty )
	 Cx (+ tx (/ E 2))
	 Cy (+ H ty)
 	 LA E
	 LB F
	 n1 (fix (/ E 400))
	 n2 (fix (/ F 400))
)

%|

[Aminka]

Сообщение от Do$ Насчет цикла : делал похожую программу, выкрутиться можно так - в процессе выполнения цикла 2 выводится запрос: введите "Да" или "Нет" (к примеру). Если "Да" - условию 2 присваивается Т, если Нет - присваивается nil и цикл завершается.

Этот вариант применять бы не хотелось изначально, потому что нажимать триста раз ентер в цикле - монтонно слишком и времени займет много.

[Кулик Алексей aka kpblc]

vovkam, мой AutoCAD 2008 не знает функции sqr, это раз. Второе: где и что конкретно не работает?
Aminka, а что конкретно хочется сделать-то? Полный код кусков "что-то делать" покажи.

[E-degtyarev]

Потому что функция sqr не определена, а в Lispe такой встроенной функции нет.

[Кулик Алексей aka kpblc]

E-degtyarev, vovkam говорит, что во втором случае код работает. А sqr там используется. Значит, она уже определена и загружена.
---
Добавлено: методика записи

Код:

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

(sqr (i))

сразу в глаза не бросается, но в данном случае вряд ли правомерна... Или есть еще и функция i, помимо переменной? Ну так тогда она переопределяется на значение...
Короче, код написан "не для лиспа"

[vovkam]

Кулик Алексей aka kpblc самое интересное, что при вводе !K !L оно правильно считает...
Короче, подскажите, пожалуйста, как мне решить эту задачу. Как избавиться от этих выражений??

[Кулик Алексей aka kpblc]

vovkam, с тебя значение переменной g:

Код:

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

(defun test (/ e f j h i tx ty a1x a1y a2x a2y b1x b1y b2x b2y arcx arcy brx bry la lb n1 n2)
  (setq e    8872.
        f    8652.
        j    2322.
        h    93720.
        i    91398.
        tx   15.
        ty   15.
        a1x  tx
        a1y  (+ (- h (sqrt (- (sqrt h) (sqrt (/ e 2.))))) ty)
        a2x  (+ e tx)
        a2y  (+ (- h (sqrt (- (sqrt h) (sqrt (/ e 2))))) ty)
        b1x  (+ tx (/ (- e f) 2.))
        b1y  (+ (+ j (- i (sqrt (- (sqrt i) (sqrt (/ f 2.)))))) ty)
        b2x  (+ tx (/ (+ e f) 2.))
        b2y  (+ (+ j (- i (sqrt (- (sqrt i) (sqrt (/ f 2.)))))) ty)
        arcx (+ tx (/ e 2.))
        arcy (+ h ty)
        brx  (+ tx (/ e 2.))
        bry  (- (+ i g ty) (- i (sqrt (- (sqrt i) (sqrt (/ f 2.))))))
        la   e
        lb   f
        n1   (fix (/ e 400.))
        n2   (fix (/ f 400.))
        c    (list arcx ary)
        p    (list a1x a1y 0.)
        r    (distance c p)
        a1   (angle c p)
        a2   (+ a1 (/ e r))
        ) ;_ end of setq
  (entmakex (list (cons 0 "POINT") (cons 10 (list a1x a1y))))
  (entmakex (list '(0 . "ARC")
                  (cons 10 c)
                  (cons 40 r)
                  (cons 50 a1)
                  (cons 51 a2)
                  ) ;_  list
            ) ;_ end of entmakex
  )

Не проверял

[СИД]

Добрый день (или вечер) уважаемые корифеи Лиспа!
Я еще только как месяц пробую освоить программирование на Лиспе. Маленькие программки вроде как освоил и тут замахнуться (дурень думками богат?) на расчет эвакуации людей из здания. Может это уже кто и без меня придумал, но я об этом пока не знаю. Задумка была такова чтобы можно было нарисовать пути эвакуации людей на чертеже, ввести количество людей в чертёж и в таблице получить все результаты вычислений, и в конце время эвакуации из здания.
Это была такая задумка, а сталкнулся я с проблемой, когда пытался ввести длину участка маршрута в таблицу, для дальнейших вычислений. Длину участка изображенного до этого графически я так и не смог вычислить и ещё не смог научиться определять длины различных участков одного маршрута. Пока что дальше не пошел. Если кто может подсказать, каким образом можно информацию о длине линий из чертежа вставить в таблицу Автокада (или экселя) , для использования в вычислениях, то очень буду тому благодарен. И вообще возможно ли это в Лиспе?

[Aminka]

Сообщение от Кулик Алексей aka kpblc Aminka, а что конкретно хочется сделать-то? Полный код кусков "что-то делать" покажи.

Попробовала поискать, как делать выход по пустому вводу. Получилась откровенная ерунда. Цикл, который должен выполняться N раз, не выполняется. Подскажите, пожалуйста, почему так происходит и что на данную тему почитать, наверняка это уже где-то обсуждалось.

Код:

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

(defun c:T5 (/ eNizv i inc )
  (setq Nizv nil)
  (setq inc nil)
  (setq i 1)
  (setq Nizv 6)
 
 (while (<= i Nizv)
  (setq flag nil) 
  (while (null flag) 
   (setq s (car (nentsel "\Будут ли указаны датчики с данным шлейфом и прибором? Если будут, то нажмите ENTER или правую клавишу мыши. Для смены этажа, номера шлейфа или ПКП выберите любой объект) ")));имя примитива или имя атрибута
   (cond
   ((= s nil) 
     (
      (princ "\nВыберите что-нибудь ") 
      (setq gr (ssget))
      ;;программа выполняет действия с выбранными блоками
      (setq inc (sslength gr))
      (setq i (+ i 1))
     )
   )    
   ((/= s nil) (setq flag T)) 
   );; endof cond
  );; endof (while null_flag_new
 );end of while Nizv 
);end of defun
(princ)

[Кулик Алексей aka kpblc]

не вникая в код (поздновато уже):

Код:

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

(defun c:t5 (/ enizv i inc)
  (setq nizv nil)
  (setq inc nil)
  (setq i 1)
  (setq nizv 6)

  (while (<= i nizv)
    (setq flag nil)
    (while (null flag)
      (setq s
             (car
               (nentsel
                 (strcat
                   "\Будут ли указаны датчики с данным шлейфом и прибором? "
                   "Если будут, то нажмите ENTER или правую клавишу мыши. "
                   "Для смены этажа, номера шлейфа или ПКП выберите любой объект) "
                   ) ;_ end of strcat
                 ) ;_ end of nentsel
               ) ;_ end of car
            )                           ;имя примитива или имя атрибута
      (cond
        ((= s nil)
                                        ;( Зачем здесь скобки?
         (princ "\nВыберите что-нибудь ")
         (setq gr (ssget))
         ;;программа выполняет действия с выбранными блоками
         (setq inc (sslength gr))
         (setq i (+ i 1))
                                        ;  )
         )
        ((/= s nil)
         (setq flag t)
         )
        ) ;_ end of cond
      ;; endof cond
      ) ;_ end of while
    ;; endof (while null_flag_new
    ) ;_ end of while
  ) ;_ end of defun
(princ)

[Дима_]

Сообщение от СИД Добрый день (или вечер) уважаемые корифеи Лиспа! Я еще только как месяц пробую освоить программирование на Лиспе. Маленькие программки вроде как освоил и тут замахнуться (дурень думками богат?) на расчет эвакуации людей из здания. Может это уже кто и без меня придумал, но я об этом пока не знаю. Задумка была такова чтобы можно было нарисовать пути эвакуации людей на чертеже, ввести количество людей в чертёж и в таблице получить все результаты вычислений, и в конце время эвакуации из здания. Это была такая задумка, а сталкнулся я с проблемой, когда пытался ввести длину участка маршрута в таблицу, для дальнейших вычислений. Длину участка изображенного до этого графически я так и не смог вычислить и ещё не смог научиться определять длины различных участков одного маршрута. Пока что дальше не пошел. Если кто может подсказать, каким образом можно информацию о длине линий из чертежа вставить в таблицу Автокада (или экселя) , для использования в вычислениях, то очень буду тому благодарен. И вообще возможно ли это в Лиспе?

Да можно, только ньюансов в Вашей программе - уверею больше чем кажеться, свойства объектов можно вычислять либо из dxf представления (entget (car (entsel))) - поличите список dxf кодов - их расшифровку см. в справке по Acad'у, либо vla-методами - для получения длинны например (vla-get-length (vlax-ename->vla-object (car (entsel)))) - чтобы занести в таблицу - аналогично - но проще с помощью vla. В ексель либо изучай объектную модель екселя, либо при помощи sql запрса к установленному диапазону - короче изучать еще много чего, если совсем ничего не понятно, пишите конкретными задачами с примерами.

[Aminka]

Сообщение от Кулик Алексей aka kpblc не вникая в код (поздновато уже

скобка появилась потому, что
(
сond
(
(условие 2) ((действие2) (действие3))
(условие1) (действие1)
)
)


или так не правильно?

[Кулик Алексей aka kpblc]

По идее надо:

Код:

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

(cond
 ((условие 2)
  (Действие 2)
  (Действие 3)
  )
 ((условие 1)
  (Действие 1)
  )
 ) ;_ end of cond

[Aminka]

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

Cпасибо. В приложении - итог моей "деятельности", который, однако ж, глючит слегка, судя по лишней надписи nil и ""-пустому вводу в окне командных строк.


Не уверена, что мое "творчесство" кому-то интересно, но, может, и пригодится - программка позволяет осуществлять нумерацию датчиков ПС,а так же вывод в файлик информации по датчикам и длине кабеля между ними, отрисованного полилинией. Если будут идеи по тому, как сделать правильнее и красивее, буду благодарна))))


И еще вопрос - крайне не оригинальный, но что ж поделать - можно ли рисовать автокадовские таблицы с помощью автолиспа, но без использований объектных vla-.. функций? Хотелось бы информацию из файлика вывести в таблицу в автокаде, которая нормальная таблица, а не набор линий и текста)

[Кулик Алексей aka kpblc]

"Навскидку". Замени (setq gr (ssget)) на (setq gr (ssget '((0 . "INSERT")))) - и будут выбираться только блоки. А если добавить сюда и имена блоков, станет совсем просто:

Код:

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

(setq gr (ssget '((0 . "INSERT") (2 . "дым,пламя,ручник,теплов")))))

И строка

Код:

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

(write-line (itoa Nizv) fileh)

меняется на

Код:

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

(write-line (vl-princ-to-string (sslength gr)) fileh)

Остальной код не смотрел, но там мест для упрощения достаточно много ИМХО.

[Do$]

Сообщение от Aminka ...Если будут идеи по тому, как сделать правильнее и красивее, буду благодарна))))...

То, что сразу бросилось в глаза:

Код:

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

;АККУРАТНО!!! при использовании блоков размером больше чем 600 на 600 нужно подправлять текст программы на 266й строке!

(defun c:strktpoj05
       (/ etaj Nizv i inc shl OBruchn OBdim OBtepl);в скобках указаны пременные
   (setq temp "y")  ;temp="y"-строковая переменная(да,Yes)
   (setq fname nil fileh nil) ;обнуляет две переменные
   (setq fname (getfiled "Output filename" "" "txt" 0));(getfiled "строка-запрос""путь" "расширение" "режим")Взятие имени файла
   (setq fileh (open fname "a"))
   (setq Nizv nil)
   (setq inc nil)
   (setq etaj nil)


   (setq shl nil)

Если переменные в списке локальных, то им при запуске функции автоматом nil присваевается, а при выходе из функции возвращается исходное значение.
(A1 B C1 C2 C3 DL DLINA DOPNUM FILEH FL1 FL2 FLAG_SEL_NEW FNAME GR J K N NB OBPLAM P PKP POLYL POM ROT SS SUM TEMP X XX XXX XXXX)
Эти переменные используются в каких то других функциях? Если нет - то их тоже правильнее внести в список... А может быть от многих из них постараться избавиться, переделав код...

Код:

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

(if (OR (/= fl1 T) (/= fl2 T)) (nentsel (strcat "\nВы ошиблись и выбрали лишнее или не те объекты." "\nДля продолжения - ENTER.")))

Я бы при вместо nentsel использовал alert

Код:

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

	
(if (OR (/= fl1 T) (/= fl2 T))
  (alert
        "\nВы ошиблись и выбрали лишнее или не те объекты."
  ) ;_ end of alert
) ;_ end of if

Когда увидел эту функцию удивился и полез в справочник
(gc)
Что делает? Зачем тут нужна? (Может действительно нужна, просто я с ней "не знаком")

(princ) после закрывающей функцию скобки не будет обрабатываться

Код:

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

);end of defun
(princ)

[VVA]

(gc) Что делает? Зачем тут нужна? (Может действительно нужна, просто я с ней "не знаком")

GC - garbage collection
Во времена 10 Автокада это было критично.

[Aminka]

Относительно (gc). Без нее строка (setq dlina (+ dlina (getvar "PERIMETER"))) работать адекватно отказывалась. На попытку вытащить то. что лежит в "PERIMETER" акад ругался, хотя и писал в командном окне значения area и периметра. Почему, не имею понятия( После того, как не получилось кусок кода с подсчетом длины полилинии написать самой, подсмотрела ее в одной из готовых программ. Видимо, в свойстве "PERIMETER" что-то уже валялось..хотя это лишь мои догадки) Ну а в конце я ее решила добавить уже почитав, что она память подчищает.

Избавиться от лишних переменных можно. Просто написала кучу всяких разных переменных для наглядности и упрощения отладки, на четверть их сократить точно можно)) Что и обещаюсь сделать в ближайшее время.

Но вопрос с рисованием таблиц остается открытым. Если не будет лениво и у кого-то есть пример того, как вставлять таблицы без функций вида (Vl*-... ), киньте сюда, плз, буду разбираться на примере методом тыка и хэлпов. Если так не получится вставить табличку, то хоть напишите об этом))) Буду покупать тогда полищука и пытаться изучать (vl*). Если я правильно понимаю, то искать нужно то, как работает VLA-ADDTABLE?
Опять-таки, вопрос человека, весьма далекого от программирования, vl-функции, это ведь уже объектно-ориентированное программирование под автокад? В инете множество ссылок на VBA. Однако с автолиспом, работающим со списками, у них маловато общего. Стоит ли начинать лезть в VBA или хватит вполне Полищука?)) В общеМ, извиняйте блондинку за кучу вопросов дурацких, но инфы в инете слишком много и у меня глаза разбегаются и за что хвататься не очень понятно.

[Кулик Алексей aka kpblc]

Offtop: полищука покупать не надо. А вот книгу Н.Н.Полещука - можно и нужно
Теперь по делу (возможно, VVA меня поправит): создавать таблицу "просто так" не получится. Сначала надо создать или изменить стиль таблицы. Учитывая объем информации, хранимой в описании табличного стиля, я бы упирал именно на ActiveX-методы. Вставку таблицы и задание ей всех настроек (количество и ширина столбцов, высоты строк, границы ячеек, объединение ячеек и т.д.) - я бы тоже делал на ActiveX (то есть vla-* функциях).

[VVA]

Нечего и нечем поправлять
Добавлю только, что как вариант можно создавать стиль таблицы так:
1. настроить ручками
2. Сохранить полученный список из словаря "ACAD_TABLESTYLE"
3. При необходимость entmakex' ом создавать.
Так было сделано здесь (см. table-style-make из #1)
Кстати, чтобы при активной работе с таблицами чтобы она не подтормаживала, не забывать включать/отключать свойство Regeneratetablesuppressed с его проверкой. Подробнее можно почитать здесь

[Do$]

Все-таки не понятно, что конкретно эта функция делает (я про gc).
Если можно, на примерах обьясните, пожалуйста!

[VVA]

Do$, Ты ссылку в #724 читал?

[Do$]

Да, там описание в википедии про сборщик мусора в различных языках программирования.
Он удаляет ненужные данные, освобождает память.
Сперва я подумал, что после завершения работы программы ставим gc и всем неиспользуемым переменным nil присваевается. Попробовал - ничего подобного...
Пока писал ответ, пришла мысль: когда мы вводим новую переменную, в памяти выделяется какое-то место под нее. Даже если мы потом этой переменной nil присвоили, место под нее сохраняется. А gc подчищает как раз такие неиспользуемые зарезервированные участки памяти. Но это только мои фантазии

[VVA]

Ну в общем где-то так и есть.

Код:

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

(setq a 10)
(setq a 5.6e12)
(setq a "Мама мыла раму")
(setq a (vla-get-activedocument (vlax-get-acad-object)))

В a хранится указатель на выделенный участок памяти.
Каждое присвоение в a требует разного объема памяти. Подчисткой таких хвостов как раз gc и занимается.

[Do$]

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

[VVA]

Do$, Мусорщик запускается автоматически. Самому вызывать не нужно. Я последний раз принудительно вызывал его в году эдак 1991-1993, когда был DOS (твой тезка ), Автокад 10 и очень мало памяти.

[ShaggyDoc]

В современных AutoCAD сборщик мусора вызывать не обязательно. Памяти обычно хватает. Но у меня он включен в стартовую функцию, которая вызвается во всех программах. Тем самым постоянно убирается грязь.

"Большие приложения" действительно расплывчатое понятие. Оно не связано с большим объемом кода. Иногда маленький "в строках", но плохо написанный код может привести к накоплению мусора. Вот здесь вызов (gc) поможет. Хотя лучше писать хороший код.

Более точно о gc знают только програмисты Autodesk, реализующие сборку мусора в AutoCAD.

А вот в AutoCAD-10 вызов (gc) был абсолютно необходим в любой чуть сложной программе. В отличие от Windows, где, в крайнем случае, добавится дисковая память, в DOS это было невозможно. Весь LISP работал в 64 Kb памяти, из них около 20 Kb занимал сам интерпретатор, а остальное делилось между пространством нодов и пространством строк. В пространстве нодов и размещаются переменные и их значения. При исчерпании этого пространства выполнялась автоматическая сборка мусора. Только она могла не успеть выполниться.

Сейчас, видимо, происходит что-то подобное, просто память измеряется уже другими единицами.

И еще использовалась ныне забытая функция vmon, выполнявшая постраничную организацию памяти, в случае если LISP-программа превышала имеющееся пространство нодов.

Серьезные программы без vmon и gc нельзя было написать. А теперь - можно. Если, конечно, аккуратно обращаться с переменными.

[Елпанов Евгений]

Хотелось бы добавить, каждый вызов сборщика мусора занимает время, причем, не всегда хватает одного прохода, т.е. при троекратном вызове, результат может быть лучше, но занять в трое больше времени. Я тоже регулярно вызываю сборщик мусора, после создания и обнуления большого количества объектов или работы с огромными списками. Из своего опыта могу посоветовать, обратить внимание на несколько моментов:
1. Всегда планировать в какой момент вызвать сборщик мусора. Иногда выгоднее его вызвать несколько раз по ходу программы, а иногда один раз в конце или старте. Мой критерий - замеры скорости работы на реальных (больших) чертежах.
2. Заранее проверять, есть ли изменение в расходе памяти, если вызвать сборку мусора два три раза подряд.
3. Винда, не любит освобождать память сразу. Часто приходится ждать некоторое время. Хорошо помогает вложенный вызов. Как пример, сильно расходует память программа с вызовом

Код:

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

(test)

если сразу после вызова в коде поставить сборку мусора, результат может быть заметно хуже, чем если сделать дополнительную обертку

Код:

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

(defun test1 ()(test))

и после вызова

Код:

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

(test1)

убрать мусор. Почему так работает не знаю, но несколько раз выручало. Единственная разница, винда освобождает память быстрее, иногда сразу.

ps. Наблюдения проводились в программах, занимающих во время выполнения несколько сотен мегов в оперативке. Вероятно, для маленьких задач, вызов сборщика мусора не актуален. Автокад, сам его регулярно вызывает. Другое дело, если лисп выполняется значительное время, например час или часы...

[Red Nova]

Давненько я тут не был
ЛИСП я так и не выучил, да и что знал – позабыл. Но причины на этот раз не в лени как у меня обычно бывало. Я трудился над развитием лиспа от VVA для расчета спецификаций из мтекстов SPEC5D, намеревался добавить функцию автоматической генерации ведомости расхода стали и даже немного получалось, но как это часто бывает: работа... Приехал к нам в страну новый сотовый оператор. Меня назначили ГИП-ом, и про мое увлечение пришлось забыть на год, да и навряд ли теперь удастся вернуться к этому…
Но недавно работа поостыла и я для начала решил обновить Акад и СПДС. Поставил 2010 + СПДС6. Теперь тестирую все что имел под 2009-й. И обнаружил что так прижившаяся в моем КБ добавка для генерации ведомости из выносок СПДС перестала работать. Потестил в Влайде, понял что глючит dwgru-get-spds-text-and-range представленный Кулик Алексей aka kpblc тут на посте 472. Списки в 2010-ом создаются некорректно .
Поможите люди добрые

[Кулик Алексей aka kpblc]

6-го СПДС нет, так что я помочь не смогу. Может быть, "штатные" средства самой СПДС помогут (но не факт)

[Red Nova]

А идей нет?
2009 + СПДС4

Command: (_dwgru-get-spds-text-and-range) Select objects: 1 found Select objects: (("1" "Ш10 A500C, ш.150" 1))

2010 + СПДС6

Command: (_dwgru-get-spds-text-and-range) Select objects: 1 found Select objects: ((1))

Или может тебе что-то подскажет если я какие ни будь цитаты из Влайда валожу? Уж больно нужная вешь, придется обратно на 2009-й переходить, ох как не охота

[Кулик Алексей aka kpblc]

Цитаты помогут как мертвому припарки. Надо скачивать и ставить СПДС 6, а у меня сейчас скорость коннекта около 5 кбит/с.

[Red Nova]

Просто на сколько я помню ты первую версию вовсе без СПДС-а написал
Жаль что скачать не можешь. Отправил бы по почте в конверте, да наверное доходить долго будет, хотя идея...
теперь мне наверное предется на некоторое времяпреостановить использование 2010-го пока не сохранил важные файлы в 6-й версие СПДС, а-то потом не 4-м не открою если что...

У кого из программистов есть СПДС 6? HELP

[VVA]

Для справки:
_dwgru-get-spds-text-and-range нашел в #485
Red Nova,
Выложи списки, которые возвращат ниже приведенный код для 2009 и 2010 Автокада

Код:

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

(entget (car(entsel "\nSelect SPDS object:")) '("*"))

[Red Nova]

VVA,
2009

Command: (entget (car(entsel "\nSelect SPDS object:")) '("*")) Select SPDS object(-1 . <Entity name: 7effead0>) (0 . "spdsNotePosition") (330 . <Entity name: 7ef04cf8>) (5 . "187A0A") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (48 . 100.0) (370 . 25) (100 . "mcsDbObject") (100 . "mcsDbObjectNotePosition") (90 . 1) (301 . "Name") (300 . "1") (301 . "Info") (300 . "Позиционная выноска\r\n1\r\nшвеллер 20, L=1000") (301 . "Scale") (40 . 100.0) (301 . "CutAcElements") (290 . 1) (301 . "Text style") (300 . "GOST 2.304") (301 . "Первая строка") (300 . "1") (301 . "Вторая строка") (300 . "швеллер 20, L=1000") (301 . "Выравнивание текста") (90 . 1) (301 . "Направление полки") (40 . 0.0) (301 . "Высота текста") (40 . 2.5) (301 . "Высота малого текста") (40 . 2.5) (301 . "Шаг угла") (40 . 0.0))

2010

Command: (entget (car(entsel "\nSelect SPDS object:")) '("*")) Select SPDS object(-1 . <Entity name: 7d96c978>) (0 . "spdsNotePosition") (330 . <Entity name: 7ed17cf8>) (5 . "1879DF") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (48 . 100.0) (370 . 25) (100 . "mcsDbObject") (100 . "mcsDbObjectNotePosition") (90 . 1) (301 . "Name") (300 . "1") (301 . "Info") (300 . "Позиционная выноска\r\n1\r\nшвеллер 20, L=1000") (301 . "Scale") (40 . 100.0) (301 . "CutAcElements") (290 . 1) (301 . "WipeOut") (290 . 0) (301 . "Text style") (300 . "GOST 2.304") (301 . "String1") (300 . "1") (301 . "String2") (300 . "швеллер 20, L=1000") (301 . "TextAlign") (90 . 1) (301 . "RackDir") (40 . 0.0) (301 . "TextSize") (40 . 2.5) (301 . "SmallTextSize") (40 . 2.5) (301 . "AngleStep") (40 . 0.0))

Рожици в цитате естественно означают соответствующие символы, но вполне соответствуют моему настроению.

[Кулик Алексей aka kpblc]

"Насухую", предполагая, что СПДС 6 только в 2010:

Код:

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

(defun _dwgru-get-spds-text-and-range (/ selset lst cadver)
                                      ;|
*    Возвращает список строк выделенных выносок. В набор попадают узловые выноски,
* позиционные выноски, цепные и гребенчатые.
*    Параметры вызова:
	нет
*    Примеры вызова:
(_dwgru-get-spds-text)
	;
|;
  (setq cadver (atoi (vl-string-trim " VISUALP" (strcase (ver)))))
  (if
    (and
      (= (type (setq selset (vl-catch-all-apply
                              (function (lambda () (ssget)))
                              ) ;_ end of vl-catch-all-apply
                     ) ;_ end of setq
               ) ;_ end of type
         'pickset
         ) ;_ end of =
      (setq selset
             (vl-remove-if-not
               (function
                 (lambda (x)
                   (member (cdr (assoc 0 x))
                           '("spdsNotePosition"
          ;"spdsNoteKnot" закомментировал тапорно, чтобы исключить из выбора узловые выноски
                             "spdsNoteComb"
                             "spdsNoteChain"
                             )
                           ) ;_ end of member
                   ) ;_ end of lambda
                 ) ;_ end of function
               (mapcar
                 (function (lambda (a)
                             (vl-remove-if-not
                               '(lambda (b) (member (car b) '(0 300 301 90)))
                               (entget a)
                               ) ;_ end of vl-remove-if-not
                             ) ;_ end of lambda
                           ) ;_ end of function
                 (_dwgru-conv-pickset-to-list selset)
                 ) ;_ end of mapcar
               ) ;_ end of vl-remove-if-not
            ) ;_ end of setq
      ) ;_ end of and
     (setq
       lst
        (mapcar
          (function
            (lambda (item)
              (cond
                ((= (cdr (assoc 0 item)) "spdsNoteKnot")
                 (append (mapcar
                           (function cdr)
                           (vl-remove-if-not
                             (function
                               (lambda (x)
                                 (= (car x) 300)
                                 ) ;_ end of lambda
                               ) ;_ end of function
                             (reverse
                               (member '(301 . "Выравнивание текста")
                                       (reverse (member '(301 . "Номер узла") item))
                                       ) ;_ end of member
                               ) ;_ end of reverse
                             ) ;_ end of vl-remove-if-not
                           ) ;_ end of mapcar
                         (list 1)
                         ) ;_ end of append
                 )
                ((= (cdr (assoc 0 item)) "spdsNotePosition")
                 (append (mapcar
                           (function cdr)
                           (vl-remove-if-not
                             (function
                               (lambda (x)
                                 (= (car x) 300)
                                 ) ;_ end of lambda
                               ) ;_ end of function
                             (member (cons 301
                                           (if (< cadver 2010)
                                             "Первая строка"
                                             "String1"
                                             ) ;_ end of if
                                           ) ;_ end of cons
                                     item
                                     ) ;_ end of member
                             ) ;_ end of vl-remove-if-not
                           ) ;_ end of mapcar
                         (list 1)
                         ) ;_ end of append
                 )
                ((member (cdr (assoc 0 item))
                         '("spdsNoteComb" "spdsNoteChain")
                         ) ;_ end of member
                 (append
                   (mapcar
                     (function cdr)
                     (vl-remove-if-not
                       (function
                         (lambda (x)
                           (= (car x) 300)
                           ) ;_ end of lambda
                         ) ;_ end of function
                       (reverse
                         (member '(301 . "Выравнивание текста")
                                 (reverse (member '(301 . "Первая строка") item))
                                 ) ;_ end of member
                         ) ;_ end of reverse
                       ) ;_ end of vl-remove-if-not
                     ) ;_ end of mapcar
                   (list (cdr (assoc 90 (reverse item))))
                   ) ;_ end of cons
                 )
                ) ;_ end of cond
              ) ;_ end of lambda
            ) ;_ end of function
          selset
          ) ;_ end of mapcar
       ) ;_ end of setq
     ) ;_ end of if
  lst
  ) ;_ end of defun

[Дима_]

Опоздал.

[Red Nova]

Спасибо, заработало
А возможно сделать так чтобы для обоих версий СПДС одна и та же функция была рабочей? Скажем сперва проверить версию СПДС потом в зависимости от нее то либо другое.

[Кулик Алексей aka kpblc]

Если бы мне удалось это сделать, то все было бы наверняка проще. Значительно проще.

[VVA]

Кулик Алексей aka kpblc, В порядке бреда : после entget'a subst'ом и заменить (301 . "String1") на (301 . "Первая строка") и не привязываться к версии Автокада

[Кулик Алексей aka kpblc]

Можно и так Но лично я сейчас не в силах что-либо полезное делать

[superkot007]

Раз уж есть такая тема - задам вопрос тут...

Код:

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

(defun C:SRP24 (/ pt pt1 pt2 pt3 m1 m2 v VarOsMode)
; Разрыв вертикальных линий, равный 4 мм
(setq pt (getpoint "\n \n \nВведите точку пересечения линий:"))

; Отключить привязку
  (setq VarOsMode (getvar "osmode"))
  (setvar "osmode" 0)

  (setq pt1 (osnap pt "_int"))
  (setq m1 (+ (cadr pt1) 2))
  (setq pt2 (list (car pt1) m1))
  (setq m2 (- (cadr pt1) 2))
  (setq pt3 (list (car pt1) m2))
  (command "_break" pt2 pt3)

; Включить привязку
  (setvar "osmode" VarOsMode)
)

1. как задать произвольный размер разрыва
2. горизонт/вертик разрыв (направление разрыва указывается мышкой)

[ShaggyDoc]

Сообщение от superkot007 Раз уж есть такая тема - задам вопрос тут... Код: [Выделить все] (defun C:SRP24 (/ pt pt1 pt2 pt3 m1 m2 v VarOsMode) ; Разрыв вертикальных линий, равный 4 мм (setq pt (getpoint "\n \n \nВведите точку пересечения линий:")) ; Отключить привязку (setq VarOsMode (getvar "osmode")) (setvar "osmode" 0) (setq pt1 (osnap pt "_int")) (setq m1 (+ (cadr pt1) 2)) (setq pt2 (list (car pt1) m1)) (setq m2 (- (cadr pt1) 2)) (setq pt3 (list (car pt1) m2)) (command "_break" pt2 pt3) ; Включить привязку (setvar "osmode" VarOsMode) ) 1. как задать произвольный размер разрыва 2. горизонт/вертик разрыв (направление разрыва указывается мышкой)

Задать размер разрыва самое простое - сделать его величину в виде опции с каким-то значением по умолчанию. Хотя вообще-то лучше, чтобы длина разрыва определялась автоматически в зависимости от ширины и веса линейных объектов.

Но программа принципиально неверно делается.

1. Надо делать разрыв не только "линий" (программисты говорят и пишут "LINE", в крайнем случае "отрезок"), а и других типов примитивов, похожих на "линии". У них точки совсем иначе извлекаются.

2. Разрывать надо одну "линию", та, которая должна лежать ниже. Для этого надо указать не точку пересечения, а примитивы - тот, который надо разорвать и тот, которым надо разорвать. Указывать надо в любом месте, пересечений может оказаться несколько. При этом ещё учитывать, что примитивы (полилинии) могут иметь физическую ширину.

В результате реальная программа вырастет в размере примерно да двухсот строк, и это если использовать библиотеки.

Такую программу я включал в исходники к книге "САПР на базе AutoCAD - как это делается" - ru_cross_lines.lsp.

[superkot007]

Сообщение от ShaggyDoc Задать размер разрыва самое простое - сделать его величину в виде опции с каким-то значением по умолчанию. Хотя вообще-то лучше, чтобы длина разрыва определялась автоматически в зависимости от ширины и веса линейных объектов.

Будем разбираться...

Сообщение от ShaggyDoc Но программа принципиально неверно делается. 1. Надо делать разрыв не только "линий" (программисты говорят и пишут "LINE", в крайнем случае "отрезок"), а и других типов примитивов, похожих на "линии". У них точки совсем иначе извлекаются. 2. Разрывать надо одну "линию", та, которая должна лежать ниже. Для этого надо указать не точку пересечения, а примитивы - тот, который надо разорвать и тот, которым надо разорвать. Указывать надо в любом месте, пересечений может оказаться несколько. При этом ещё учитывать, что примитивы (полилинии) могут иметь физическую ширину. В результате реальная программа вырастет в размере примерно да двухсот строк, и это если использовать библиотеки.

Мне просто надо пересекающиеся ОТРЕЗКИ разрывать, а тут уже предлагаете целый комбайн использовать...

Сообщение от ShaggyDoc Такую программу я включал в исходники к книге "САПР на базе AutoCAD - как это делается" - ru_cross_lines.lsp.

За книгу спасибо (уже нашел и качаю), будем учиться...

[Red Nova]

Оказывается заработала теперь только с spdsnoteposition, а остальные выноски в пролете...
"spdsNoteKnot"
"spdsNoteComb"
"spdsNoteChain"
Пожогите пожалуйста и для них исправить функцию _dwgru-get-spds-text-and-range.
Вот что выдает тестирование этих объектов СПДС функцией от VVA поочередно в 2010

Код:

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

Command: (entget (car(entsel "\nSelect SPDS object:")) '("*"))

Select SPDS object:((-1 . <Entity name: 7edb02e0>) (0 . "spdsNoteKnot") (330 . 
<Entity name: 7ed17cf8>) (5 . "16BC54") (100 . "AcDbEntity") (67 . 0) (410 . 
"Model") (8 . "0") (48 . 15.0) (370 . 20) (100 . "mcsDbObject") (100 . 
"mcsDbObjectNoteKnot") (90 . 1) (301 . "Name") (300 . "1") (301 . "Info") (300 
. "Узловая выноска\r\n1\r\nШвеллер 20, L=1000") (301 . "Scale") (40 . 15.0) 
(301 . "CutAcElements") (290 . 1) (301 . "WipeOut") (290 . 0) (301 . "Text 
style") (300 . "CS Arm Unicode") (301 . "XRadius") (40 . 540.145) (301 . 
"YRadius") (40 . 441.036) (301 . "NodeNumber") (300 . "1") (301 . 
"SheetNumber") (300 . "") (301 . "NodeAddress") (300 . "Швеллер 20, L=1000") 
(301 . "TextAlign") (300 . "По центру") (301 . "RackDir") (40 . 0.0) (301 . 
"TextSize") (40 . 3.5) (301 . "SmallTextSize") (40 . 2.5) (301 . "AngleStep") 
(40 . 15.0) (301 . "Circle") (290 . 0))

Command:
.ERASE
Select objects: 1 found

Select objects:

Command: _u
Command: (entget (car(entsel "\nSelect SPDS object:")) '("*"))

Select SPDS object:((-1 . <Entity name: 7edb0300>) (0 . "spdsNoteComb") (330 . 
<Entity name: 7ed17cf8>) (5 . "16BC58") (100 . "AcDbEntity") (67 . 0) (410 . 
"Model") (8 . "0") (48 . 15.0) (370 . 20) (100 . "mcsDbObject") (100 . 
"mcsDbObjectNoteComb") (90 . 1) (301 . "Name") (300 . "1") (301 . "Info") (300 
. "Гребенчатая выноска\r\n1\r\nШвеллер 20, L=1000") (301 . "Scale") (40 . 15.0) 
(301 . "CutAcElements") (290 . 1) (301 . "WipeOut") (290 . 0) (301 . "Text 
style") (300 . "CS Arm Unicode") (301 . "String1") (300 . "1") (301 . 
"String2") (300 . "Швеллер 20, L=1000") (301 . "TextAlign") (300 . "По центру") 
(301 . "RackDir") (40 . 0.0) (301 . "TextSize") (40 . 2.5) (301 . "AngleStep") 
(40 . 0.0) (301 . "LeadersCount") (90 . 2))

Command: _spREdit
Command: (entget (car(entsel "\nSelect SPDS object:")) '("*"))

Select SPDS object:((-1 . <Entity name: 7edb0308>) (0 . "spdsNoteChain") (330 . 
<Entity name: 7ed17cf8>) (5 . "16BC59") (100 . "AcDbEntity") (67 . 0) (410 . 
"Model") (8 . "0") (48 . 15.0) (370 . 20) (100 . "mcsDbObject") (100 . 
"mcsDbObjectNoteChain") (90 . 1) (301 . "Name") (300 . "1") (301 . "Info") (300 
. "Цепная выноска\r\n1\r\nШвеллер 20, L=1000") (301 . "Scale") (40 . 15.0) (301 
. "CutAcElements") (290 . 1) (301 . "WipeOut") (290 . 0) (301 . "Text style") 
(300 . "CS Arm Unicode") (301 . "String1") (300 . "1") (301 . "String2") (300 . 
"Швеллер 20, L=1000") (301 . "TextAlign") (300 . "По центру") (301 . "RackDir") 
(40 . -1.29422e-007) (301 . "TextSize") (40 . 2.5) (301 . "LeadersCount") (90 . 
4))

А сот что в 2009-м

Код:

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

Command: (entget (car(entsel "\nSelect SPDS object:")) '("*"))

Select SPDS object:((-1 . <Entity name: 7ef03538>) (0 . "spdsNoteKnot") (330 . 
<Entity name: 7ef01cf8>) (5 . "207") (100 . "AcDbEntity") (67 . 0) (410 . 
"Model") (8 . "0") (48 . 100.0) (370 . 25) (100 . "mcsDbObject") (100 . 
"mcsDbObjectNoteKnot") (90 . 1) (301 . "Name") (300 . "1") (301 . "Info") (300 
. "Узловая выноска\r\n1\r\nШвеллер 20, L=1000") (301 . "Scale") (40 . 100.0) 
(301 . "CutAcElements") (290 . 1) (301 . "Text style") (300 . "GOST 2.304") 
(301 . "Горизонтальный радиус") (40 . 3703.93) (301 . "Вертикальный радиус") 
(40 . 3537.43) (301 . "Номер узла") (300 . "1") (301 . "Номер листа") (300 . 
"") (301 . "Адрес узла") (300 . "Швеллер 20, L=1000") (301 . "Выравнивание 
текста") (300 . "По центру") (301 . "Направление полки") (40 . 0.0) (301 . 
"Высота текста") (40 . 3.5) (301 . "Высота малого текста") (40 . 2.5) (301 . 
"Шаг угла") (40 . 15.0) (301 . "Окружность") (290 . 0))

Command: (entget (car(entsel "\nSelect SPDS object:")) '("*"))

Select SPDS object:((-1 . <Entity name: 7ef03568>) (0 . "spdsNoteComb") (330 . 
<Entity name: 7ef01cf8>) (5 . "20D") (100 . "AcDbEntity") (67 . 0) (410 . 
"Model") (8 . "0") (48 . 100.0) (370 . 25) (100 . "mcsDbObject") (100 . 
"mcsDbObjectNoteComb") (90 . 1) (301 . "Name") (300 . "1") (301 . "Info") (300 
. "Гребенчатая выноска\r\n1\r\nШвеллер 20, L=1000") (301 . "Scale") (40 . 
100.0) (301 . "CutAcElements") (290 . 1) (301 . "Text style") (300 . "GOST 
2.304") (301 . "Первая строка") (300 . "1") (301 . "Вторая строка") (300 . 
"Швеллер 20, L=1000") (301 . "Выравнивание текста") (300 . "По центру") (301 . 
"Направление полки") (40 . 0.0) (301 . "Высота текста") (40 . 2.5) (301 . "Шаг 
угла") (40 . 0.0) (301 . "Количество линий-выносок") (90 . 2))

Command: (entget (car(entsel "\nSelect SPDS object:")) '("*"))

Select SPDS object:((-1 . <Entity name: 7ef03570>) (0 . "spdsNoteChain") (330 . 
<Entity name: 7ef01cf8>) (5 . "20E") (100 . "AcDbEntity") (67 . 0) (410 . 
"Model") (8 . "0") (48 . 100.0) (370 . 25) (100 . "mcsDbObject") (100 . 
"mcsDbObjectNoteChain") (90 . 1) (301 . "Name") (300 . "1") (301 . "Info") (300 
. "Цепная выноска\r\n1\r\nШвеллер 20, L=1000") (301 . "Scale") (40 . 100.0) 
(301 . "CutAcElements") (290 . 1) (301 . "Text style") (300 . "GOST 2.304") 
(301 . "Первая строка") (300 . "1") (301 . "Вторая строка") (300 . "Швеллер 20, 
L=1000") (301 . "Выравнивание текста") (300 . "По центру") (301 . "Направление 
полки") (40 . 5.63933e-011) (301 . "Высота текста") (40 . 2.5) (301 . 
"Количество линий-выносок") (90 . 2))

[Red Nova]

Не у кого пока нет идей...

[VVA]

Без привязки к версии Автокада. Данные меняются по словарю. Для замены списка добавлена функция _dwgru-prepare-spds-list.

Код:

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

(defun _dwgru-prepare-spds-list ( lst / dict )
  (setq	dict
	 '(("ПЕРВАЯ СТРОКА" "String1")
	   ("ВТОРАЯ СТРОКА" "String2")
	   ("ВЫРАВНИВАНИЕ ТЕКСТА" "TextAlign")
           ("НОМЕР УЗЛА" "NodeNumber")
	  )
  )
  (mapcar '(lambda( x / tmp)
             (if (and
                   (= (car x) 301)
                   (setq tmp (cadr(assoc (strcase (cdr x)) dict)))
                   )
               (cons 301 tmp)
               x
             )
             )
          lst
          )
)
  
           
(defun _dwgru-get-spds-text-and-range (/ selset lst)
                                      ;|
*    Возвращает список строк выделенных выносок. В набор попадают узловые выноски,
* позиционные выноски, цепные и гребенчатые.
*    Параметры вызова:
	нет
*    Примеры вызова:
(_dwgru-get-spds-text)
	;
|;
  (if
    (and
      (= (type (setq selset (vl-catch-all-apply
                              (function (lambda () (ssget)))
                              ) ;_ end of vl-catch-all-apply
                     ) ;_ end of setq
               ) ;_ end of type
         'pickset
         ) ;_ end of =
      (setq selset
             (vl-remove-if-not
               (function
                 (lambda (x)
                   (member (cdr (assoc 0 x))
                           '("spdsNotePosition"
                             ;"spdsNoteKnot" закомментировал тапорно, чтобы исключить из выбора узловые выноски
                             "spdsNoteComb"
                             "spdsNoteChain"
                             )
                           ) ;_ end of member
                   ) ;_ end of lambda
                 ) ;_ end of function
               (mapcar
                 (function (lambda (a)
                             (_dwgru-prepare-spds-list
                             (vl-remove-if-not
                               '(lambda (b) (member (car b) '(0 300 301 90)))
                               (entget a)
                               ) ;_ end of vl-remove-if-not
                              )
                             ) ;_ end of lambda
                           ) ;_ end of function
                 (_dwgru-conv-pickset-to-list selset)
                 ) ;_ end of mapcar
               ) ;_ end of vl-remove-if-not
            ) ;_ end of setq
      ) ;_ end of and
     (setq
       lst
        (mapcar
          (function
            (lambda (item)
              (cond
                ((= (cdr (assoc 0 item)) "spdsNoteKnot")
                 (append (mapcar
                           (function cdr)
                           (vl-remove-if-not
                             (function
                               (lambda (x)
                                 (= (car x) 300)
                                 ) ;_ end of lambda
                               ) ;_ end of function
                             (reverse
                               (member '(301 . "TextAlign") ;ВЫРАВНИВАНИЕ ТЕКСТА
                                       (reverse (member
                                                  '(301 . "NodeNumber")  ; Номер узла
                                                  item))
                                       ) ;_ end of member
                               ) ;_ end of reverse
                             ) ;_ end of vl-remove-if-not
                           ) ;_ end of mapcar
                         (list 1)
                         ) ;_ end of append
                 )
                ((= (cdr (assoc 0 item)) "spdsNotePosition")
                 (append (mapcar
                           (function cdr)
                           (vl-remove-if-not
                             (function
                               (lambda (x)
                                 (= (car x) 300)
                                 ) ;_ end of lambda
                               ) ;_ end of function
                             (member '(301 . "String1");Первая строка
                                     item)
                             ) ;_ end of vl-remove-if-not
                           ) ;_ end of mapcar
                         (list 1)
                         ) ;_ end of append
                 )
                ((member (cdr (assoc 0 item))
                         '("spdsNoteComb" "spdsNoteChain")
                         ) ;_ end of member
                 (append
                   (mapcar
                     (function cdr)
                     (vl-remove-if-not
                       (function
                         (lambda (x)
                           (= (car x) 300)
                           ) ;_ end of lambda
                         ) ;_ end of function
                       (reverse
                         (member '(301 . "TextAlign") ; Выравнивание текста
                                 (reverse (member '(301 . "String1") ;Первая строка
                                                  item))
                                 ) ;_ end of member
                         ) ;_ end of reverse
                       ) ;_ end of vl-remove-if-not
                     ) ;_ end of mapcar
                   (list (cdr (assoc 90 (reverse item))))
                   ) ;_ end of cons
                 )
                ) ;_ end of cond
              ) ;_ end of lambda
            ) ;_ end of function
          selset
          ) ;_ end of mapcar
       ) ;_ end of setq
     ) ;_ end of if
  lst
  ) ;_ end of defun

[alex8888]

Привет всем!

Подскажите, пожалуйста, что неправильно в моей конструкции:

(vl-cmdf "_fillet" "_r" f_r f_1 f_2)
здесь f_r - радиус скругления
f_1 и f_2 точки на пересекающихся перпендикулярно сторонах прямоугольника.

Мне выдает в окне по F2 в Акаде вот что:
Befehl: _fillet
Aktuelle Einstellungen: Modus = STUTZEN, Radius = 30.0
Erstes Objekt wählen oder [rÜckgängig/Polylinie/Radius/Stutzen/Mehrere]: _r
Rundungsradius angeben <30.0>: 30.00000000000000
Befehl:
Befehl:
Далее - ничего не происходит.
Что то нужно после задания радиуса вставить, только что и как? При вводе в командной строке все проходит, но там я "мышой" выбираю стороны скругления.


Здесь Befehl - это команда, Aktuelle Einstellungen - актуальные настройки,
Rundungsradius angeben - ввод радиуса скругления, Erstes Objekt wählen oder - выбрать первый объект или..., далее перечисления возможных вариантов.

И еще вопросик. Посредством VLA-тыры-пыры есть команда на скругление? Не могу найти пока никак.

[Do$]

В команду fillet нужно передавать не точки, а примитивы. Точно не скажу, в каком виде, но либо в таком, как их возвращает функция entsel, либо просто ename - (car (entsel)).

И еще вопросик. Посредством VLA-тыры-пыры есть команда на скругление? Не могу найти пока никак.

Насколько я знаю - нет.

[alex8888]

В команду fillet нужно передавать не точки, а примитивы

Хорошо, тогда каким образом передать команде Fillet две стороны прямоугольника, образованной полилинией? Сам прямоугольник я могу сохранить в виде примитива, а что дальше?

[ShaggyDoc]

Сообщение от alex8888 Хорошо, тогда каким образом передать команде Fillet две стороны прямоугольника, образованной полилинией? Сам прямоугольник я могу сохранить в виде примитива, а что дальше?

Для полилинии нельзя и ненужно передавать две стороны. Команда запрашивает только один примитив при использовании полилинии.

Неужели трудно промоделировать все варианты запросов и ответов в командной строке?

[Do$]

Сорри, не в те дебри полез
(vl-cmdf "_fillet" "_r" f_r f_1 f_2)
после f_r не хватает "":
(vl-cmdf "_fillet" "_r" f_r "" f_1 f_2)
Так должно работать.

[alex8888]

ShaggyDoc

Для полилинии нельзя и ненужно передавать две стороны.

Мне не нужно скруглять все углы, а только выборочные. Поэтому мне необходимо указать какие стороны надо выбрать. Как это сделать? Я выбрал точки посередине сторон и передаю их в функцию в качестве указания объектов.

Do$

не получилось.

Во вложении весь текст программки, может быть копаться в другую сторону?

[ShaggyDoc]

Мне не нужно скруглять все углы, а только выборочные. Поэтому мне необходимо указать какие стороны надо выбрать. Как это сделать? Я выбрал точки посередине сторон и передаю их в функцию в качестве указания объектов.

Мало ли кому что не нужно. Команда FILLET скругляет все углы полилинии - так уж устроен Автокад. Если надо скруглять разные углы - не надо пользоваться полилинией. Тогда и работа команды будет совсем иная.

[Do$]

Хм, вот ведь странность - fillet ведет себя по разному, если вручную выполнять и через vl-cmdf. После указания радиуса, команда прекращается.
Поэтому, думается мне, надо либо два раза запускать vl-cmdf
(vl-cmdf "_.fillet" "_r" f_r)
(vl-cmdf "_.fillet" f_1 f_2)
Либо для задания радиуса менять системную переменную filletrad.

Команда FILLET скругляет все углы полилинии - так уж устроен Автокад.

Не знаю, как с "POLILINE", но если применять fillet к "LWPOLYLINE", то можно по одному углу скруглять... При этом в команду передаются точки вблизи тех участков, между которыми делаем скругление:

Код:

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

(vl-cmdf "_.fillet" (cadr (entsel "\nFirst line:")) (cadr (entsel "\nSecond line:")))

[alex8888]

Добавил строку :
(setvar "filletrad" f_r),

и изменил:
(vl-cmdf "_.fillet" f_1 f_2)

Все работает. Спасибо.

Теперь вопрос как получить скругление 2х соседних углов , если радиус скругления равен половине длины общей стороны? Первый угол скругляется правильно, второй уже нет. Если нужно закруглить только противоположные углы, то все проходит нормально.

[Do$]

Сообщение от alex8888 как получить скругление 2х соседних углов , если радиус скругления равен половине длины общей стороны?

Нарисовать дугу вручную.

[alex8888]

Нарисовать дугу вручную.

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


Решил задачу проще - взял точки не посередине скругляемой стороны, а ближе к углу - все работает как надо. Только точек добавилось
:
f_9 (polar f_1 0 (* 0.25 f_l)) ;9+10 - rechts unten
f_10 (polar f_2 (* pi -0.5) (* 0.25 f_h))
f_11 (polar f_2 (* pi 0.5) (* 0.25 f_h)) ;11+12 - rechts oben
f_12 (polar f_3 0 (* 0.25 f_l))
f_13 (polar f_3 pi (* 0.25 f_l)) ;13+14 - links oben
f_14 (polar f_4 (* pi 0.5) (* 0.25 f_h))
f_15 (polar f_4 (* pi -0.5) (* 0.25 f_h)) ;15+16 - links unten
f_16 (polar f_1 pi (* 0.25 f_l))

(vl-cmdf "_fillet" f_9 f_10) ;rechts unten Ecke

(vl-cmdf "_fillet" f_11 f_12) ;rechts oben Ecke

(vl-cmdf "_fillet" f_13 f_14) ;links oben Ecke

(vl-cmdf "_fillet" f_15 f_16) ;links unten Ecke

[Red Nova]

VVA
Спасибо за код, пока правда так и не проверил, все занят покупкой новой машини . Ах как приятно перестать ощущать себя пешиходом

[Do$]

alex8888, не ищете вы легких путей...
В вашем случае надо отрисовывать полилинией прямоугольник со скругленными углами: простой арифметикой можно определить точки и создать полилинию функцией entmake или entmakex.

[alex8888]

Do$,
а нельзя наводку, как именно через enmake-entmakex и чем же легче? Посмотрел описание - немного вспотел Не понимаю (пока ).

Поначалу я делал так: рассчитывал каждую точку, потом по ним рисовал замкнутую полилинию. Но была трудность, что как то коряво рисовались дуги после прямых линий (конструкция типа (vl-cmdf "_pline" p1 "_l" p2 "_a" "_center" p3 p4 "_l" p5 ..... "_close"). Так вот некоторые дуги почему то рисовались развернутыми в обратную сторону (не наружу, а внутрь)). Поэтому я и решил посмотреть на _fillet. Может есть более простое решение?

[ShaggyDoc]

Может есть более простое решение?

Простое решение - рисовать полилинию с дуговыми сегментами в правильном порядке обхода вершин. Чтобы не выгибалось, куда не надо.

Для этого достаточно просто вручную промоделировать ситуацию - рисовать последовательно со всеми опциями, вводя их в командной строке. Точки можно указывать примерно - сразу будет видно, куда выгибается дуга.

Командный метод - самое простое решение. Сначала надо им научиться делать, пройти через детские ошибки №1 и №2. Можно и через entmake, и через ActiveX, но там уж вовсе больше изучать надо.

[Do$]

Ну как-то так:

Код:

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

(defun make-filled-rectangle  (rec_length rec_hight rec_radius base_pt)
         ;|
Функция рисования прямоугольника со скругленными углами "облегченной" полилинией (LWPOLYLINE).
Аргументы:
 rec_length - Длина прямоугольника
 rec_hight - Высота прямоугольника
 radius - Радиус скругления углов
 base_pt - Центр прямоугольника, координаты в виде списка (Х У)
Примечание: Построение происходит в мировой системе координат, поэтому базовую точку
следует задавать также в МСК.
Возвращаемое значение:
 ename созданной "облегченной" полилинии или nil при неудаче.
Пример вызова:
  (make-filled-rectangle 200 300 20 ((lambda (lst) (list (car lst) (cadr lst)))
  (trans (getpoint "\nSelect base point:") 1 0)))
  |;
  (entmakex
    (append
      (quote ((0 . "LWPOLYLINE")
        (100 . "AcDbEntity")
;;;      (67 . 0)
;;;      (410 . "Model")
;;;      (8 . "0")
        (100 . "AcDbPolyline")
        (90 . 8)
        (70 . 1)
        (43 . 0.0)
        (38 . 0.0)
        (39 . 0.0)))
      (list
 (cons 10 (mapcar (function +) (list (/ rec_length 2) (- rec_radius (/ rec_hight 2))) base_pt)) ;_ 1pt
 (cons 40 0.0)
 (cons 41 0.0)
 (cons 42 0.0)
 (cons 10 (mapcar (function +) (list (/ rec_length 2) (- (/ rec_hight 2) rec_radius)) base_pt)) ;_ 2pt
 (cons 40 0.0)
 (cons 41 0.0)
 (cons 42 0.414214)
 (cons 10 (mapcar (function +) (list (- (/ rec_length 2) rec_radius) (/ rec_hight 2)) base_pt)) ;_ 3pt
 (cons 40 0.0)
 (cons 41 0.0)
 (cons 42 0.0)
 (cons 10 (mapcar (function +) (list (- rec_radius (/ rec_length 2)) (/ rec_hight 2)) base_pt)) ;_ 4pt
 (cons 40 0.0)
 (cons 41 0.0)
 (cons 42 0.414214)
 (cons 10 (mapcar (function +) (list (- (/ rec_length 2)) (- (/ rec_hight 2) rec_radius)) base_pt)) ;_ 5pt
 (cons 40 0.0)
 (cons 41 0.0)
 (cons 42 0.0)
 (cons 10 (mapcar (function +) (list (- (/ rec_length 2)) (- rec_radius (/ rec_hight 2))) base_pt)) ;_ 6pt
 (cons 40 0.0)
 (cons 41 0.0)
 (cons 42 0.414214)
 (cons 10 (mapcar (function +) (list (- rec_radius (/ rec_length 2)) (- (/ rec_hight 2))) base_pt)) ;_ 7pt
 (cons 40 0.0)
 (cons 41 0.0)
 (cons 42 0.0)
 (cons 10 (mapcar (function +) (list (- (/ rec_length 2) rec_radius) (- (/ rec_hight 2))) base_pt)) ;_ 8pt
 (cons 40 0.0)
 (cons 41 0.0)
 (cons 42 0.414214)
 (list 210 0.0 0.0 1.0)))))

[Елпанов Евгений]

Сообщение от alex8888 Do$, а нельзя наводку, как именно через enmake-entmakex и чем же легче? Посмотрел описание - немного вспотел Не понимаю (пока ). Поначалу я делал так: рассчитывал каждую точку, потом по ним рисовал замкнутую полилинию. Но была трудность, что как то коряво рисовались дуги после прямых линий (конструкция типа (vl-cmdf "_pline" p1 "_l" p2 "_a" "_center" p3 p4 "_l" p5 ..... "_close"). Так вот некоторые дуги почему то рисовались развернутыми в обратную сторону (не наружу, а внутрь)). Поэтому я и решил посмотреть на _fillet. Может есть более простое решение?

Что то я не понял, зачем нужна программа, если есть встроенная функция рисования прямоугольников со скругленными углами?
Вот копия из ком строки:

Код:

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

Command: rec RECTANG
Current rectangle modes:  Fillet=50.0000
Specify first corner point or [Chamfer/Elevation/Fillet/Thickness/Width]: f
Specify fillet radius for rectangles <50.0000>: 10
Specify first corner point or [Chamfer/Elevation/Fillet/Thickness/Width]:
Specify other corner point or [Area/Dimensions/Rotation]:

[alex8888]

ShaggyDoc

Простое решение - рисовать полилинию с дуговыми сегментами в правильном порядке обхода вершин. Чтобы не выгибалось, куда не надо.

1.Это как в правильном? Обход правый нижний угол-правый верхний-левый верхний-левый нижний будет являться правильным?
2.При проходе вручную функции _pline тем же порядком, что и в программе, контур получается правильным, а из программы нет. Почему? Из-за скорости проведения линии вручную?

пройти через детские ошибки №1 и №2

это какие? №1-Не лезь куда не просят, потому как все равно дурак и №2-см №1
Про привязки уже уяснил, хотя не попадал в такие ситуации, где они бы помешали.

Еще открытым для меня остается вопрос, как подгрузить вспомогательную пользовательскую функцию из другой пользовательской, типа ru-трам-пам-пам из _ru-тра-ля-ля? Когда вписываю несколько функций в один Lisp, то команда из функции работает, равно как и если была прописана вспомогательная функция в автозагрузке через appload. Но все функции без надобности грузить в каждый чертеж? Или прописывать абсолютные пути в основной лисп?

Do$,
1. По твоему коду получается проще? И что мне теперь для каждого из 16 вариантов делать свою полилинию через entmakex? В чем выигрыш?
2. Зачем делать преобразования систем координат? Я только, как понимаю, всегда в МСК работаю.

Елпанов Евгений

Что то я не понял, зачем нужна программа, если есть встроенная функция рисования прямоугольников со скругленными углами?

1. Она лепит только со всеми скругленными углами.
2. Использование вертикальных решений мне еще в начале программирской деятельности рекомендовали не использовать.
3. Данная прога только прелюдия для более масштабного проекта, так сказать учусь, пробую, экспериментирую.

[Do$]

Сообщение от alex8888 1. По твоему коду получается проще?

Для меня проще, ибо командные методы - тот еще головнячок. В одной версии команда может иметь одни опции, в другой - другие и пр. неприятности. Entmakex же будет работать одинаково и стабильно и в 2000, и в 2010 AutoCAD'е.

Сообщение от alex8888 И что мне теперь для каждого из 16 вариантов делать свою полилинию через entmakex?

16 вариантов? То есть у каждого угла может быть или не быть скругление? Можно добавить в функцию обработку этих вариантов. Или сделать функцию - аналог fillet со входными параметрами: ename прямоугольника и координата вершины, в которой нужно сделать скругление...
Делай как хочешь, просто мое мнение - от vl-cmdf и command в программе желательно избавляться.

Сообщение от alex8888 Зачем делать преобразования систем координат? Я только, как понимаю, всегда в МСК работаю.

Если делаешь программу только для себя - то сойдет, а если планируется потом раздавать коллегам, то вполне может оказаться, что они не все работают в МСК. При использовании командных методов, об этом не надо задумываться - все всегда рисуется в текущей СК, а при использовании entmake о СК приходится всегда помнить и, при необходимости, производить преобразования.

[ShaggyDoc]

Сообщение от alex8888 ShaggyDoc 1.Это как в правильном? Обход правый нижний угол-правый верхний-левый верхний-левый нижний будет являться правильным? 2.При проходе вручную функции _pline тем же порядком, что и в программе, контур получается правильным, а из программы нет. Почему?

Наверное потому, что команда запрашивает одни точки, а программно ты выдаешь другие. Для предотвращения "выворотки" дуги надо тщательно продумывать.

Сообщение от alex8888 это какие? №1-Не лезь куда не просят, потому как все равно дурак и №2-см №1 Про привязки уже уяснил, хотя не попадал в такие ситуации, где они бы помешали.

Вот это и есть ошибка - думаешь, что раз не попадал, то и не попадешь. А попадешь обязательно.

Ещё одну указал Do$ - никогда нельзя забывать про системы координат. Помнить, что get-функции возвращают точки в ПСК, command работает в ПСК, а данные примитивов будут в МСК.

Сообщение от alex8888 Еще открытым для меня остается вопрос, как подгрузить вспомогательную пользовательскую функцию из другой пользовательской, типа ru-трам-пам-пам из _ru-тра-ля-ля? Когда вписываю несколько функций в один Lisp, то команда из функции работает, равно как и если была прописана вспомогательная функция в автозагрузке через appload. Но все функции без надобности грузить в каждый чертеж?

Должна быть постоянно загружаемая библиотека (сборник) функций, доступных во всех "конечных" программах. К необходимости такой библиотеки придешь сам, когда в двадцатый раз будешь описывать одно и то же, причем каждый раз с новыми ошибками. А про "без надобности" не надо переживать. Вот сотни функций Автокада многим "без надобности", но их не вырезают.

Сообщение от alex8888 Или прописывать абсолютные пути в основной лисп?

Самый худший путь. Любая программа должна вычислять, где она сама живет и где находятся требуемые файлы.

И что мне теперь для каждого из 16 вариантов делать свою полилинию через entmakex? В чем выигрыш?

Надо делать одну библиотечную функцию с таким набором аргументов, который позволит нарисовать сколько угодно вариантов.

[alex8888]

ShaggyDoc
ну подскажи ты дураку, ну как мне сделать

постоянно загружаемую библиотеку (сборник) функций, доступных во всех "конечных" программах

Я уже давно пришел к этому, но не получается сделать по уму. Из всего, что смог:
1. В пути к файлам настроек Када прописал директорию с моими Лиспами.
2. При вводе команды Appload прописал там где нарисован портфель, все Лиспы, которые нужно загружать каждый раз. Там набрался список из пары десятков уже.
Книгу "САПР на базе Автокада" "пролистал" (штудирую по мере сил и возможностей), жаль представленные примеры без переработки проверить не могу - нерешенная проблема с отображением русского языка в каде. Да и профиль у меня машиностроительный, что несколько отличается от представленного в книге для строителей.

Насчет

Вот это и есть ошибка - думаешь, что раз не попадал, то и не попадешь. А попадешь обязательно.

уже застраховался, в некоторых случаях аж дважды Но советами не пренебрегаю, спасибо.

Для предотвращения "выворотки" дуги надо тщательно продумывать

Продумываю. Поэтому склоняюсь к кардинальным мерам - если не получается после долгих мучений задуманное, то сношу все к чертям и придумываю новый путь. Жаль, приходиться работать подпольно - буржуи на это времени не спонсируют.

Или прописывать абсолютные пути в основной лисп?

Полностью согласен, потому как это самая большая из глупостей, которая может придти на ум (ну после начала программирования )

Надо делать одну библиотечную функцию с таким набором аргументов, который позволит нарисовать сколько угодно вариантов.

Именно это я и пытаюсь изобразить. Поначалу создавал конкретно этот Лисп для построения плат "ног" для емкостей, которые мы производим. Потом решил, что отверстия в пате можно комбинировать и располагать в разных часто встречающихся и повторяющихся положениях, потом дошел до того, что некоторые платы можно или нужно скруглять, наконец, что раз скругления делаются тоже по выбору - какие надо углы, то можно и таким же образом делать уши для подъема емкости краном. Сюда же входит целый набор всевозможных плат заземлителей, держателей и тп. Все они построены по единому принципу, но каждая деталь отбирает кучу времени. В 2010 (да и уже в 2009) Каде есть параметризация, но Лисп уже был написан, да и что то не лежит душа к параметризации конкретной задачи. Вот днища по Din 28011 или 28013 в параметризации прижились крепко, а Лисп создать корректно так и не смог - не хватило математики в аппроксимации.

[Кулик Алексей aka kpblc]

В функцию http://forum.dwg.ru/showthread.php?t=16561 подставить свои маски lsp-файлов и последовательно выполнить (load file) - один из вариантов. Несмотря на некоторые трудности в последних версиях AutoCAD (см., например, http://autolisp.ru/2009/12/09/load_complie_write/ и http://autolisp.ru/2009/12/09/load_complie_write/ ) - вполне реальный.
Если не испугает использование библиотечных функций, вот тебе вариант рисования полилинии (вроде работало ):

Код:

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

(defun _kpblc-ent-create-lwpline (lst point-list / res point_list)
                                 ;|
*    Функция добавления полилинии в указанное пространство.
*    Параметры вызова:
*	lst	- список точечных пар вида:
*		'(("where" . <Куда добавлять>)	; в какой блок / пространство
*				добавлять полилинию (vla-указатель). nil -> активное пространство
*		("closed" . t / nil)		; замкнутая полилиния. nil -> нет
*		("lineweight" . aclnwt025)		; вес полилинии. nil -> aclnwt000
*		("ltype" . "Continuous")	; тип линии. nil -> Continuous (только английский, нижний регистр)
*		("ltypefile" . "acadiso.lin")	; файл, из которого грузить тип линии (nil -> acadiso.lin)
*		("color" . 0)			; цвет. nil -> (getvar "cecolor")
*		("layer" . "test")		; слой. nil -> "0"
*		("width" . 0)			; изменение глобальной ширины
						; полилинии (группа 39). nil -> 0
*		(cons "normal" '(0. 0. 1.))	; система координат, в которой
			; создавать примитив. nil -> текущая
		(cons "round"(list (cons 0 -1)(cons 1 -2)))	; список участков полилинии
			; с устанавливаемой кривизной (тангенс четверти
			; центрального угла)
*		)
*	point-list	список точек (переводится в 2Д)
*    Возвращает vla-указатель на созданную полилинию либо nil в случае неудачи
*    Примеры вызова:
(_kpblc-ent-create-lwpline (list
	(cons "closed" t)
	(cons "round" '((0 . -1.) (2 . 0.5))))
	'((0. 0.)(10. 10.)(0. 20.)(-10. 10.)))
|;
  (_kpblc-error-catch
    (function
      (lambda ()
        (setq point-list (apply
                           (function append)
                           (mapcar (function (lambda (x) (list (car x) (cadr x))))
                                   point-list
                                   ) ;_ end of mapcar
                           ) ;_ end of apply
              res        (vla-addlightweightpolyline
                           (if (and (assoc "where" lst)
                                    (cdr (assoc "where" lst))
                                    ) ;_ end of and
                             (cdr (assoc "where" lst))
                             (_kpblc-get-active-space-obj)
                             ) ;_ end of if
                           (vlax-make-variant
                             (vlax-safearray-fill
                               (vlax-make-safearray
                                 vlax-vbdouble
                                 (cons 0 (1- (length point-list)))
                                 ) ;_ end of vlax-make-safearray
                               point-list
                               ) ;_ end of vlax-safearray-fill
                             ) ;_ end of vlax-make-variant
                           ) ;_ end of vla-addlightweightpolyline
              ) ;_ end of setq
        (if (cdr (assoc "round" lst))
          (foreach item (cdr (assoc "round" lst))
            (_kpblc-error-catch
              (function
                (lambda ()
                  (vla-setbulge res (car item) (cdr item))
                  ) ;_ end of lambda
                ) ;_ end of function
              '(lambda (x)
                 (princ (strcat "\nНевозможно задать кривизну "
                                (car item)
                                " участку полилинии"
                                ) ;_ end of strcat
                        ) ;_ end of princ
                 ) ;_ end of lambda
              ) ;_ end of _kpblc-error-catch
            ) ;_ end of foreach
          ) ;_ end of if
        (foreach item (list (list "closed" "closed" :vlax-false)
                            (list "lineweight" "lineweight" aclnwt000)
                            '("ltype" "linetype" "Continuous")
                            (list "color" "color" (getvar "cecolor"))
                            '("layer" "layer" "0")
                            '("width" "ConstantWidth" 0)
                            ) ;_ end of list
          (if (member (car item) lst)
            (setq lst (subst (cons (cadr item) (cdr (assoc (car item) lst))) (assoc (car item) lst) lst))
            (setq lst (append lst (list (cdr item))))
            ) ;_ end of if
          ) ;_ end of foreach
        (foreach item lst
          (vl-catch-all-apply
            (function
              (lambda ()
                (vlax-put-property res (car item) (cadr item))
                ) ;_ end of lambda
              ) ;_ end of function
            ) ;_ end of vl-catch-all-apply
          ) ;_ end of foreach
        ) ;_ end of lambda
      ) ;_ end of function
    (function
      (lambda (x)
        (_kpblc-error-print "_kpblc-ent-create-lwpline" x)
        (setq res nil)
        ) ;_ end of lambda
      ) ;_ end of function
    ) ;_ end of _kpblc-error-catch
  res
  ) ;_ end of defun

Анализируй Задачи, решаемые недостающими функциями, по идее и так понятны должны быть.
---
P.S. По голове прошу не бить - она и без того "чугуниевая"

[alex8888]

Кулик Алексей aka kpblc
спасибо, посмотрю на работе, а

(см., например, http://autolisp.ru/2009/12/09/load_complie_write/ и http://autolisp.ru/2009/12/09/load_complie_write/ )

ссылаются на одно и тоже место или есть там различия?

Что вкратце делает твоя функция рисования полилиний?

[Кулик Алексей aka kpblc]

Сорри, вторая ссылка : http://autolisp.ru/2009/12/25/loadcomplie_write_2/
Как "что делает"? Если есть все библиотечные функции, то рисует полилинию с указанными параметрами. А в данном случае выступает в качестве примера для анализа, не более.

[alex8888]

Кулик Алексей aka kpblc

Как "что делает"?...рисует полилинию с указанными параметрами

Вот и вопрос, какую и зачем? Пол-страницы текста и все намудрено и непонятно (для меня, чайника ).
Например у меня в программе просто рисуется прямоугольник и скругляются его углы, которые выбираются в диалоговом окне. Все остальное рисуется и проставляется автоматом. Это просто прога для конкретно моей задачи. И составлял я ее только для облегчения работы, ускорения, для устранения повторяющихся монотонных вычислений и действий. С удовольствием использую коды форумчан, если они мне подходят и если я в них разобрался. Потому как все равно подстраиваю их под себя, например, перевожу всю кириллицу или добавляю слои, уровни и тп.

[Кулик Алексей aka kpblc]

Кое-что о параметрах вызова, как я это понимаю: http://autolisp.ru/2009/10/21/lisp-overloading/

Сообщение от alex8888 Вот и вопрос, какую и зачем?

Какую? Какую будет приказано. Зачем? Ну было же приказано

Сообщение от alex8888 у меня в программе просто рисуется прямоугольник и скругляются его углы, которые выбираются в диалоговом окне

А я бы сначала сделал диалоговое окно, и потом по результатам выполнения рисовал полилинию.

[alex8888]

Кулик Алексей aka kpblc

А я бы сначала сделал диалоговое окно, и потом по результатам выполнения рисовал полилинию.

А я так и сделал Поначалу проблематично было диалоговое окно делать - не мог "въехать" в синтаксис action_tile. У Полещука достаточно туманно описана эта команда, больше даны описания диалоговых окон, а вот на Афролиспе разжевано все очень подробно (еще бы так легко читалось по англицки -было бы вообще все замечательно). Если есть желание, посмотри, что у меня получилось. Это пока последняя версия, вроде бы все работает. И можешь, наверное, подсказать, какие еще функции в библиотеку перевести или наоборот взять.

[Кулик Алексей aka kpblc]

Сейчас пытаюсь написать статью про динамические диалоговые окна...
А так, сразу:
По поводу lsp:

• Почему *error* не сделана локальной?
• Нет меток начала и конца отмены (подробнее см., например, http://autolisp.ru/2009/09/20/howto_undo/ ).
• Зачем такое количество неинформативных названий переменных? Не проще ли засунуть их в список и брать оттуда?
• Опять же, насчет информативности: ключи в dcl я бы делал понятными. Понадобится переделывать программу через полгода - получится, что ее проще переписать заново.
• Глобальные переменные достаточно тяжело идентифицировать.
• action_tile я бы засовывал в отдельные локальные функции
• Почему не используется конструкция типа (done_dialog 0) / (done_dialog 1) и т.п. с анализом возвращаемого значения?
• Создание и настройку слоя я бы вынес в отдельную функцию. В имеющемся варианте кода однозначность работы гарантировать тяжеловато.
• Выполнение команды (vl-cmdf "_.layer" "_s" "Schrift" "") в файле, где этого слоя нет, не гарантирует корректности работы.
• filletrad обратно не возвращается
• Создание текста командными методами тоже не гарантирует корректности работы (прежде всего из-за того, что пользователь может установить высоту текста в стиле равной 0. А это не отслеживается никак. Создание текста я бы тоже выносил в отдельную функцию.
• Ну и создание полилинии - тоже в отдельную функцию.

Примерно так.

[alex8888]

Кулик Алексей aka kpblc
"Много еще не доработано, Аполлон, много, вот стану директором НУИНУ, обязательно подниму вопрос" - что то типа того из "Чародеев".
Будем копать дальше.
1.

Нет меток начала и конца отмены

Достаточно, если поставить
(vla-StartUndoMark (vla-Get-ActiveDocument (vlax-Get-Acad-Object)))
после команды (vl-load-com),а перед закрывающей скобкой основной функции после возврата переменных osmode и oldlay:
(vla-EndUndoMark (vla-Get-ActiveDocument (vlax-Get-Acad-Object)))?
Или нет?
2. Что значит

Почему *error* не сделана локальной?

?
Должен ли я при определении локальных переменных основной функции дописать туда msg и (или) *error* (хотя последнее- это команда) ? Или ты имеешь ввиду что то другое?
3.

Зачем такое количество неинформативных названий переменных? Не проще ли засунуть их в список и брать оттуда?

Поясни, как сделать со списком (примерно). Переменные я зашифровывал таким образом: первая буква - от имени функции, потом через подчеркивание переменная, длина, высота и тп (от немецких названий - Länge, Breite и тп). Для меня так казалось удобнее.
4.

Опять же, насчет информативности: ключи в dcl я бы делал понятными. Понадобится переделывать программу через полгода - получится, что ее проще переписать заново.

Тоже, что и в п.3. Насчет переделать- пока учусь еще ничего, но уже сталкивался с тем, что переписать проще заново, хотя у меня есть ключи к шифрам. Но идеи приходят, кардинальным образом требующие изменения самой программы, поэтому проще сделать снова, чем переделывать старое.
5.

Глобальные переменные достаточно тяжело идентифицировать.

По-моему, я их не делал Или?
6.

action_tile я бы засовывал в отдельные локальные функции

Покажи, пожалуйста, как. Можно ли как то универсализировать? А то каждый раз ломаю голову - какая нибудь пакость да случается.
7.

Почему не используется конструкция типа (done_dialog 0) / (done_dialog 1) и т.п. с анализом возвращаемого значения?

Ответ до банальности прост: не умею Если (done_dialog) еще понятен, то почему или зачем (done_dialog 0) / (done_dialog 1) - это несколько диалоговых окон, что ли?
8.

Создание и настройку слоя я бы вынес в отдельную функцию. В имеющемся варианте кода однозначность работы гарантировать тяжеловато.

Сам бы хотел, да ума нет. Попробую с твоей подсказкой по поводу загрузки лиспов поработать, чтобы вынести как библиотечную функцию.
9.

Выполнение команды (vl-cmdf "_.layer" "_s" "Schrift" "") в файле, где этого слоя нет, не гарантирует корректности работы.

Мне пока было достаточно, что текст попадает именно на этот слой и не мешает основному, а что цвет и тп не тот, я смирился. В будущем планирую посмотреть.
10.

filletrad обратно не возвращается

И не надо, пусть и будет такой, все равно каждый раз нужно пересматривать и подставлять новый.
11.

Создание текста не командными методами....

С этим прошу помочь. Просто туплю, а делать надо.
12.

Ну и создание полилинии - тоже в отдельную функцию.

А для конкретного случая как? Конечно, если все мои поделки будут использовать одну внешнюю, но универсальную функцию, то я готов "целовать песок" по которому пройдет тот, кто наставит меня на путь истинный

[Кулик Алексей aka kpblc]

1. По факту у меня типовой код выглядит так:

Код:

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

(vl-load-com)

(defun c:cmd1 (/ *error* adoc)

  (defun *error* (msg)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ end of defun

  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

А наполнение потом. В том числе и *error*
2. Ошибки (скажу честно, повторяться лениво): http://autolisp.ru/2009/09/13/error-catch/
3. Я бы делал, наверно, так (правда, я и привык к англ.вариантам):

Код:

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

(setq var_lst '(("f_l" . 0.) ("f_n" . 0.) ...)

"Забирать" данные становится проще: (setq var (cdr (assoc "f_l" var_lst))) или (cdr(assoc "f_n" var_lst)) и т.п. И в качестве локальных переменных надо вводить одну var_lst, а не сотню (практически гарантированно рано или поздно что-то забудется). Но тут надо смотреть на целесообразность такого решения.
5. А как же rb1, rb2 и т.п.?
6. Давно не игрался с dcl, но я бы делал примерно так:

Код:

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

(action_tile "rb1" "(fun_action-rb1)")

И в качестве локальной функции уже сделать

Код:

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

(defun fun_action-rb1 ()
  (setq f_typ 0)
  (mode_tile "eb4" 0)
  (mode_tile "eb5" 1)
  (mode_tile "eb6" 0)
  (mode_tile "eb7" 1)

  (setq	w (dimx_tile "im1") ;get image tile width
	h (dimy_tile "im1") ;get image tile height
	) ;setq
  (start_image "im1") ;start the image
  (fill_image 0 0 (* 2 w) h -15)
  (slide_image 0 0 (* 2 w) h "fuss1") ;display a slide   
  (end_image)
  ) ;_ end of defun

Вносить изменения будет проще. А если еще и параметры вызова использовать, то вообще можно будет обойтись всего одной функцией.
7. Попробуй сделать так:

Код:

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

(action_tile "Accept" "(done_dialog 1)")
(action_tile "Cancel" "(done_dialog 0)")

(setq dlg_res (start_dialog))
(unload_dialog)

(if (= dlg_res 0) (alert "Cancelled!") (alert "Continue!"))

8. О чем задумывался я, когда создавал подобный лисп:
- в каком документе создавать (ведь можно и не текущий обрабатывать)
- если слоя нет, то его надо создавать и настраивать.
- если слой есть, то его надо настраивать.
- в слое есть свойство "типа линии". Этот тип линии может отсутствовать в документе, то есть его надо подгружать. Возможно, из нестандартных файлов *.lin. Которые, в свою очередь, могут находиться не в путях поиска. Закошмарил?
11. Либо делать через entmakex, либо через vla-addtext. Извини, сейчас полноценно показать не могу. А если все же использовать командные методы, то получится нечто типа:

Код:

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

(if (= (cdr (assoc 40 (entget (tblobjname "style" (getvar "textstyle"))))) 0.)
  (vl-cmdf "_.text" f_t1 "30" "" f_text)
  (vl-cmdf "_.text" f_t1 "" f_text)
  ) ;_ end of if

Расширять уже надо будет самостоятельно
12. Не сейчас. Скажу честно, времени и мозгов именно сейчас не хватает

[alex8888]

Кулик Алексей aka kpblc
к п.12 Понятно, не хочешь, чтобы я за тобой на карачках ползал

Подскажи, пожалуйста, как сформировать полученный программой dwgru-browsefiles-in-directory список, чтобы передать его на загрузку. А то только показывается в окне, что есть по такому то пути такие то файлы и все.

Тут сообразил, что если в программе задать (load file), где файл - мой лисп, то можно оперативно подгружать недостающие функции. Типа, если команда не найдена, то загрузить функцию с этой командой, потом снова выполнить ее. Это может заметно упростить листинг основной функции, введя несколько вспомогательных библиотечных.

[magiker]

Подскажите пожалуйста =) Есть функция

Код:

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

(defun Beta (a b g h)
  (
   (setq ChTg2b	(* 2 (+ (* a h) (* b g)))
	 ZnTg2b	(- (- (expt a 2) (expt h 2)) (- (expt b 2) (expt g 2)))
	 tg2b	(/ ChTg2b ZnTg2b))
   (/ (atan tg2b) 2)
  )
)

На ней выдается ошибка unknown format directive: "["
В каком месте эта ошибка-то? Заранее спасибо

[Do$]

Выделил скобки, которые тут лишние:

Код:

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

(defun Beta (a b g h)
  (
   (setq ChTg2b	(* 2 (+ (* a h) (* b g)))
	 ZnTg2b	(- (- (expt a 2) (expt h 2)) (- (expt b 2) (expt g 2)))
	 tg2b	(/ ChTg2b ZnTg2b))
   (/ (atan tg2b) 2)
  ))

[magiker]

странно... спасибо, никак не привыкну к лиспу с его скобками, путаюсь

а не, все-равно выдает ошибку эту же... причем выдает ее, если не ошибаюсь, на

Код:

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

(setq ChTg2b	(* 2 (+ (* a h) (* b g)))
	 ZnTg2b	(- (- (expt a 2) (expt h 2)) (- (expt b 2) (expt g 2)))
	 tg2b	(/ ChTg2b ZnTg2b))

[Do$]

Тут как раз в коде все хорошо.
Проверял так:

Код:

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

(setq a    1
      b    2
      h    3
      g    4
) ;_ end of setq
(setq ChTg2b (* 2 (+ (* a h) (* b g)))
      ZnTg2b (- (- (expt a 2) (expt h 2)) (- (expt b 2) (expt g 2)))
      tg2b   (/ ChTg2b ZnTg2b)
) ;_ end of setq

Вообще, никогда не выскакивала такая ошибка:

Код:

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

unknown format directive: "["

[Кулик Алексей aka kpblc]

Русификатор не ставил?

[magiker]

Ну он в комплекте шел, точнее сразу русифицированный ставился

А может я велосипед изобретаю? В целом задача тривиальная: есть функция (астроида), заданная параметрическим уравнением

Код:

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

x=Fx(t)
y=Fy(t)

Надо построить график этой функции и график функции с применением матрицы преобразований (a b g h)
На любом другом языке сделал бы уже давно, а на лиспе всю ночь мучаюсь, и пока ничего. Может дадите волшебного пинка в нужном направлении?

А, и самое главное - АвтоКАД 2005

[Кулик Алексей aka kpblc]

Эта ошибка была в версиях 2005 и, по-моему, в 2006. Попробуй SP поставить - вроде бы решалась проблема, но точно не помню

[magiker]

А где взять сервиспак на варезный кад? )

Все, вопрос снят. Нашел, качаю. Посмотрим, встанет ли он на левый серийник

Еще такой вопрос по структуре программы на лиспе. Функция должна быть описана до ее первого вызова или не имеет значения? И как все-таки быть со скобками в функции, возвращающей значение? Учебник говорит что синтаксис такой
(defun %FnName% (par1 par2 ...) (%FnBody%) ), и как пример - стандартный DtR
(defun dtr (u)
(* pi (/ u 180)) ;Это как я понимаю то значение которое функция должна вернуть
)

А как быть если перед расчетом возвращаемого значения надо провести дополнительные расчеты?

[Do$]

Сообщение от magiker Функция должна быть описана до ее первого вызова или не имеет значения?

Обязательно до! На момент первого обращения к ней, она должна быть уже загружена.

Сообщение от magiker А как быть если перед расчетом возвращаемого значения надо провести дополнительные расчеты?

Код:

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

(defun test (a b / c)
  (setq c (list a b))
  ;; <дополнительные рассчеты>
  c
) ;_ end of defun

[magiker]

а что в строке (a b / c) означает слэш?

[Do$]

Разделяет список переменных на глобальные и локальные.
В данном случае, после выполнения функции test локальной переменной C будет присвоено то значение, которое у нее было до начала выполнения функции.

[magiker]

ага понятно. А как явно указать значение которое должно быть присвоено функции в итоге?

[Do$]

Сообщение от magiker А как явно указать значение которое должно быть присвоено функции в итоге?

Наверное, это следует понимать так:
Как задать значение, которое вернет функция после ее вызова?
Я ж показал, для при веденного выше примера - функция test:
-обращаемся к функции:
(test 1 2) но надо как-то сохранить результат работы функции, поэтому:
- сохраняем возвращаемое значение:
(setq test_rez (test 1 2))
А функция test будет всегда возвращать вычисленное значение своей локальной переменной C, потому что в коде после всех вычислений стоит C:

Код:

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

(defun test (a b / c)
  (setq c (list a b))
  ;; <дополнительные рассчеты>
  c
) ;_ end of defun

[magiker]

Во =) Спасибо за доходчивое объяснение

З.ы. сорри за невнятные вопросы, вторые сутки не сплю, поэтому мозг немного притормаживает

Установка СП1 на АвтоКАД 2005 убила серийник, что впрочем и ожидалось. Поставил 2010 Кад, но тут другая проблема... а где в нем автолисп? о.0

Нашел, невнимательно смотрел просто. Очередной вопрос возник. Как в команде
(command "_.line" p1 p2)
задать ширину (толщину) линии и ее цвет?

Разобрался... Следующий вопрос

Код:

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

;Fx = R * cos^3(t)
(defun Fx (tt r / c)
  (setq c (* r (expt (cos tt) 3)))
  c
)

; Fy = R * sin^3(t)
(defun Fy (tt r / c)
  (setq c (* r (expt (sin tt) 3)))
  c
)

(defun dl (p1 p2)
  (command "_.line" p1 p2 "")
)

(defun c:dc ()
  (setq R 2.0 
          Ts 0.0
          Te (* pi 2)
          St (* pi 0.01)
          Mn 10)
  (setq Sch Ts)
  (while (<= Sch Te)
    (setq x1  (* Mn (fx Sch R))
            y1  (* Mn (fy Sch R))
            p1  (list x1 y1)
            x2  (* Mn (fx (+ sch St) R))
            y2  (* Mn (fy (+ sch St) R))
            p2  (list x2 y2))
    (dl p1 p2)
    (setq sch (+ sch St))
  )
)

Результатом должен быть график астроиды, но получается вот что:


Т.е. в целом рисунок правильный, не считая углов. Не подскажите почему?

Поэкспериментировал сейчас - оказывается если максимально приблизить рабочий лист перед выполнением программы то строится без проблем, точнее чем больше приближение тем меньше скос на углах. Как избавиться от этого? Надо чтоб рисовалось нормально, независимо от масштаба

Решил немного изменить алгоритм. Пусть сначала все точки собираются в список, а потом из этих точек рисовать график. Т.е. в теории это выглядит так

Код:

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

(while (<= Sch Te)
  (setq x  (* Mn (fx Sch))
          y  (* Mn (fy Sch))
          p  '(x y))
  (setq Pts (list Pts p))
  (setq sch (+ sch St))
)

На практике же не совсем уверен в строке (setq Pts (list Pts p))
Результатом работы циклы должен стать список ((х1 у1) (х2 у2) (х3 у3) (х4 у4) ... )
Но если использовать list то скорее всего получится ((((((х1 у1) (х2 у2)) (х3 у3)) (х4 у4)) ... ) как-то так
Вобщем, как правильно в цикле составить список точек, и главное - как из этого списка построить полилинию?

Ну помогите кто-нибудь пожалуйста

Со скошенными углами разобрался, концы отрезков прилепляются к ближайшей точке. Справился отключением данного параметра.
Вопрос с формированием массива точек и рисованием линии из этого массива все еще актуален

[Makswell]

Сообщение от Do$ Сообщение от magiker Функция должна быть описана до ее первого вызова или не имеет значения? Обязательно до! На момент первого обращения к ней, она должна быть уже загружена.

Сообщение от Do$ Разделяет список переменных на глобальные и локальные.

Немного позанудствую.
Вот код:

Код:

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

(defun test1 ()
  (princ (test 2 3))
  (setq d 5)
  (princ)
)
(defun test (a b / c)
  (setq c (list a b))
  c
)

Вот проверка:

; 2 форм загружено из #<editor "<Без имени-0> загружается..."> _$ (test1) (2 3) _$ a nil _$ c nil _$ d 5

Или вот код:

Код:

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

(defun test1 ()
  (princ (test 2 3))
  (defun test (a b / c)
    (setq c (list a b))
    c
  )
  (setq d 5)
  (princ)
)

Проверка:

; 1 блок кода загружено из #<editor "<Без имени-0> загружается..."> _$ (test1) (2 3) _$ a nil _$ d 5

В результате можно сделать выводы:
1. Функцию можно определять и после её первого вызова.
2. Слэш не разделяет список переменных на глобальные и локальные. Он отделяет аргументы функции от её локальных переменных. Глобальные переменные появляются, если они просто не прописаны явно как локальные. А аргументы тоже по-сути локальны, что доказыавает проверка: a=nil.

[Do$]

Сообщение от Makswell 1. Функцию можно определять и после её первого вызова.

В показанном варианте вызова функции как такового не происходит. Это просто объявления двух функций, одна из которых используется внутри другой. Фактически, первый вызов был тут:

Код:

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

(test1)

А к этому времени функция test уже была объявлена. А такие замечания способны запутать начинающего! Естествено - это мое мнение, не утверждаю, что единственно верное

Сообщение от Makswell 2. Слэш не разделяет список переменных на глобальные и локальные. Он отделяет аргументы функции от её локальных переменных. Глобальные переменные появляются, если они просто не прописаны явно как локальные. А аргументы тоже по-сути локальны, что доказыавает проверка: a=nil.

Да, так, конечно, правильно!
magiker, как я понял, у тебя сложность с формированием списка. Для этого есть две полезные функции: cons и append. Cons - добавление в список элемента на первое место, append - слияние списков в один.
Примеры:

Код:

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

(setq Pts (cons p Pts))
(setq Pts (append Pts (list p)))

cons использовать предпочтительнее, но надо учесть такие особенности:
- если второй аргумент не является списком или nil (nil по сути есть пустой список), то создастся точечная пара. Примеры:

Код:

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

(cons 1 (list 1 2 3))
;-->(1 1 2 3)
(cons 1 nil)
;-->(1)
(cons 1 1)
;-->(1 . 1)
(cons (list 1 2 3) 1)
;-->((1 2 3) . 1)

- когда формируешь список в цикле используя cons, в результате получается список вида: (...<третье добавление> <второе добавление> <первое добавление>), поэтому часто требуется после формирования список "развернуть". Для этого есть специальная функция reverse.

Код:

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

(setq i 0 rez nil)
(while (< i 10)
  (setq rez (cons i rez)
	i (1+ i)
	)
) ;_ end of while
rez
;-->
(9 8 7 6 5 4 3 2 1 0) 


(setq rez (reverse rez))
;-->(0 1 2 3 4 5 6 7 8 9)

[Makswell]

Сообщение от Do$ В показанном варианте вызова функции как такового не происходит. Это просто объявления двух функций, одна из которых используется внутри другой

Для этого я как раз написал второй пример. Повторю.

Код:

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

(defun test1 ()
  (princ (test 2 3))
  (defun test (a b / c)
    (setq c (list a b))
    c
  )
  (setq d 5)
  (princ)
)

Здесь функция test вызывается до того, как она была определена (defun test...
Дело в том, что сначала код загружается в память. Оперативную. Опеределённые программистом функции вносятся в список лисп-символов (на равне например со стандартными символами setq или тот же defun и т.п.), а потом уже происходит выполнение этого кода. Как-то так я всё это себе представляю.
Хотя может быть мы вообще о разных вещах говорим.

Добавлено:
Вот кстати для наглядности. В смыле, что имел ввиду, говоря, что функция вносится в список лисп-символов.

_$ setq #<SUBR @113e29ec SETQ> _$ test #<USUBR @133054ec TEST>

[Do$]

А вот в таком варианте уж точно не будет работать.

Код:

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

TEST1 
_$ (test1)
; error: no function definition: TEST
_1$

[Makswell]

Хы, точно, херню я написал. Видимо эта test уже висела в памяти, опредёлённая раньше. При презагрузке Автокада так и вышло. Как у тебя. В таком случае, ты безусловно прав. Однозначно.
Ладно, проехали.

[magiker]

Do$, Makswell, спасибо за советы. Со списками разобрался более-менее. Теперь у меня есть список вида ( (х1.у1) (х2.у2) (х3.у3) ... ) А как из точек, описанных в этом списке, построить линию? И не совсем понятно, что лучше использовать - _.line или _.pline

[VVA]

Сообщение от magiker А как из точек, описанных в этом списке, построить линию?

Код:

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

(setq lst '((10.5 10)(11.3 12)(9 4.5)(2.2 3.3)(18.5 12.3))) ;_Список
(command "_.PLINE")
(foreach pt lst (command "_none" pt))
(command "")

[magiker]

о как... спасибо

Добавлено:
Ан нет. Пишет "unknown command NONE"
Что не так?

[VVA]

Сообщение от magiker Ан нет. Пишет "unknown command NONE"

"_none" это опция привязкию По русски "Ничего". Попробуй вместо "_none" "_non". Геоникс случайно не установлен?

[magiker]

VVA, нет, чистый АвтоКАД 2010, английский, без русификатора, без доп. пакетов

Код:

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

(defun Fx (tt / c)
  (setq c (* r (expt (cos tt) 3)))
  c
)

(defun Fy (tt / c)
  (setq c (* r (expt (sin tt) 3)))
  c
)

(defun c:dc ()
  (setvar "CMDECHO" 0)
  (setvar "OSMODE" 0)
  (setq R 1.0
          Ts 0.0
          Te (* pi 2)
          St (* pi 0.01))
          Pts ())
  
  (setq Sch Ts)
  (while (<= Sch Te)
    (setq x  (fx Sch)
          y  (fy Sch)
          p  (cons x y)
          Pts (cons Pts p)
      sch (+ sch St))
  )

  (command "_.pline")
  (foreach pt pts (command "_none" pt))
  (command "")
  
  (command "_zoom" "_e")
)

Пробовал _none, _non, _no... больше фантазии нехватает

[superkot007]

Нашел lisp...

Код:

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

;;----------------------------------------------------
;;  Программа для выравнивания отрезков по осям X и Y
;;  Если отрезки не будут лежать в плоскости МСК
;;  результат работы не определен.
;;  Автор Александр Ривилис.
;;----------------------------------------------------
(defun C:L_ALIGN_XY ( / ss en e p1 p2 i n dir d dr x y l dl)
    (setvar "CMDECHO" 0)
    (if (null L_ALIGN_XY_delta_ang) (progn
       (setq L_ALIGN_XY_delta_ang 1.0)
    )) ;; (if (progn
    (setq d (getreal
      (strcat "\nМаксимальный угол отклонения от оси в градусах <"
              (rtos L_ALIGN_XY_delta_ang 2 3) ">: ")))
    (if d (setq L_ALIGN_XY_delta_ang (abs d)))
    (setq d (* PI (/ L_ALIGN_XY_delta_ang 180.0)))
    (princ "\nВыберите отрезки для выравнивания: ")
    (cond
      ((setq ss (ssget '((0 . "LINE"))))
        (setq i 0 n (sslength ss))
        (while (< i n)
          (setq e (entget (ssname ss i)))
          (setq p1 (cdr (assoc 10 e)) p2 (cdr (assoc 11 e)))
          (setq l (distance p1 p2)) ;; Длина отрезка
          (setq dir (angle p1 p2)) ;; Находим угол с осью X
          ;; Приводим угол в диапазон 0...2*PI
          (if (< dir 0.0) (setq dir (+ (* 2.0 PI) dir)))
          (cond
            ;; Отрезок условно параллелен оси X
            ((or (equal dir 0.0 d) (equal dir PI d) (equal dir (* 2.0 PI) d))
              (setq y (* 0.5 (+ (cadr p1) (cadr p2))))
              (setq p1 (list (car p1) y (caddr p1)))
              (setq p2 (list (car p2) y (caddr p2)))
              (setq dl (* 0.5 (- l (distance p1 p2))))
              ;; Восстанавливаем длину отрезка
              (setq p1 (polar p1 (angle p2 p1) dl))
              (setq p2 (polar p2 (angle p1 p2) dl))
              (setq e (subst (cons 10 p1) (assoc 10 e) e))
              (setq e (subst (cons 11 p2) (assoc 11 e) e))
              (entmod e)
            )
            ;; Отрезок условно параллелен оси Y
            ((or (equal dir (* PI 0.5) d) (equal dir (* PI 1.5) d))
              (setq x (* 0.5 (+ (car p1) (car p2))))
              (setq p1 (list x (cadr p1) (caddr p1)))
              (setq p2 (list x (cadr p2) (caddr p2)))
              (setq dl (* 0.5 (- l (distance p1 p2))))
              ;; Восстанавливаем длину отрезка
              (setq p1 (polar p1 (angle p2 p1) dl))
              (setq p2 (polar p2 (angle p1 p2) dl))
              (setq e (subst (cons 10 p1) (assoc 10 e) e))
              (setq e (subst (cons 11 p2) (assoc 11 e) e))
              (entmod e)
            )
          ) ;; (cond
          (setq i (1+ i))
        ) ;; endof (while
      )
      (T
       (princ "\nНичего не выбрано, или выбрано что-то не то!")
      )
    ) ;; (cond
    (princ)
)

но почему-то "не пашет" (проверял и в 2006, и в 2011). И еще - как его модернизировать, чтобы он еще и выравнивал концы отрезков по координатам, кратным, например, 5...

Т.е. если, например, отрезок имеет начало в т. (548;762) и конец в (987;759), то сначала выравнивание по горизонтали, а затем - по точкам (550;760) - (985;760). Зачастую попадаются чертежи, выполненные без привязки или нарушенной ортогональностью

[VVA]

magiker, Убери "_none" совсем. А еще лучше покажи листинг того, что делаешь

[magiker]

VVA, опишу тогда все с самого начала для большего понимания. Дана функция, заданная параметрически, т.е.
x = Fx(t)
y = Fy(t)
Надо построить график этой функции

На текущий момент код имеет такой вид

Код:

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

;                 2*(a*h + b*g)    
; tg(2Beta) = ---------------------
;             ((a^2-h^2)-(b^2-g^2))
(defun Beta (/ c)
  (setq ChTg2b    (* 2 (+ (* a h) (* b g)))
        ZnTg2b    (- (- (expt a 2) (expt h 2)) (- (expt b 2) (expt g 2)))
        tg2b    (/ ChTg2b ZnTg2b))
  (setq c (/ (atan tg2b) 2))
  c
)

;             a*sin(Beta) - h*cos(Beta)
; tg(Alpha) = -------------------------
;             b*cos(Beta) - g*sin(Beta)
(defun Alpha (/ c)
  (setq ChTgA (- (* a (sin (Beta))) (* h (cos (Beta))))
        ZnTgA (- (* b (cos (Beta))) (* g (sin (Beta))))
        TgA   (/ ChTgA ZnTgA))
  (setq c (atan TgA))
  c
)

;      a*cos(Beta)+h*sin(Beta)   b*sin(Beta)+g*cos(Beta)
; k1 = ----------------------- = -----------------------
;            cos(Alpha)                sin(Alpha)       
(defun k1 (/ c)
  (if (= (cos (Alpha)) 0)
  ; then
    (setq Ch (+ (* b (sin (Beta))) (* g (cos (Beta))))
          Zn (sin (Alpha)))
  ; else
    (setq Ch (+ (* a (cos (Beta))) (* h (sin (Beta))))
          Zn (cos (Alpha)))
  ); end if
  (setq c (/ Ch Zn))
  c
)

;      a*sin(Beta)-h*cos(Beta)   b*cos(Beta)-g*sin(Beta)
; k2 = ----------------------- = -----------------------
;            sin(Alpha)                cos(Alpha)
(defun k2 (/ c)
  (if (= (sin (Alpha)) 0)
  ; then
    (setq Ch (- (* b (cos (Beta))) (* g (sin (Beta))))
          Zn (cos (Alpha)))
  ; else
    (setq Ch (- (* a (sin (Beta))) (* h (cos (Beta))))
          Zn (sin (Alpha)))
  ); end if
  (setq c (/ Ch Zn))
  c
)

; Fx = R * cos^3(t)
(defun Fx (tt / c)
  (setq c (* r (expt (cos tt) 3)))
  c
)

; Fy = R * sin^3(t)
(defun Fy (tt / c)
  (setq c (* r (expt (sin tt) 3)))
  c
)

; FxP = k1*Fx*cos(Alpha) - k2*Fy*sin(Alpha)
(defun FxP (tt / c)
  (setq c (- (* (k1) (fx tt) (cos (alpha))) (* (k2) (fy tt) (sin (alpha)))))
  c
)

; FyP = k1*Fx*sin(Alpha) + k2*Fy*cos(Alpha)
(defun FyP (tt / c)
  (setq c (+ (* (k1) (fx tt) (sin (alpha))) (* (k2) (fy tt) (cos (alpha)))))
  c
)


(defun dl (pt1 pt2)
  (command "_.line" pt1 pt2 "")
)

(defun c:dc ()
  (setvar "CMDECHO" 0)
  (setvar "OSMODE" 0)
  (setq a 1
        b 1
        g 0
        h 1
    R 1.0
        Ts 0.0
        Te (* pi 2)
    St (* pi 0.01)
        Pts ())

  (setq Sch Ts)
  (while (<= Sch Te)
    (setq x1  (fxp Sch)
          y1  (fyp Sch)
          p1  (list x1 y1)
          x2  (fxp (+ sch St))
          y2  (fyp (+ sch St))
          p2  (list x2 y2)
      sch (+ sch St))
    (dl p1 p2)
  )

  (command "_zoom" "_e")
)

Хотелось бы переделать функцию dc() так, чтоб график рисовался сразу весь, а не отдельными отрезками. Ну и если укажите на явные косяки (а точнее не оптимальные пути решения) в коде - тоже буду премного благодарен

Ну и совсем уж идеальный вариант - добавить функцию для рисования осей координат с делениями. И чтоб оси были одного цвета, а график чуть толще и другого цвета

З.Ы. АвтоЛИСП, равно как и АвтоКАД, вижу впервые в своей жизни, так что за кривой код строго не судите

[VVA]

magiker, Вроде как так

Код:

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

(defun c:dc ( )
  (setvar "CMDECHO" 0)
  (setvar "OSMODE" 0)
  (setq a 1
        b 1
        g 0
        h 1
    R 1.0
        Ts 0.0
        Te (* pi 2)
    St (* pi 0.01)
        Pts ())

  (setq Sch Ts)
  (setq x1  (fxp Sch)
        y1  (fyp Sch)
        p1  (list x1 y1)
	)
  (setvar "CELWEIGHT" 50) ;_ Вес
  (setvar "CECOLOR" "1")    ;_ Цвет
  (command "_.PLINE" p1)
  (while (<= Sch Te)
    (setq x2  (fxp (+ sch St))
          y2  (fyp (+ sch St))
          p2  (list x2 y2)
      sch (+ sch St))
    (command p2)
    ;;;(dl p1 p2)
  )
(while (> (getvar "CMDACTIVE") 0)(command ""))
(command "_zoom" "_e")
)

Остальные ф-ции в #812

[magiker]

Спасибо, все работает. Только немного непонятно с толщиной (весом) линии. Пробовал разные значения - разницы так и не увидел. В чем подвох? )
И еще такой вопрос - как удалить все что нарисовано, очистить лист?

С удалением разобрался, а вот с толщиной линии все еще не понятно. Разницы не вижу хоть убей

[VVA]

Сообщение от magiker С удалением разобрался, а вот с толщиной линии все еще не понятно. Разницы не вижу хоть убей

Разницу увидишь когда напечатаешь лист. Еще в Автокаде внизу под командной строкой есть кнопки. Одна из них отвечает за показ весов линий. Альтернативный вариант - набрать команду _lweight и включить чек-бокс "Отображать линии в соответствии с весами".

И еще такой вопрос - как удалить все что нарисовано, очистить лист?

Код:

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

(command "_.erase" "_all" "")

Кстати в коде я показал явное присвоение цвета и веса. Правильнее все разнести по слоям

[magiker]

VVA, спасибо, все получилось. Разносить по слоям смысла нет, работа дипломная, важен сам факт построения графиков - все остальное это уже личная инициатива =)

Еще раз спасибо всем кто откликнулся

[kha]

Добрый день!

Пополняю ряды чайников!

Начал изучение лиспа с разбора кода, сделанного VVA. Весь файл находится в сообщении по этой ссылке:

http://forum.dwg.ru/showpost.php?p=179141&postcount=1

пока что заткнулся на вот этой строке (выделено красным):

Код:

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

(if
(and
(setq ss (ssget "_X" '((0 . "INSERT")(66 . 1))))
(setq lst (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp(mapcar 'cadr(ssnamex ss)))))

я так понял, что здесь список объектов чертежа превращается в удобоваримый список для обработки vla- функциями.

1. ssnamex - извлекает примитив из набора по порядковому номеру
2. cadr - извлекает второй элемент из списка, который даёт (ssnamex ss)
3. mapcar - повторяет п. 2 с каждым элементом набора ss
4. listp - проверяет, является ли списком то, что получилось в результате п.3.

заткнулся на функции vl-remove-if - не понял как работает. То есть через командную строку прогнал, посмотрел что на выходе даёт, но не понял как.

в "Visual Lisp и секреты адаптации AutoCAD" (издание 2001 г.) читаю:

"Удаляет из списка все элементы, возвращающие Т при проверке тест-функцией"

тест-функция - здесь listp

по этому описанию выходит, что эта функция удаляет из списка как раз те элементы, которые нам нужны, чего на практике не происходит.

[VVA]

Сообщение от kha 1. ssnamex - извлекает примитив из набора по порядковому номеру

Неверно. Найди разницу между функциями ssnameX и ssname

2. cadr - извлекает второй элемент из списка, который даёт (ssnamex ss)

Правильно

3. mapcar - повторяет п. 2 с каждым элементом набора ss

Неверно. С каждым элементом списка, возвращенного (ssnameX ss)

4. listp - проверяет, является ли списком то, что получилось в результате п.3

Верно.
Функция vl-remove-if применяет тестовую ф-цию listp к каждому элементу списка, возвращенноно ф-цией п.2 и удаляет из списка те элементы, у которых listp вернула истину. Т.е. те элементы, которые являются списками, в том числе и nil - пустой список.

Код:

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

(setq lst (mapcar
            'vlax-ename->vla-object
                (vl-remove-if    ;_Шаг  4. -> (<Имя объекта: 7ef835f0> <Имя объекта: 7ef834d8>) 
                  'listp         
                  (mapcar
                    'cadr        ;_Шаг  3. -> (<Имя объекта: 7ef835f0> <Имя объекта: 7ef834d8>) 
                    (ssnamex     ;_Шаг  2. -> ((0 <Имя объекта: 7ef835f0> 0) (0 <Имя объекта: 7ef834d8> 0)) 
                       (setq ss (ssget "_X" '((0 . "INSERT")(66 . 1)))) ;_Шаг 1.->  <Selection set: 7> 
                      ) 
                    )
                  )
          ) ;_ end of mapcar
) ;_ end of setq

Если бы на шаге 3 список имел вид (<Имя объекта: 7ef835f0> <Имя объекта: 7ef834d8> nil (1 2 3))
то, на шаге 4 он принял бы вид (<Имя объекта: 7ef835f0> <Имя объекта: 7ef834d8>) Два последних элемента списка vl-remove-if удалит, так как если к ним применить listp, то она вернет истину.

[kha]

VVA: спасибо за разъяснения, всё понял!

Буду копать дальше, потом выложу этот лисп с подробными пошаговыми комментариями. Ну и если возникнут вопросы по ходу изучения - буду писать сюда

[magiker]

И снова драсти =)

Вопрос: есть список с числами. Как из него выбрать максимальное и минимальное число?

[Do$]

Можно так:

Код:

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

(setq lst '(5 7 2 1 9 0))
(setq min_numb (car (vl-sort lst (function <))))
(setq max_numb (car (vl-sort lst (function >))))

Писал без проверки в акаде.

[magiker]

Ну собственно именно так я сейчас и делаю... ну, почти так.
Просто думал, может есть какой-нить аналог (min) (max) для списка =)

[Do$]

Можно еще так:

Код:

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

(apply 'min lst)
(apply 'max lst)

[VVA]

Сообщение от magiker Просто думал, может есть какой-нить аналог (min) (max) для списка =)

Ну и еще для развития. Есть список точек с координатами X,Y.

Код:

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

(setq lst '((11 2)(2 5)(2 4)(3 1)))

Нужно из этого списка получить точку с минимальным X,Y и максимальным X,Y

Код:

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

(setq lst '((11 2)(2 5)(2 4)(3 1)))
(apply 'mapcar (cons 'min lst)) ;_Xmin Ymin
(apply 'mapcar (cons 'max lst)) ;_Xmax Ymax

[Дима_]

Сообщение от VVA Сначала дать свой вариант, потом смотреть здесь Код: (setq lst '((11 2)(2 5)(2 4)(3 1))) (apply 'mapcar (cons 'min lst)) ;_Xmin Ymin (apply 'mapcar (cons 'max lst)) ;_Xmax Ymax

Я не понимаю как это вобще работает???
p.s. - все понял - хитр'о.
p.p.s - тогда уж (mapcar '(lambda (f)(apply 'mapcar (cons f lst))) '(min max))

[superkot007]

Прошу прощения за назойливость...
Никто не может помочь с
http://forum.dwg.ru/showpost.php?p=562615&postcount=810
???

[Do$]

У меня в автокаде 2006 код работает.
Может быть код применялся не к отрезкам?

[VVA]

superkot007, У меня код так же работает. Может угол отклонения отрезка от оси больше указанного в команде

И еще - как его модернизировать, чтобы он еще и выравнивал концы отрезков по координатам, кратным, например, 5..

Написать другую команду

Код:

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

(defun C:L_ROUND_XY (/ ss en e p1 p2 i n dir d dr x y l dl)
;;;Команда выравнивает координаты концов отрезков блоков текстов
;;;согласно указанной точности
;;; Округление выравнивание
;;; http://forum.dwg.ru/showpost.php?p=564014&postcount=828
  (defun round (num prec)
    (* prec
       (if (minusp num)
         (fix (- (/ num prec) 0.5))
         (fix (+ (/ num prec) 0.5))
       ) ;_ end of if
    ) ;_ end of *
  ) ;_ end of defun

  (setvar "CMDECHO" 0)
  (if (null L_ROUND_XY)
    (progn
      (setq L_ROUND_XY 5.0)
    ) ;_ end of progn
  ) ;_ end of if
  (setq d (getreal
            (strcat "\nТочность округления координат <"
                    (rtos L_ROUND_XY 2 3)
                    ">: "
            ) ;_ end of strcat
          ) ;_ end of getreal
  ) ;_ end of setq
  (if d
    (setq L_ROUND_XY (abs d))
  ) ;_ end of if
  (princ "\nВыберите отрезки, тексты, блоки для выравнивания: ")
  (cond
    ((setq ss (ssget '((0 . "LINE,TEXT,INSERT"))))
     (setq i 0
           n (sslength ss)
     ) ;_ end of setq
     (while (< i n)
       (setq e (entget (ssname ss i)))
       (setq p1 (cdr (assoc 10 e))
             p2 (cdr (assoc 11 e))
       ) ;_ end of setq
       (if p1
       (setq p1 (list
                  (round (car p1) L_ROUND_XY) ;_X
                  (round (cadr p1) L_ROUND_XY) ;_Y
                  (caddr p1)                   ;_Z
                ) ;_ end of list
       ) ;_ end of setq
         )
       (if p2
       (setq p2 (list
                  (round (car p2) L_ROUND_XY) ;_X
                  (round (cadr p2) L_ROUND_XY) ;_Y
                  (caddr p2)                    ;_Z
                ) ;_ end of list
       ) ;_ end of setq
         )
       (if p1 (setq e (subst (cons 10 p1) (assoc 10 e) e)))
       (if p2 (setq e (subst (cons 11 p2) (assoc 11 e) e)))
       (entmod e)
       (setq i (1+ i))
     ) ;_ end of while
    )
    (t
     (princ "\nНичего не выбрано, или выбрано что-то не то!")
    )
  ) ;_ end of cond
  (princ)
)

[superkot007]

Сообщение от Do$ У меня в автокаде 2006 код работает. Может быть код применялся не к отрезкам?

Нифига не понял почему - но сейчас работает... И вперед точно использовались отрезки (сам чертил для проверки, точно были не полилинии - не использую). "Ничё не понимаю" (с) Ну да ладно, работает и хорошо... Спасибо за проверку!

VVA Все как всегда - безупречно. Спасибо!

Еще вопрос - можно сделать "разрывы" как, например, в MS Visio - при перемещении/удалении/добавлении отрезка "разрыв" изменяется соответствующим образом? И с проверкой принадлежности одинаковому слою??? "Топорный" вариант есть:

Код:

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

 (defun C:VRT (/ pt pt1 pt2 pt3 m1 m2 v VarOsMode)
 ;РАЗРЫВ ВЕРТИКАЛЬНЫХ ЛИНИЙ РАВНЫЙ 4мм
 (setq pt (getpoint "\n \n \nВведите точку пересечения линий:"))

; Отключить привязку
 (setq VarOsMode (getvar "osmode"))
 (setvar "osmode" 0)

 (setq pt1 (osnap pt "_int"))
 (setq m1 (+ (cadr pt1) 2))
 (setq pt2 (list (car pt1) m1))
 (setq m2 (- (cadr pt1) 2))
 (setq pt3 (list (car pt1) m2))
 (command "_break" pt2 pt3)

; Включить привязку
  (setvar "osmode" VarOsMode)

 )

Но когда начинаешь редактировать чертежи - можно мылить веревку...

[VVA]

Сообщение от superkot007 можно мылить веревку.

Почитай тему Хитрый блок Плюс его можно сделать динамическим с автовыравниванием

[superkot007]

Сообщение от VVA Почитай тему Хитрый блок Плюс его можно сделать динамическим с автовыравниванием

Ну я склонялся уже к "маскировке", думал, что какие еще решения интересные будут... Нашел вообще классический вариант - http://dwg.ru/art/14 Буду теперь "мучить" AutoCAD
Спасибо за наводку...

[alex8888]

Привет всем ,
подскажите для моей конструкции:

Код:

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

(defun save_new_dxf ( / )
  (command "_.wblock"
           (strcat
             	(getvar "dwgprefix")
                       (getvar "dwgname")
                       "-1");strcat
           "*");command
  );defun

1. Как сделать, чтобы при исходном имени "тырпыр.dwg" при выполнении программы вместо имени файла "тырпыр.dwg-1.dwg" получилось "тырпыр-1.dwg" ?
2. Что подставить вместо "*", чтобы была возможность выбрать конкретно, что сохранить (блоки, текст, уровни и тп)?

[Do$]

1. См. функции VL-FILENAME-BASE, VL-FILENAME-EXTENSION, SUBSTR.
2. Наверное, PAUSE.

[alex8888]

По п.1 исправил на следующую конструкцию:

Код:

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

(defun save_new_dxf (/)
  (vl-load-com)
  (command "_.wblock"
           (strcat
             (getvar "dwgprefix")
             (vl-filename-base (getvar "dwgname"))
             "-1"
           )                            ;strcat
           "*"
  )                                     ;command
)                                       ;defun

А вот Pause не помогает - спрашивает имя сохраненного блока или новый чертеж:

Namen des vorhandenen Blocks eingeben oder [= (block=ausgabedatei)/* (ganze zeichnung)] <Neue Zeichnung definieren>:

при этом если продолжать жать enter, то позволяет выбирать блоки, но затирает их из текущего чертежа, формируя корректно новый (все выбранное в наличии, имя файла правильное).
Как поступить?

[Do$]

Честно говоря, никогда этой командой (wblock) не пользовался. Судя по описанию, с ее помощью можно сохранить блок чертежа в отдельном файле (вроде бы, только один). Поэтому, наверное, нужно из всего, что хочется сохранить в отдельный файл создать новый блок в чертеже, и уже его передавать в команду wblock. Опять же, с программным созданием блоков никогда не сталкивался (знаю только, что это возможно ), но, думаю, если поискать тут на форуме, то что-то по этой теме найдется.
Хотя, насчет одного блока - это я ошибся.
Вот так можно попробовать (без всяких проверок и пр.):

Код:

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

(defun c:test (/ ss)
  (vl-cmdf "_.copy"
    (setq ss (ssget))
    ""
    '(0.0 0.0 0.0)
    '(0.0 0.0 0.0)
  ) ;_ end of vl-cmdf
  (vl-cmdf "_.-wblock"
    (strcat
      (getvar "dwgprefix")
      (vl-filename-base (getvar "dwgname"))
      "-1"
    ) ;_ end of strcat
    ""
    (list 0.0 0.0 0.0)
    ss
    ""
  ) ;_ end of vl-cmdf
) ;_ end of defun

[Кулик Алексей aka kpblc]

Еще один вариант:

Код:

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

(vl-load-com)

(defun c:test (/ adoc selsets selsetname vla_selset dwg_file wb_file)

  (setq selsets    (vla-get-selectionsets (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
        selsetname "wb"
        ) ;_ end of setq
  (if (/= (setq dwg_file (vla-get-fullname adoc)) "")
    (progn
      (vl-catch-all-apply
        (function
          (lambda ()
            (vla-delete (vla-item selsets selsetname))
            ) ;_ end of lambda
          ) ;_ end of function
        ) ;_ end of vl-catch-all-apply
      (setq vla_selset (vla-add selsets selsetname))
      (if (and (not (vl-catch-all-error-p
                      (vl-catch-all-apply
                        (function
                          (lambda ()
                            (vla-selectonscreen vla_selset)
                            ) ;_ end of lambda
                          ) ;_ end of function
                        ) ;_ end of vl-catch-all-apply
                      ) ;_ end of vl-catch-all-error-p
                    ) ;_ end of not
               (> (vla-get-count vla_selset) 0)
               ) ;_ end of and
        (progn
          (vla-wblock (setq wb_file (strcat (vl-filename-directory dwg_file)
                                            "\\"
                                            (vl-filename-base dwg_file)
                                            "-1.dwg"
                                            ) ;_ end of strcat
                            ) ;_ end of setq
                      vla_selset
                      ) ;_ end of vla-Wblock
          (princ (strcat "\nНабор был сохранен в файл " wb_file))
          ) ;_ end of progn
        ) ;_ end of if
      (vl-catch-all-apply
        (function
          (lambda ()
            (vla-delete (vla-item selsets selsetname))
            ) ;_ end of lambda
          ) ;_ end of function
        ) ;_ end of vl-catch-all-apply
      ) ;_ end of progn
    (alert "Файл не сохранялся еще ни разу! Выполнение невозможно!")
    ) ;_ end of if
  (princ)
  ) ;_ end of defun

[alex8888]

Кулик Алексей aka kpblc,
попытка выполнить твой лисп:
1. ругается на переопределение команды c:test, говорит что то про запрещенные символы и прерывания
2. при переименовании функции test в другую, в том числе и без с:, выскакивает Fehlerhafter Argumenttyp: VLA-OBJECT "G:\\Dateien-FH\\DrawingG\\DXF-LASER\\DXF von4401-4500\\4477-1.dwg" (ошибка типа аргумента), соответственно, на выходе нет
Каков алгоритм использует твоя программа? Можешь вкратце для чайника разъяснить

Do$,
после переименования test в другую функцию работает
Осталось только разобраться зачем введена команда copy и переменная ss

[Do$]

Да потому что я сделал код на скорую руку и для наглядности использовал командные методы. Команда "wblock" удаляет объекты после экспорта, поэтому пришлось сперва командой "copy" сделать копию объектов, которые собираемся экспортировать, поэтому и сохранение набора в переменной понадобилось... Использовать такое в качестве готовой функции, конечно же, нельзя!
У Алексея все довольно правильно сделано (вот не лень было заморочиться человеку ).
Алгоритм его функции прост - создается набор из объектов, передается в метод WBLOCK (оказывается и такое есть в VLA!) и при помощи него экспортируется в новый чертеж. Есть необходимые проверки и все "по уму".
Вставь то, что красным выделено в функцию и будет тебе счастье

Код:

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

(vla-wblock
     adoc
     (setq wb_file (strcat (vl-filename-directory dwg_file)
      "\\"
      (vl-filename-base dwg_file)
      "-1.dwg"
     ) ;_ end of strcat
     ) ;_ end of setq
     vla_selset
   ) ;_ end of vla-Wblock

[Кулик Алексей aka kpblc]

Offtop: Во блин, ну надо же было так лохануться! Про указатель на документ забыл! Е-мое...

[alex8888]

Do$,

Использовать такое в качестве готовой функции, конечно же, нельзя!

вот взял и так уронил
Хотя все же заработало.

Конечно у Алексея все классно, но смысл то не только в том, что он пишет грамотно, кто бы сомневался, а в том чтобы тоже хоть граммулечку так же как и он научиться делать.

После добавки его лисп заработал как часы.
Спасибо.

[Do$]

Сообщение от alex8888 вот взял и так уронил Хотя все же заработало.

Не уронил, а предостерег Дабы потом самому по шапке не получить

[alex8888]

Кулик Алексей aka kpblc,
как посмотреть что требуется функции vla-wblock, какие аргументы? В справке нет такой функции, в книгах тоже. Где вообще про "такое" почитать?

[Кулик Алексей aka kpblc]

В справке есть такая функция В консоли VLIDE пишется vla-wblock, потом нажимается Ctrl+F1 и на экране будет справка (в 2011 надо будет принудительно перед этим установить использование локальной справки и выполнить перезапуск AutoCAD'a). Ну и дополнительно http://www.cad.dp.ua/stats/vla_doc.php в руки, как говорится

[alex8888]

Кулик Алексей aka kpblc
Развернул таки справку, ессес-но на инглише (чуть не вырвалось на идише). Но там как для VBA написано:

Signature object.WBlock FileName, SelectionSet Object Document The object this method applies to. FileName String; input-only The file name to write the selection set to. SelectionSet SelectionSet object; input-only The name of the selection set.

Это оно?
Что, можно вместо object.WBlock просто вставлять vla-wblock, вместо object.SelectOnScreen - vla-onscreen?
А например object.HasExtensionDictionary - vla-HasExtensionDictionary -тоже верно?
А как определить, что за феня мне нужна? Там сто-о-о-олько методов и свойств !

[Кулик Алексей aka kpblc]

alex8888, так я ж ссылку дал, где про все это можно прочитать.
Offtop: Уже сильно хочется себе на сайт продублировать тот текст

[alex8888]

Кулик Алексей aka kpblc,
если ты про это:

Проблема в том, что она была написана для программистов на VBA, а не для программистов Visual LISP. Однако, Autodesk знает что “перевод” VBA-документации в Visual LISP был бы настолько прост, что нет реальной необходимости ее дублировать.

,
то я просто хотел лишний раз удостовериться в этом. Прошу прощения за назойливость

[Кулик Алексей aka kpblc]

Ну, на самом деле про то, что справка VBA практически идеально подходит для работы с ActiveX. Самое главное - не забывать, что

<...>первый параметр каждой функции vla- будет объектом непосредственно.

А я при написании своего кода именно этот момент и не проконтролировал
В качестве иллюстрации: если вариант замены веса линии для объекта в VBA выглядит как

Код:

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

objLine.Lineweight = acLnWt050

то для vlide получится

Код:

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

(vla-put-lineweight objline aclnwt050)

или расширенный (и по идее более верный) вариант

Код:

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

(vlax-put-property objline 'lineweight aclnwt050)
; либо (то же самое, но немного другая форма записи)
(vlax-put-property objline "lineweight" aclnwt050)

Варианты получения указателей на объект не рассматриваю.

[alex8888]

Кулик Алексей aka kpblc
если пошла такая пьянка, могу я попытать тебя еще?

Пытаясь разобрать твой код , встретил непонятные места. Я буду расшифровывать, а ты подскажи, что мне не понятно, хорошо?

Код:

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

(vl-load-com) ;загрузка функций VLisp

(defun c:test (/ adoc selsets selsetname vla_selset dwg_file wb_file) ;определение функции с перечислением аргументов (все локальные)

  (setq selsets    ;в переменной selsets сохранить
(vla-get-selectionsets ;полученный выбор из
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))) ; переменной открытого активного документа и 
        selsetname "wb" ;имени выборки
        ) ;_ end of setq
  (if (/= (setq dwg_file (vla-get-fullname adoc)) "") ;если полученное имя файла непустое 
    (progn
      (vl-catch-all-apply ; назначение этой функции не понял, но без нее не работает
        (function
          (lambda ()
            (vla-delete (vla-item selsets selsetname))  ;что и зачем удалять?
            ) ;_ end of lambda
          ) ;_ end of function
        ) ;_ end of vl-catch-all-apply
      (setq vla_selset (vla-add selsets selsetname)) ;здесь происходит выбор элементов и сохранение его в переменной vla_selset?, (если опустить функцию vl-catch-all-apply, то происходит затык, типа не правильные аргументы)
      (if (and (not (vl-catch-all-error-p ;проверка на срабатывание ошибки
                      (vl-catch-all-apply ;функции vl-catch-all-apply при
                        (function
                          (lambda ()
                            (vla-selectonscreen vla_selset);выборе объектов с экрана
                            ) ;_ end of lambda
                          ) ;_ end of function
                        ) ;_ end of vl-catch-all-apply
                      ) ;_ end of vl-catch-all-error-p
                    ) ;_ end of not
               (> (vla-get-count vla_selset) 0) ;и если есть что то в наборе, то есть что то выбрано
               ) ;_ end of and
        (progn ;далее - формирование пути вывода и имени файла
          (vla-wblock ;записать в файл
(setq wb_file ;создание имени из
(strcat (vl-filename-directory dwg_file) ;пути файла
                                            "\\" ;добавление косой черты после имени директории
                                            (vl-filename-base dwg_file) ;имени файла без расширения
                                            "-1.dwg" ;добавление к имени файла символов
                                            ) ;_ end of strcat
                            ) ;_ end of setq
                      vla_selset  ;что записать - полученный набор объектов
                      ) ;_ end of vla-Wblock
          (princ (strcat "\nНабор был сохранен в файл " wb_file)) ;просто подсказка о выполнении работы
          ) ;_ end of progn
        ) ;_ end of if
      (vl-catch-all-apply ;опять эта функция, зачем 2 раза?
        (function
          (lambda ()
            (vla-delete (vla-item selsets selsetname))
            ) ;_ end of lambda
          ) ;_ end of function
        ) ;_ end of vl-catch-all-apply
      ) ;_ end of progn
    (alert "Файл не сохранялся еще ни разу! Выполнение невозможно!") ;если имя полученного фала пустое, то сообщение о невозможности продолжения работы. Как такое может случиться, если изначально уже все чертежи имеют имена - чертеж1, чертеж2 и тп?
    ) ;_ end of if
  (princ)
  ) ;_ end of defun;стандартное завершение функции

Литературу изучаю, но vl-catch-all-apply -

[Кулик Алексей aka kpblc]

Сообщение от alex8888 vl-catch-all-apply -

Скажу честно - сейчас времени нет катастрофически. Посему отсылаю к http://autolisp.ru/2009/09/13/error-catch/
С остальным, извини, чуть попозже.

[Do$]

Сообщение от alex8888 (alert "Файл не сохранялся еще ни разу! Выполнение невозможно!") ;если имя полученного фала пустое, то сообщение о невозможности продолжения работы. Как такое может случиться, если изначально уже все чертежи имеют имена - чертеж1, чертеж2 и тп?

Очень просто - запусти AutoCAD с ярлыка на рабочем столе, автоматически откроется Drawind1(2,3,4...), который пока нигде не сохранен.
В такой ситуации выражение:

Код:

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

(getvar "dwgprefix")

выдает путь к папке "Мои документы", а:

Код:

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

(setq dwg_file (vla-get-fullname adoc))

пустую строку. А куда сохранять, если нет пути для сохранения? Поэтому и есть проверка, и предупреждение, что файл не сохранялся.

Сообщение от alex8888 (vla-delete (vla-item selsets selsetname)) ;что и зачем удалять?

Я так думаю, что удаляется набор из чертежа с названием selsetname, если такой присутсвует уже в чертеже. А если не присутствует - то возникает ошибка (наверное, не проверял), которую "отлавливает" vl-catch-all-apply.

[VVA]

alex8888, Чтобы понять ACTIVEX, нужно разобраться с объектной моделью Автокада. Understand the AutoCAD Object Model
Кратко можно сказать, что модель состоит из Объектов и их Коллекций (совокупности объектов).
Например Автокад состоит из коллекции открытых документов. Если взять документ, то он состоит из коллекций слоев, блоков, текстовых, размерных стилей.
Причем пространство модели и листов - это так же блоки Автокада. Сам блок (модель, лист или блок элемент чертежа состоит из отрезков, дуг, полилиний и т.д.)
Плюс помнить, что в Лиспе выполнение начинается с самого внутреннего(вложенного) оператора.

(setq selsets ;5. в переменной selsets сохранить коллекцию наборов (vla-get-selectionsets ;_ 4. Из всех коллеций текущего документа берем коллекцию наборов (setq adoc ;_3. запоминаем в переменную adoc (vla-get-activedocument 2. Из всех открытых документов (коллекции документов) берем текущий (активный) (vlax-get-acad-object) ;_ 1. Объект Автокада )))))

[grachev.p]

Всем добрый день!
Подскажите пожалуйста, товарищи знатоки. Проблемные моменты выделены красным.

Код:

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

;;; Автор идеи Kenny Ramage, Эдуард, Torino, он же Кочетков Андрей 
;;; Доработка Владимир Азарко (VVA)
;;; Опубликовано http://forum.dwg.ru/showpost.php?p=58664&postcount=25
;;;Автоматический перенос размеров на слой "размеры" 
;;;и заливки на слой "заливка" 
;;;Просто добавь этот файл в автозагрузку 
(vl-load-com) 
(setq *OldLayer* (getvar "CLAYER")) 
(vl-cmdf "_layer" "_make" "Размеры" "_color" 142 "" "_lw" 0.18 "" "") ;_Создаем слой размеры и задаем цвет 142 ... 
(vl-cmdf "_layer" "_make" "Штриховка" "_color" 5 "" "_lw" 0.30 "" "") ;_Создаем слой штриховка и задаем цвет 5 
(vl-cmdf "_layer" "_make" "Текст" "_color" 214 "" "_lw" 0.30 "" "")     ;_Создаем слой текст и задаем цвет 126
(vl-cmdf "_layer" "_make" "Таблицы" "_color" 126 "" "_lw" 0.30 "" "")   ;_Создаем слой таблицы и задаем цвет 126
(vl-cmdf "_layer" "_make" "Выноски" "_color" 126 "" "_lw" 0.18 "" "")   ;_Создаем слой выноски и задаем цвет 126
(setvar "clayer" *OldLayer*) 
(setq *OldLayer* nil) 
;;;;;;По аналогии добавить создание своего слоя 
;;; ... 
;;;;;; 
;;;;;;------------------------------------------------------------- 
(if *vlr-cmd* ;Не могу понять, как это работает. Для 
;чего тут в условии командный реактор? . 
  (progn
    (setq *vlr-cmd* nil)
    (vlr-remove-all :vlr-command-reactor)
    ) ;_ end of progn
  ) ;_ end of if
(if (not *vlr-cmd*) ; 
  (setq	*vlr-cmd* (vlr-command-reactor "cmd" 
		    '((:vlr-commandwillstart . cmd-start)
		      (:vlr-commandended . cmd-end)
		      (:vlr-commandcancelled . cmd-end)
		      (:vlr-commandfailed . cmd-end)))))
;;;;;;------------------------------------------------------------- 
(defun cmd-start (calling-reactor startcommandInfo / thecommandstart) ;calling-reactor startcommandInfo - для чего тут эти аргументы? 
   (setq thecommandstart (nth 0 startcommandInfo))
  (if (null *OldLayer*)(setq *OldLayer* (getvar "CLAYER")))
  (cond 
 ;;;_Реакция на начало команды DIM* (DIMALIGNED DIMLINEAR и все что начинается с DIM)    
    ((wcmatch thecommandstart "DIM*")  ;_Если выполняется команда DIM* 
     (setvar "clayer" "размеры")       ;_Слой размеры должен быть создан выше (vl-cmdf "_layer" ... 
    ) 
 ;;; Конец реакции на DIM*    
    ((wcmatch thecommandstart "*HATCH*") ;_Если выполняется команда *HATCH* 
     (setvar "clayer" "штриховка") 
    ) 
    ((wcmatch thecommandstart "*TEXT") ;_Если выполняется команда *TEXT (TEXT DTEXT) 
     (setvar "clayer" "Текст") 
    )
    ((wcmatch thecommandstart "*TABLE") ;_Если выполняется команда *TABLE
     (setvar "clayer" "Таблицы") 
    )
    ((wcmatch thecommandstart "*LEADER") ;_Если выполняется команда *QLEADER MLEADER
     (setvar "clayer" "Выноски") 
    )
    (t (setq *OldLayer* nil)) ;;_Если не наша команда, чистим список текущих слоев
;;;См http://forum.dwg.ru/showpost.php?p=318806&postcount=139
;;;и http://forum.dwg.ru/showpost.php?p=318806&postcount=143
    )
  (princ)) 
 ;;;------------------------------------------------------------- 
(defun cmd-end (calling-reactor cmd / cmd_name)
(setq cmd_name (strcase (car cmd)))
(if (or
      (wcmatch cmd_name "*HATCH*") ;_Если выполняется команда DIM*
      (wcmatch cmd_name "DIM*")    ;_Если выполняется команда *HATCH*
      (wcmatch cmd_name "*TEXT")   ;_Если выполняется команда *TEXT (TEXT DTEXT)
      (wcmatch cmd_name "*TABLE")   ;_Если выполняется команда ТАБЛИЦА
      (wcmatch cmd_name "*LEADER")   ;_Если выполняется команда *QLEADER или MLEADER
      )
  (progn
    (if *OldLayer* (setvar "clayer" *OldLayer*)) 
    (setq *OldLayer* nil)
    ))
 (princ))

Заранее спасибо!

[VVA]

*vlr-cmd* - глобальная переменная, в которой запоминается указатель на командный реактор. Скажем пользователь взял и дважды (трижды и т.д.) в один документ в одном сеансе загрузил этот лисп.
Вопрос: сколько командных реакторов должно создаться?
Поэтому и сделана проверка, если *vlr-cmd* не nil, значит кто-то раньше создавал реактор.

[grachev.p]

Сообщение от VVA Вопрос: сколько командных реакторов должно создаться?

Так этот реактор запоминается в переменную с таким же именем. Или эта переменная не переопределяется при повторном присвоении какого-либо значения?

А так, в общем понял, для чего эта проверка. Спасибо еще раз.

PS. Вопрос отменяется. Нашел информацию по реакторам, прочитал, все стало ясно.

[superkot007]

1. Перенос объекта (блок, текст, отрезок, полилиния и пр. 2D-объекты) с выбранной точкой в нужную точку на чертеже - как уйти от геморроя с шаговой привязкой?
2. Разбить M-TEXT в D-TEXT с сохранением, если возможно, выравниваний M-TEXT'а
Кулик Алексей aka kpblc, это просьба чайника

Сообщение от gomer Алексей, просто пропущены слова: Сделайте мне, пожалуйста...

Что-то пропустил самое главное - вежливо попросить...

[Кулик Алексей aka kpblc]

superkot007, и что это было?

[gomer]

Алексей, просто пропущены слова: Сделайте мне, пожалуйста...

[mmax]

Сообщение от VVA *vlr-cmd* - глобальная переменная, в которой запоминается указатель на командный реактор. Скажем пользователь взял и дважды (трижды и т.д.) в один документ в одном сеансе загрузил этот лисп. Вопрос: сколько командных реакторов должно создаться? Поэтому и сделана проверка, если *vlr-cmd* не nil, значит кто-то раньше создавал реактор.

В зоопарке 12 обезьян. Каждой выдали по гранате Ф1.
Вопрос: расчитать вероятность возникновения взрыва.

[alex8888]

mmax,Offtop:

В зоопарке 12 обезьян. Каждой выдали по гранате Ф1. Вопрос: расчитать вероятность возникновения взрыва.

Ответ: 12/13?

[gomer]

>mmax: Кто потом обезьян собирать будет?

Сообщение от grachev.p (vl-cmdf "_layer" "_make" "Размеры" "_color" 142 "" "_lw" 0.18 "" "") ;_Создаем слой размеры и задаем цвет 142 ... (vl-cmdf "_layer" "_make" "Штриховка" "_color" 5 "" "_lw" 0.30 "" "") ;_Создаем слой штриховка и задаем цвет 5 (vl-cmdf "_layer" "_make" "Текст" "_color" 214 "" "_lw" 0.30 "" "") ;_Создаем слой текст и задаем цвет 126 (vl-cmdf "_layer" "_make" "Таблицы" "_color" 126 "" "_lw" 0.30 "" "") ;_Создаем слой таблицы и задаем цвет 126 (vl-cmdf "_layer" "_make" "Выноски" "_color" 126 "" "_lw" 0.18 "" "") ;_Создаем слой выноски и задаем цвет 126

это могло бы выглядеть так:

Код:

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

(mapcar	'(lambda (x) (vl-cmdf "_layer" "_make" (nth 0 x) "_color" (nth 1 x) "" "_lw" (nth 2 x) "" ""))
    (list
      '("Размеры" 142 0.18) ;_Создаем слой размеры и задаем цвет 142 ...
      '("Штриховка" 5 0.30) ;_Создаем слой штриховка и задаем цвет 5
      '("Текст" 214 0.30)   ;_Создаем слой текст и задаем цвет   126
      '("Таблицы" 126 0.30) ;_Создаем слой таблицы и задаем цвет 126
      '("Выноски" 126 0.18));_Создаем слой выноски и задаем цвет 126
)

[mmax]

Сообщение от gomer >mmax: Кто потом обезьян собирать будет?

будет конечно лучше гранаты не выдавать. Обезьянам.

[grachev.p]

Сообщение от gomer это могло бы выглядеть так:

Если честно, вот сколько читаю я про эту люмбда функцию у Полещука, так и не могу никак сообразить, как она работает

[Кулик Алексей aka kpblc]

Сообщение от grachev.p Если честно, вот сколько читаю я про эту люмбда функцию у Полещука, так и не могу никак сообразить, как она работает

http://autolisp.ru/2009/09/16/lambda-functions/ не поможет?

[grachev.p]

Спасибо, Алексей Прочитаю твою статью, думаю, что поможет.

[superkot007]

Можно попросить модифицировать LISP из http://forum.dwg.ru/showpost.php?p=564014&postcount=828 еще и "под" D-text и блоки (выравнивание по базовой точке)?

Помогите, пожалуйста, со следующими проблемами
1. Перенос объекта (блок, текст, отрезок, и пр. 2D-объекты) с базовой точкой в нужную точку на чертеже?
2. Разбить M-TEXT в D-TEXT с сохранением, если возможно, выравниваний M-TEXT'а
3. Преобразование полилинии в отрезки (может, плохо искал по форуму, но не нашел; с преобразованием отрезков в полилинии видел темы)
4. Переделать lisp из G-tools

Код:

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

;;;------------------------------------>JOIN1<-------------------------------------;;;
;;;                Команда объединения двух отрезков, дуг или текста               ;;;
;;;                            JOIN1.lsp Version 1.2                              ;;;
;;;                          Автор: Протасов Георгий                               ;;;
;;;Программа объединяет два отрезка или дуги, соединяя их наиболее удаленные точки,;;;
;;;замыкает дуги, объединяет текст                                                 ;;;
;;;--------------------------------------------------------------------------------;;;

(DEFUN JOIN1 ( / ed1 ed2
      cmdecho-save error-save
      REMDXFCODE ANGDISTANCE CLOSEELLIPSE CLOSEARC JOINLINES JOINELLIPSES JOINARCHES)
   (SETQ error-save *error*
      cmdecho-save (GETVAR "CMDECHO")
      );SETQ
 
   (DEFUN *error* (msg)
      (IF  error-save (SETQ *error* error-save))
      (IF msg (PRINC "\nВыполнение функции прервано "))
      ;; Восстановление значений системных переменных
      (SETVAR "CMDECHO" cmdecho-save)
      (IF ed1 (REDRAW (CDR (ASSOC -1 ed1)) 4))
      (PRINC)
      );DEFUN

   ;; Функция удаления всех вхождений DXF кода из описания примитива
   (DEFUN REMDXFCODE (code l)
      (COND
         ((NULL l) nil)
         ((= code (CAAR l)) (REMDXFCODE code (CDR l)))
         ((EQUAL n (CAR l)) (REMDXFCODE code (CDR l)))
         (t (CONS (CAR l) (REMDXFCODE code (CDR l))))
         );COND
      );DEFUN

   ;; Функция определения углового расстояния
   (DEFUN ANGDISTANCE (ang1 ang2)
      (COND
         ((> (ABS (- ang1 ang2)) pi) (- (* 2 pi) (ABS (- ang1 ang2))))
         (t (ABS (- ang1 ang2)))
         );COND
      );DEFUN

   ;; Функция замыкания эллипса
   (DEFUN CLOSEELLIPSE (ed)
      (SETQ
         ed (SUBST (CONS 41 0.0)(ASSOC 41 ed) ed)
         ed (SUBST (CONS 42 (* 2 pi))(ASSOC 42 ed) ed)
         );SETQ
      (ENTMOD  ed)
      );DEFUN

   ;; Функция замыкания дуги
   (DEFUN CLOSEARC (ed / ed1 code)
      (SETQ ed1 (SUBST (CONS 0 "CIRCLE")(ASSOC 0 ed) ed))
      (FOREACH code '(-1 5 50 51 100 102 330 360)
         (SETQ ed1 (REMDXFCODE code ed1))
         );FOREACH
      (ENTMAKE  ed1)
      (ENTDEL (CDR (ASSOC -1 ed)))
      );DEFUN

   ;;Функция обединения текста
   (DEFUN JOINTEXT (ed1 ed2 / txt1 txt2)
      (SETQ
         txt1 (CDR (ASSOC 1 ed1))
         txt2 (CDR (ASSOC 1 ed2))
         txt1 (IF (= " " (SUBSTR txt1 (STRLEN txt1)))
            (STRCAT txt1 txt2)
            (STRCAT txt1 " " txt2)
            );IF
         );SETQ
      (SETQ ed1 (SUBST (CONS 1 txt1)(ASSOC 1 ed1) ed1))
      (ENTMOD ed1)
      (ENTDEL (CDR (ASSOC -1 ed2)))
      );DEFUN

   ;;Функция обединения отрезков
   (DEFUN JOINLINES (ed1 ed2 / p1 p2 p3 p4 pnt1 pnt2)
      (SETQ
         p1 (CDR (ASSOC 10 ed1))
         p2 (CDR (ASSOC 11 ed1))
         p3 (CDR (ASSOC 10 ed2))
         p4 (CDR (ASSOC 11 ed2))
         );SETQ
      (IF (> (MAX (DISTANCE p1 p3) (DISTANCE p1 p4))
            (MAX (DISTANCE p2 p3) (DISTANCE p2 p4)))
         (SETQ pnt1 p1)
         (SETQ pnt1 p2)
         );IF
      (IF (> (DISTANCE pnt1 p3) (DISTANCE pnt1 p4))
         (SETQ pnt2 p3)
         (SETQ pnt2 p4)
         );IF
      (SETQ
         ed1 (SUBST (CONS 10 pnt1)(ASSOC 10 ed1) ed1)
         ed1 (SUBST (CONS 11 pnt2)(ASSOC 11 ed1) ed1)
         );SETQ
      (ENTMOD ed1)
      (ENTDEL (CDR (ASSOC -1 ed2)))
      );DEFUN

   ;;Функция обединения эллиптических дуг
   (DEFUN JOINELLIPSES (ed1 ed2 / a1 a2 a3 a4 ang1 ang2)
      (COND
         ((NOT (EQUAL (CDR (ASSOC 10 ed1)) (CDR (ASSOC 10 ed2))))
            (PRINC "\nНе совпадают центры дуг! ")
            (IF ed1 (REDRAW (CDR (ASSOC -1 ed1)) 4))
            )
         ((OR
               (NOT (EQUAL (CDR (ASSOC 11 ed1)) (CDR (ASSOC 11 ed2))))
               (NOT (EQUAL (CDR (ASSOC 40 ed1)) (CDR (ASSOC 40 ed2))))
               );OR
            (PRINC "\nНе совпадают полуоси эллипсов! ")
            (IF ed1 (REDRAW (CDR (ASSOC -1 ed1)) 4))
            )
         (t (SETQ
               a1 (CDR (ASSOC 41 ed1))
               a2 (CDR (ASSOC 42 ed1))
               a3 (CDR (ASSOC 41 ed2))
               a4 (CDR (ASSOC 42 ed2))
               );SETQ
            (IF (< (ANGDISTANCE a1 a4) (ANGDISTANCE a2 a3))
               (SETQ
                  ang1 a3
                  ang2 a2
                  );SETQ
               (SETQ
                  ang1 a1
                  ang2 a4
                  );SETQ
               );IF
            (SETQ
               ed1 (SUBST (CONS 41 ang1)(ASSOC 41 ed1) ed1)
               ed1 (SUBST (CONS 42 ang2)(ASSOC 42 ed1) ed1)
               );SETQ
            (ENTMOD ed1)
            (ENTDEL (CDR (ASSOC -1 ed2)))
            );t
         );COND
      );DEFUN

   ;;Функция обединения круговых дуг
   (DEFUN JOINARCHES (ed1 ed2 / a1 a2 a3 a4 ang1 ang2)
      (COND
         ((NOT (EQUAL (CDR (ASSOC 10 ed1)) (CDR (ASSOC 10 ed2))))
            (PRINC "\nНе совпадают центры дуг! ")
            (IF ed1 (REDRAW (CDR (ASSOC -1 ed1)) 4))
            )
         ((NOT (EQUAL (CDR (ASSOC 40 ed1)) (CDR (ASSOC 40 ed2))))
            (PRINC "\nНе совпадают радиусы дуг! ")
            (IF ed1 (REDRAW (CDR (ASSOC -1 ed1)) 4))
            )
         (t (SETQ
               a1 (CDR (ASSOC 50 ed1))
               a2 (CDR (ASSOC 51 ed1))
               a3 (CDR (ASSOC 50 ed2))
               a4 (CDR (ASSOC 51 ed2))
               );SETQ
            (IF (< (ANGDISTANCE a1 a4) (ANGDISTANCE a2 a3))
               (SETQ
                  ang1 a3
                  ang2 a2
                  );SETQ
               (SETQ
                  ang1 a1
                  ang2 a4
                  );SETQ
               );IF
            (SETQ
               ed1 (SUBST (CONS 50 ang1)(ASSOC 50 ed1) ed1)
               ed1 (SUBST (CONS 51 ang2)(ASSOC 51 ed1) ed1)
               );SETQ
            (ENTMOD ed1)
            (ENTDEL (CDR (ASSOC -1 ed2)))
            );t
         );COND
      );DEFUN
 
;;; Основной текст программы
   (SETVAR "CMDECHO" 0)
   (COMMAND "_.undo" "_begin")
   (SETQ ed1 (ENTGET (CAR (ENTSEL "\nВыберите 1-ю линию, дугу или текст"))))
   (WHILE (NOT (MEMBER (CDR (ASSOC 0 ed1)) '("LINE" "ELLIPSE" "ARC" "TEXT")))
      (PROGN
         (PRINC "\nНеверный тип примитива! ")
         (SETQ ed1 (ENTGET (CAR (ENTSEL "\nВыберите 1-ю линию, дугу или текст"))))
         );PROGN
      );IF
   (REDRAW (CDR (ASSOC -1 ed1)) 3)
   (COND
      ((EQ (CDR (ASSOC 0 ed1)) "ARC")
         (SETQ ed2 (ENTSEL "\nВыберите 2-ю дугу или <ENTER>, чтобы замкнуть"))
         (IF (NULL ed2) (CLOSEARC ed1)
            (PROGN
               (SETQ ed2 (ENTGET (CAR ed2)))
               (WHILE (NOT (EQ (CDR (ASSOC 0 ed2)) "ARC"))
                  (PROGN
                     (PRINC "\nНеверный тип примитива! ")
                     (SETQ ed2 (ENTGET (CAR (ENTSEL "\nВыберите 2-ю дугу"))))
                     );PROGN
                  );WHILE
               (JOINARCHES ed1 ed2)
               );PROGN
            );IF
         );ARC
      ((EQ (CDR (ASSOC 0 ed1)) "ELLIPSE")
         (SETQ ed2 (ENTSEL "\nВыберите 2-ю дугу или <ENTER>, чтобы замкнуть"))
         (IF (NULL ed2) (CLOSEELLIPSE ed1)
            (PROGN
               (SETQ ed2 (ENTGET (CAR ed2)))
               (WHILE (NOT (EQ (CDR (ASSOC 0 ed2)) "ELLIPSE"))
                  (PROGN
                     (PRINC "\nНеверный тип примитива! ")
                     (SETQ ed2 (ENTGET (CAR (ENTSEL "\nВыберите 2-ю дугу"))))
                     );PROGN
                  );WHILE
               (JOINELLIPSES ed1 ed2)
               );PROGN
            );IF
         );ELLIPSE
      ((EQ (CDR (ASSOC 0 ed1)) "LINE")
         (SETQ ed2 (ENTGET (CAR (ENTSEL "\nВыберите 2-ю линию"))))
         (WHILE (NOT (EQ (CDR (ASSOC 0 ed2)) "LINE"))
            (PROGN
               (PRINC "\nНеверный тип примитива! ")
               (SETQ ed2 (ENTGET (CAR (ENTSEL "\nВыберите 2-ю линию"))))
               );PROGN
            );WHILE
         (JOINLINES ed1 ed2)
         );LINE
      ((EQ (CDR (ASSOC 0 ed1)) "TEXT")
         (SETQ ed2 (ENTGET (CAR (ENTSEL "\nВыберите 2-й текст"))))
         (WHILE (NOT (EQ (CDR (ASSOC 0 ed2)) "TEXT"))
            (PROGN
               (PRINC "\nНеверный тип примитива! ")
               (SETQ ed2 (ENTGET (CAR (ENTSEL "\nВыберите 2-й текст"))))
               );PROGN
            );WHILE
         (JOINTEXT ed1 ed2)
         );TEXT
      );COND
   (REDRAW (CDR (ASSOC -1 ed1)) 4)
   (COMMAND "_.undo" "_end")
   (SETVAR "CMDECHO" cmdecho-save)
   (SETQ *error* error-save)
   (PRINC)
   );DEFUN

(IF (OR (NULL C:JOIN1)
      (NOT (LISTP C:JOIN1))
      );OR
   (DEFUN C:JOIN1 ()
      (JOIN1)
      );DEFUN
   );IF
(PRINC "\nJOIN1.lsp загружен... ")
(PRINC "\nДобавлена команда JOIN1...")
(PRINC)

под объединение отрезков по выделению (иногда несколько отрезков - больше 2-х - находятся один под одним, бывают разной длины). Хотелось бы "кучей" объединять выделенное в один отрезок
P.S. Для циклической работы команд нужно добавить в пункте меню * (*^c^c) ?

[grachev.p]

Сообщение от superkot007 под объединение отрезков по выделению (иногда несколько отрезков - больше 2-х - находятся один под одним, бывают разной длины). Хотелось бы "кучей" объединять выделенное в один отрезок

А чем _overkill из ET для этого не подходит?

[superkot007]

Сообщение от grachev.p А чем _overkill из ET для этого не подходит?

Подходит для ограниченного круга задач...

1. Отрезки должны полностью или частично накладываться друг на друга
2. Если отрезки под углом, отличающимся от 0 - никакого толку от _overkill
3. Меню ET "закрыто" (настройка админская такая на работе)
4. Мелочь, но... "лишнее" диалоговое окно, да и с "буржуйским" напряжно...

Хотя за совет спасибо Надеюсь, кто-нибудь поможет в моих проблемах

[grachev.p]

Подскажите пожалуйста.

Вот лисп, который делает подобие на нужный мне слой, величина которого зависит от масштаба аннотаций. Все бы ничего, не не пойму, как сделать так, чтобы при прерывании клавишей Esc или какой-либо другой командой слой все равно восстанавливался на тот, который был до выполнения этого лиспа?

Код:

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

(defun c:KKK (/ AnnScaleValue offset_value)
(setq     adoc         (vla-get-activedocument (vlax-get-acad-object))
    OldLayer    (getvar "CLAYER")
    AnnScaleValue    (getvar "CANNOSCALEVALUE")
    offset_value    (/ 3 AnnScaleValue)
    lst         (vl-sort
                  ((lambda (/ res name)
                   (vlax-for item (vla-get-layers adoc)
                       (if (not (wcmatch (setq name (vla-get-name item)) "*|*"))
                       (setq res (cons name res))
                       ) ;_ end of if
                   ) ;_ end of vlax-for
                   (reverse res)
                   ) ;_ end of lambda
                  )
                  '<
              ) ;_ end of vl-sort
) ;_ end of setq
(if (member "Кант" (reverse (member "Кант" lst)))
    (setvar "CLAYER" "Кант")
    (vl-cmdf "_layer" "_make" "Кант" "_color" 13 "" "_lw" 1.00 "" "") ;_ end of vl-cmdf
)
(command "_offset" "_L" "_current" offset_value)
(while (/= (logand (getvar "cmdactive") 31) 0)
    (command pause)
) ;_ end of while
(setvar "CLAYER" OldLayer)
)

[Do$]

1. Попробуй все command заменить на vl-cmdf
2. Используй это: http://forum.dwg.ru/showthread.php?t=22945

[VVA]

Сообщение от grachev.p не не пойму, как сделать так, чтобы при прерывании клавишей Esc

Основное выделил красным. Вдобавок не вижу смысла в том, чтобы перебирать и сортировать слои vl-* функциями для того, чтобы проверить наличие слоя. Кроме того опция _make команды _-layer создает слой и устанавливает его текущим. От конструкции (if (tblsearch "LAYER" "Кант") можно отказаться, оставив просто (command "_-Layer" ...)

Код:

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

(defun c:KKK (/ AnnScaleValue offset_value *error*)
  (defun *error* (msg)
    (setvar "CLAYER" OldLayer)
    (princ msg)
    (princ)
    )
(setq OldLayer    (getvar "CLAYER")
      AnnScaleValue    (getvar "CANNOSCALEVALUE")
      offset_value    (/ 3 AnnScaleValue)
) ;_ end of setq
(if (tblsearch "LAYER"  "Кант")
    (setvar "CLAYER" "Кант")
    (command "_-layer" "_make" "Кант" "_color" 13 "" "_lw" 1.00 "" "")
)
(command "_offset" "_L" "_current" offset_value)
(while (/= (logand (getvar "cmdactive") 31) 0)
    (command pause)
) ;_ end of while
(setvar "CLAYER" OldLayer)
)

Можно попросить модифицировать LISP из http://forum.dwg.ru/showpost.php?p=564014&postcount=828 еще и "под" D-text и блоки (выравнивание по базовой точке)?

Сделал. Пробуй

[grachev.p]

Сообщение от VVA Цитата: Сообщение от grachev.p Посмотреть сообщение не не пойму, как сделать так, чтобы при прерывании клавишей Esc Основное выделил красным. Вдобавок не вижу смысла в том, чтобы перебирать и сортировать слои vl-* функциями для того, чтобы проверить наличие слоя. Кроме того опция _make команды _-layer создает слой и устанавливает его текущим. От конструкции (if (tblsearch "LAYER" "Кант") можно отказаться, оставив просто (command "_-Layer" ...)

Спасибо. Более менее теперь понял работу функции *error*.

Сообщение от Do$ 1. Попробуй все command заменить на vl-cmdf 2. Используй это: http://forum.dwg.ru/showthread.php?t=22945

Тоже проясняется ситуация по этому отлову ошибок.

[superkot007]

Сообщение от VVA Сделал. Пробуй

Спасибо, работает (никто и не сомневался) . А "преобразование" мульти-текст в однострочный можно попросить сделать?

[VVA]

Сообщение от superkot007 А "преобразование" мульти-текст в однострочный можно попросить сделать?

1. LISP. Очистка форматирования многострочного текста
2. _explode или _Xplode на выбор

[superkot007]

Сообщение от VVA 1. LISP. Очистка форматирования многострочного текста 2. _explode или _Xplode на выбор

1. Не догоняю, как запускать
2. _explode разбивает в полилинии, _Xplode не дает никакого эффекта...
Вообще пробовал на 2011-ом (хотя вряд ли от версии зависит)

[grachev.p]

Сообщение от superkot007 2. _explode разбивает в полилинии, _Xplode не дает никакого эффекта... Вообще пробовал на 2011-ом (хотя вряд ли от версии зависит)

_explode разбивает как надо М-Текст, то есть в однострочный. Честно говоря, хотел сразу тебе такой вариант предложить, но потом подумал, что ты уже его испробовал и тебе нужно что-то другое.

Автокад тоже 2011.

А _xplode тоже эффекта не дает.

[superkot007]

Сообщение от grachev.p _explode разбивает как надо М-Текст, то есть в однострочный.

Действительно, ступил, наверное, вводил _exploded (больше никак не могу объяснить)

[VVA]

Да, _XPLODE почему-то не разбивает мтекст. Сама команда задумывалась как расширение EXPLODE. Читать про XPLODE

[alex8888]

Очередная загвоздка

Подскажите, как в коде http://forum.dwg.ru/showpost.php?p=565984&postcount=836

путем vla- выбрать только объекты с определенного уровня в выделяемой области?
И насколько правильно командным методом вот так :

(setq NABOR (ssget "_X" '((8 . "0,SF-TEXT,LASER-TEXT"))))

?

[superkot007]

Напишите, пожалуйста, lisp для загрузки файла меню (естественно, все в одной папке) и путей к вспомогательным файлам (включая все подпапки), и lisp для их выгрузки

[gomer]

(command "menuload" "menufile.mns")
(command "menuunload" "menugroupname")

[superkot007]

Сообщение от gomer (command "menuload" "menufile.mns") (command "menuunload" "menugroupname")

Не катит...
Во-первых - должно быть _menuload (у меня русский 2011-ый),
во-вторых - спрашивает файл адаптации (а не меню)и все равно, ввод правильного имени меню ничего не дает,
в-третьих - я просил прописывание путей к вспомогательным файлам (само меню загрузить не проблема, нудно прописывать папки для доступа)

[ShaggyDoc]

Сообщение от gomer (command "menuload" "menufile.mns") (command "menuunload" "menugroupname")

gomer, а кто про "безграмотных лиспописателей" возбуждение создавал?

Если уж советовать, то грамотно. Шоп работало. То есть имена команд и опций с префиксами, а имена файлов - полные, шоб с гарантией было.

[gomer]

Сообщение от ShaggyDoc а кто про "безграмотных лиспописателей" возбуждение создавал?

Сообщение от superkot007 Во-первых - должно быть _menuload (у меня русский 2011-ый)

у меня bricscad и как теперь быть

Сообщение от superkot007 прописывание путей к вспомогательным файлам

Все папки можно не прописывать, используя относительные пути... Посмотри здесь: http://dwg.ru/dnl/4649 как организовано... может найдешь чего полезного...
...еще вот к размышлению

Код:

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

(defun $incdec-setenv(/ MenuFile)
	(cond
		((setq MenuFile(findfile "INCDEC.mns")))
		((setq MenuFile(getfiled "Открыть файл меню" (strcat (getenv "PROGRAMFILES") "/INCDEC/ INCDEC") "mns" 4))
		(setenv "ACAD"(strcat(getenv "ACAD")";"(substr MenuFile 1(-(strlen MenuFile)11)))))
		(T nil)))

[ShaggyDoc]

у меня bricscad и как теперь быть

Не давать советы по AutoCAD. Или давать советы по "bricscad".

[Рyslan]

можно посредством лиспа вставить блок в текущий чертеж, если блок прописан в путях доступа вспомогательных файлах?

[Кулик Алексей aka kpblc]

Можно. Геморройно в некоторых случаях, но можно.

[Lymus]

Добрый вечер, поправьте пожалуйста, не пойму почему не работает код в AC2010, на АС2007 все нормально работало, назначение: написание текста определенной высоты

Код:

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

(defun C:TXT_5 ()
(setvar "cmdecho" 0)
(if (= (getvar "dimscale") 0) (setq M 1) (setq M (getvar "dimscale"))) 
(setq
  T1  (getpoint "\n Покажите начало текста: ")
  H   (* 5 M))
(command "_.dtext" T1 H 0))

[superkot007]

Сообщение от Lymus Добрый вечер, поправьте пожалуйста, не пойму почему не работает код в AC2010, на АС2007 все нормально работало, назначение: написание текста определенной высоты Код: [Выделить все] (defun C:TXT_5 () (setvar "cmdecho" 0) (if (= (getvar "dimscale") 0) (setq M 1) (setq M (getvar "dimscale"))) (setq T1 (getpoint "\n Покажите начало текста: ") H (* 5 M)) (command "_.dtext" T1 H 0))

Ну не знаю насчет 2010, но на 2011 работает прекрасно. Спасибо.

[VVA]

Сообщение от Lymus Добрый вечер, поправьте пожалуйста, не пойму почему не работает код в AC2010, на АС2007 все нормально работало, назначение: написание текста определенной высоты

В текущем стиле текста задана высота > 0

Код:

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

(defun C:TXT_5 ()
(setvar "cmdecho" 0)
(if (= (getvar "dimscale") 0) (setq M 1) (setq M (getvar "dimscale"))) 
(setq
  T1  (getpoint "\n Покажите начало текста: ")
  H   (* 5 M))
  (if (= (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE")))) 0.0)
    (command "_.dtext" T1 H 0)
    (alert (strcat
             "Установи в 0 высоту текущего\n"
              "текстового стиля "
             (getvar "TEXTSTYLE")
             "\nили смени стиль"
             )
           )
    )
  )

[Lymus]

Добрый день, все равно команды не работают на лиспе для определенной высоты текста, текущий текстовый стиль (высота стоит 0.00), скажите пожалуйста в чем ошибка и если не трудно поправьте. Исправно работает только кнопка масштаб, при попытке вызова команды текста пишет неизвестная команда. Асад 2010 англ..
Моя панелька

***MENUGROUP=myACAD ***POP602 **МАСШТАБ [Масштаб] [$(if,$(eq,$(getvar,dimscale),1),!.)М1:1]dimscale;1; [$(if,$(eq,$(getvar,dimscale),5),!.)М1:5]dimscale;5; [$(if,$(eq,$(getvar,dimscale),10),!.)М1:10]dimscale;10; [$(if,$(eq,$(getvar,dimscale),15),!.)М1:15]dimscale;15; [$(if,$(eq,$(getvar,dimscale),20),!.)М1:20]dimscale;20; [$(if,$(eq,$(getvar,dimscale),25),!.)М1:25]dimscale;25; [$(if,$(eq,$(getvar,dimscale),40),!.)М1:40]dimscale;40; [$(if,$(eq,$(getvar,dimscale),50),!.)М1:50]dimscale;50; [$(if,$(eq,$(getvar,dimscale),75),!.)М1:75]dimscale;75; [$(if,$(eq,$(getvar,dimscale),100),!.)М1:100]dimscale;100; [$(if,$(eq,$(getvar,dimscale),150),!.)М1:150]dimscale;150; [$(if,$(eq,$(getvar,dimscale),200),!.)М1:200]dimscale;200; [$(if,$(eq,$(getvar,dimscale),250),!.)М1:250]dimscale;250; [$(if,$(eq,$(getvar,dimscale),300),!.)М1:300]dimscale;300; [$(if,$(eq,$(getvar,dimscale),400),!.)M1:400]dimscale;400; [$(if,$(eq,$(getvar,dimscale),500),!.)М1:500]dimscale;500; [--] [$(if,$(eq,$(getvar,dimscale),0.5),!.)М2:1]dimscale;0.5; [$(if,$(eq,$(getvar,dimscale),0.2),!.)М5:1]dimscale;0.2; [--] [ВЫХОД]$s= ***TOOLBARS **МАСШТАБ [_Toolbar("МАСШТАБ", _Floating, _Hide, 0, 0, 1)] [_Button("Масштаб", "images/16_masst.bmp", "images/16_masst.bmp")]$p0=масштаб $p0=* **ТЕКСТ [_Toolbar("ТЕКСТ", _Floating, _Hide, 1, 0, 1)] [_Button("Текст горизонтальный -2.5 мм", "images/16_txt_2.5.bmp", "images/16_txt_3.bmp")]^C^C_TXT_2.5 [_Button("Текст горизонтальный -3.5 мм", "images/16_txt_3.5.bmp", "images/16_txt_3.bmp")]^C^C_TXT_3.5 [_Button("Текст горизонтальный -5.0 мм", "images/16_txt_5.bmp", "images/16_txt_5.bmp")]^C^C_TXT_5.0 **myACAD [_Toolbar("myACAD", _Floating, _Hide, 0, 0, 1)] [_Button("Масштаб", "images/16_masst.bmp", "images/16_masst.bmp")]$p0=масштаб $p0=* [_Button("Текст горизонтальный -2.5 мм", "images/16_txt_2.5.bmp", "images/16_txt_2.bmp")]^C^C_TXT_2.5 [_Button("Текст горизонтальный -3.5 мм", "images/16_txt_3.5.bmp", "images/16_txt_3.bmp")]^C^C_TXT_3.5 [_Button("Текст горизонтальный -5.0 мм", "images/16_txt_5.bmp", "images/16_txt_5.bmp")]^C^C_TXT_5.0 [_Button("Характеристики сечения", "images/16_rectang.bmp", "images/16_txt_5.bmp")]^C^C_SECHEN ***HELPSTRINGS

и кнопка текста (для примера) высотой 2,5мм

(defun C:TXT_2.5 () (setvar "cmdecho" 0) (if (= (getvar "dimscale") 0) (setq M 1) (setq M (getvar "dimscale"))) (setq T1 (getpoint "\n Покажите начало текста: ") H (* 2.5 M)) (command "_.dtext" T1 H 0))

[VVA]

Попробуй убрать красненькое

[_Button("Текст горизонтальный -2.5 мм", "images/16_txt_2.5.bmp", "images/16_txt_2.bmp")]^C^C_TXT_2.5

[Lymus]

Спасибо большое за помощь, после удаления нижнего подчеркивания не работала команда, в итоге между 2 и 5 убрал точку и все заработало.
Большая просьба к VVA посмотреть еще раз код, может у меня конечно что не так с автокадом, но панелька работает через раз, просто пишет неизвестная команда, или может я что не так загружаю, хотя там ничего хитрого нет, функция масштаба работает исправно, функция 3-х высот текста работает неверно - пишет неизвестная команда
еще раз выкладываю панельку свою

***MENUGROUP=myCAD ***POP602 **МАСШТАБ [Масштаб] [$(if,$(eq,$(getvar,dimscale),1),!.)М1:1]dimscale;1; [$(if,$(eq,$(getvar,dimscale),5),!.)М1:5]dimscale;5; [$(if,$(eq,$(getvar,dimscale),10),!.)М1:10]dimscale;10; [$(if,$(eq,$(getvar,dimscale),15),!.)М1:15]dimscale;15; [$(if,$(eq,$(getvar,dimscale),20),!.)М1:20]dimscale;20; [$(if,$(eq,$(getvar,dimscale),25),!.)М1:25]dimscale;25; [$(if,$(eq,$(getvar,dimscale),40),!.)М1:40]dimscale;40; [$(if,$(eq,$(getvar,dimscale),50),!.)М1:50]dimscale;50; [$(if,$(eq,$(getvar,dimscale),75),!.)М1:75]dimscale;75; [$(if,$(eq,$(getvar,dimscale),100),!.)М1:100]dimscale;100; [$(if,$(eq,$(getvar,dimscale),150),!.)М1:150]dimscale;150; [$(if,$(eq,$(getvar,dimscale),200),!.)М1:200]dimscale;200; [$(if,$(eq,$(getvar,dimscale),250),!.)М1:250]dimscale;250; [$(if,$(eq,$(getvar,dimscale),300),!.)М1:300]dimscale;300; [$(if,$(eq,$(getvar,dimscale),400),!.)M1:400]dimscale;400; [$(if,$(eq,$(getvar,dimscale),500),!.)М1:500]dimscale;500; [--] [$(if,$(eq,$(getvar,dimscale),0.5),!.)М2:1]dimscale;0.5; [$(if,$(eq,$(getvar,dimscale),0.2),!.)М5:1]dimscale;0.2; [--] [ВЫХОД]$s= ***TOOLBARS **МАСШТАБ [_Toolbar("МАСШТАБ", _Floating, _Hide, 0, 0, 1)] [_Button("Масштаб", "images/16_masst.bmp", "images/16_masst.bmp")]$p0=масштаб $p0=* **ТЕКСТ [_Toolbar("ТЕКСТ", _Floating, _Hide, 1, 0, 1)] [_Button("Текст горизонтальный -2.5 мм", "images/16_txt_2.bmp", "images/16_txt_2.bmp")]^C^Ctxt_2 [_Button("Текст горизонтальный -3.5 мм", "images/16_txt_3.bmp", "images/16_txt_3.bmp")]^C^Ctxt_3 [_Button("Текст горизонтальный -5.0 мм", "images/16_txt_5.bmp", "images/16_txt_5.bmp")]^C^Ctxt_5 **myCAD [_Toolbar("MyCAD", _Floating, _Hide, 0, 0, 1)] [_Button("Масштаб", "images/16_masst.bmp", "images/16_masst.bmp")]$p0=масштаб $p0=* [_Button("Текст горизонтальный -2.5 мм", "images/16_txt_2.bmp", "images/16_txt_2.bmp")]^C^Ctxt_2 [_Button("Текст горизонтальный -3.5 мм", "images/16_txt_3.bmp", "images/16_txt_3.bmp")]^C^Ctxt_3 [_Button("Текст горизонтальный -5.0 мм", "images/16_txt_5.bmp", "images/16_txt_5.bmp")]^C^Ctxt_5 [_Button("Характеристики сечения", "images/16_id.bmp", "images/16_id.bmp")]^C^Csechen ***HELPSTRINGS

и пример одной кнопки с высотой текста 2.5

(defun C:txt_2 () (setvar "cmdecho" 0) (if (= (getvar "dimscale") 0) (setq M 1) (setq M (getvar "dimscale"))) (setq T1 (getpoint "\n Покажите начало текста: ") H (* 2.5 M)) (command "_.dtext" T1 H 0))

в тестовом стиле высота стоит 0.0
з.ы. будет ли разница для АС2010 на вин7 64
Заранее спасибо за помощь!
да и еще вопросик, после подгрузки панельки через команду menuload в командной строке сначала активируется какая то команда RIBBON выгружая свою панель, и когда нажимаю на команду к примеру текста высотой 5мм в командной строке сначала активируется команда ribbon и после пишет для текста неизвестная команда!

[alex8888]

Кулик Алексей aka kpblc, измени, пожалуйста в лиспе

(vl-load-com) (defun c:test (/ adoc selsets selsetname vla_selset dwg_file wb_file) (setq selsets (vla-get-selectionsets (setq adoc (vla-get-activedocument (vlax-get-acad-object)))) selsetname "wb" ) ;_ end of setq (if (/= (setq dwg_file (vla-get-fullname adoc)) "") (progn (vl-catch-all-apply (function (lambda () (vla-delete (vla-item selsets selsetname)) ) ;_ end of lambda ) ;_ end of function ) ;_ end of vl-catch-all-apply (setq vla_selset (vla-add selsets selsetname)) (if (and (not (vl-catch-all-error-p (vl-catch-all-apply (function (lambda () (vla-selectonscreen vla_selset) ) ;_ end of lambda ) ;_ end of function ) ;_ end of vl-catch-all-apply ) ;_ end of vl-catch-all-error-p ) ;_ end of not (> (vla-get-count vla_selset) 0) ) ;_ end of and (progn (vla-wblock (setq wb_file (strcat (vl-filename-directory dwg_file) "\\" (vl-filename-base dwg_file) "-1.dwg" ) ;_ end of strcat ) ;_ end of setq vla_selset ) ;_ end of vla-Wblock (princ (strcat "\nНабор был сохранен в файл " wb_file)) ) ;_ end of progn ) ;_ end of if (vl-catch-all-apply (function (lambda () (vla-delete (vla-item selsets selsetname)) ) ;_ end of lambda ) ;_ end of function ) ;_ end of vl-catch-all-apply ) ;_ end of progn (alert "Файл не сохранялся еще ни разу! Выполнение невозможно!") ) ;_ end of if (princ) ) ;_ end of defun

чтобы выбирались только объекты с определенного урровня (-вней) .
Никак не могу фильтр приспособить по типу ssget. Куда его засунуть? (Гусары- молчать! )

[Кулик Алексей aka kpblc]

Что значит "уровня"? Слоя?

[alex8888]

Кулик Алексей aka kpblc, прошу прощения, конечно же слоя, просто у нас он зовется уровнем.

[gomer]

Layer(англ.) - уровень (SKIIN 3.42)

[Кулик Алексей aka kpblc]

Код:

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

(vl-load-com)

(defun c:test (/ adoc selsets selsetname vla_selset dwg_file wb_file)

  (setq selsets    (vla-get-selectionsets (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
        selsetname "wb"
        ) ;_ end of setq
  (if (/= (setq dwg_file (vla-get-fullname adoc)) "")
    (progn
      (vl-catch-all-apply
        (function
          (lambda ()
            (vla-delete (vla-item selsets selsetname))
            ) ;_ end of lambda
          ) ;_ end of function
        ) ;_ end of vl-catch-all-apply
      (setq vla_selset (vla-add selsets selsetname))
      (if (and (not (vl-catch-all-error-p
                      (vl-catch-all-apply
                        (function
                          (lambda (/ group data)
                            (setq group (vlax-make-variant
                                          (vlax-safearray-fill
                                            (vlax-make-safearray
                                              vlax-vbinteger
                                              '(0 . 0)
                                              ) ;_ end of vlax-make-safearray
                                            '(8)
                                            ) ;_ end of vlax-safearray-fill
                                          ) ;_ end of vlax-make-variant
                                  data  (vlax-make-variant
                                          (vlax-safearray-fill
                                            (vlax-make-safearray
                                              vlax-vbvariant
                                              '(0 . 0)
                                              ) ;_ end of vlax-make-safearray
                                            '("ИменаСлоев,ЧерезЗапятую")
                                            ) ;_ end of vlax-safearray-fill
                                          ) ;_ end of vlax-make-variant
                                  ) ;_ end of setq
                            (vla-selectonscreen vla_selset group data)
                            ) ;_ end of lambda
                          ) ;_ end of function
                        ) ;_ end of vl-catch-all-apply
                      ) ;_ end of vl-catch-all-error-p
                    ) ;_ end of not
               (> (vla-get-count vla_selset) 0)
               ) ;_ end of and
        (progn
          (vla-wblock (setq wb_file (strcat (vl-filename-directory dwg_file)
                                            "\\"
                                            (vl-filename-base dwg_file)
                                            "-1.dwg"
                                            ) ;_ end of strcat
                            ) ;_ end of setq
                      vla_selset
                      ) ;_ end of vla-Wblock
          (princ (strcat "\nНабор был сохранен в файл " wb_file))
          ) ;_ end of progn
        ) ;_ end of if
      (vl-catch-all-apply
        (function
          (lambda ()
            (vla-delete (vla-item selsets selsetname))
            ) ;_ end of lambda
          ) ;_ end of function
        ) ;_ end of vl-catch-all-apply
      ) ;_ end of progn
    (alert "Файл не сохранялся еще ни разу! Выполнение невозможно!")
    ) ;_ end of if
  (princ)
  ) ;_ end of defun

[alex8888]

Кулик Алексей aka kpblc, спасибо

[Кулик Алексей aka kpblc]

Где и как вводить имена слоев - понятно?

[alex8888]

Кулик Алексей aka kpblc, Да, все ввел, работает, только опять нужно исправить в создании имени файла, дописать объект. Но здесь я уже научен.
А вот все эти выкрутасы с кучей vla- остаются пока темным лесом.
Хотел было просто попробовать создать прямоугольник объектным методом , да что-то не найду подходящую функцию. Попробовал vla-add-rectangle и тому подобное - кад послал на некоторое расстояние и в местоположение
Offtop: Больше не возился, пытался все твой лисп обсосать. Вот только проблема, если пробую выкинуть или упростить (ну там без проверки на ошибки) чего-нибудь для эксперимента, так обычно посылают (ошибка чего то там автоматизирования). А иногда срабатывает. Не могу понять почему.

[Кулик Алексей aka kpblc]

Объекта "прямоугольник" не существует. Используй vla-addlightweightpolyline

[alex8888]

Спасибки, попробую на досуге.

[superkot007]

Простенько и со вкусом...

Код:

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

; Расчленение мультитекста
(defun c:ExplodeMText (
                    / Collect
                      n1
                      Ename
                     )

  (setq Collect (ssget "_X" '((0 . "MTEXT"))))
  (if (/= Collect nil)
    (progn
      (setq n1 0)
      (repeat (sslength Collect)
        (setq Ename (ssname Collect n1))
        (command "_explode" Ename)
        (setq n1 (+ n1 1))
      ) ; repeat
    ) ; progn
  ) ; if
)

Начинаю учиться...

[Кулик Алексей aka kpblc]

А теперь добавь обработку: заблокированных слоев; выключенных слоев; примитивов внутри блоков. Гарантирую веселье

[superkot007]

Сообщение от Кулик Алексей aka kpblc А теперь добавь обработку: заблокированных слоев; выключенных слоев; примитивов внутри блоков. Гарантирую веселье

На выключенных слоях вроде работает, замороженных - тоже... В остальном, да - не катит...
Я же и написал, что простенько - это не комбайн. Все слои у меня всегда включены (разморожены, разблокированы), в блоках нет M-текстов... Так что меня устраивает

[ShaggyDoc]

Все слои у меня всегда включены (разморожены, разблокированы), в блоках нет M-текстов... Так что меня устраивает

"У меня всегда....", "меня устраивает..." - обычная ошибка. Относящаяся не только к конкретному случаю с расчленением М-текста.

Надо делать надежно - чтобы работало везде и всегда. С учетом всех возможных вариантов и ошибочных действий пользователя.

[Do$]

Сообщение от ShaggyDoc Надо делать надежно - чтобы работало везде и всегда. С учетом всех возможных вариантов и ошибочных действий пользователя.

Разработчику приложений - да, инженеру для своих нужд - не обязательно. Зачем же, ради единожды в год применяемого в конкретном случае кода делать все обработки ошибок, предусматривать многочисленные варианты, о которых можешь даже и не подозревать?

[gomer]

Сообщение от Do$ ради единожды в год применяемого в конкретном случае кода

вообще писать не стоит

[ShaggyDoc]

Сообщение от Do$ Разработчику приложений - да, инженеру для своих нужд - не обязательно. Зачем же, ради единожды в год применяемого в конкретном случае кода делать все обработки ошибок, предусматривать многочисленные варианты, о которых можешь даже и не подозревать?

Подавляющее большинство программ для AutoCAD на LISP написаны именно обычными инженерами и сначала для своих нужд. И поначалу безграмотно - просто негде было научиться. И "единожды применяемый код" применялся многократно. С выявлением всё новых ошибок.

А ведь их можно просто сразу не допускать. В том числе "детских" - отключение привязок, учет возможностей разной высоты текста в стилях и т.п. Тем более, что сейчас все написано и спросить есть где.

Как говорил Аркадий Райкин - "сначала ребенок пишет на заборе буквы, но потом захочет писать слова..."

[alex8888]

Кулик Алексей aka kpblc, подскажи пожалуйста как попроще методами ActiveX:
1. Открыть файл dwg (можно в фоновом режиме),
2. Сохранить его в R12_dxf под измененным именем
Заранее спасибо

[Кулик Алексей aka kpblc]

Открытие файла: vla-open
Сохранение в формате: vla-saveas. Но вот будет ли поддерживаться формат R12 - еще вопрос.

[alex8888]

Кулик Алексей aka kpblc, вот такая конструкция:

Код:

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

(setq dwg_file (vla-get-fullname active_document))
(setq filename (strcat
		 (vl-filename-directory dwg_file)
		 "\\"
		 (vl-filename-base dwg_file)
;;;		 ".dxf"
		);strcat
);setq
(vla-SaveAs active_document filename acR12_dxf)

файл создается в R12 правильно, но при этом он переписывает активный файл. Что добавить, чтобы было "за кадром" и активный документ не трогался бы?

2. Метод vla-open как написано у Полещука, фактически не работает (для Document). Это как? Что имеется ввиду?

3.

Код:

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

(setq object
       (vla-get-OpenSave 		;указатель на настройки файловых операций
	 	(vla-get-Preferences	;чтение объекта настроек
		  	(vlax-get-acad-object)	;текущий документ
		);vla-get-Preferebces
	);vla-get-openSave
);setq

(vla-get-SaveAsType object)		;чтение типа файла тек. док-та

(vla-put-SaveAsType object acR12_dxf)	;установка типа файла как R12.dxf

этот код только изменяет тип документа (R12) и не изменяет сам документ? То есть файл определяется как dxf, а внутри как и прежде dwg?

[Кулик Алексей aka kpblc]

Попробуй так:

Код:

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

(vl-load-com)

(defun test (/ filename doc)
  (setq filename "d:\\1\\dwg_01.dwg"
        doc      (vla-add (vla-get-documents (vlax-get-acad-object)) filename)
        ) ;_ end of setq
  (vla-saveas doc
              (strcat (vl-filename-directory filename) "\\" (vl-filename-base filename) "R12")
              acr12_dxf
              ) ;_ end of vla-SaveAs
  (vla-close doc)
  ) ;_ end of defun

Вроде бы должно работать.

[alex8888]

Кулик Алексей aka kpblc, почему, функции с именем test упорно не хотят работать?
Только если ее переименовать в другую, отличную от test

[Кулик Алексей aka kpblc]

Значит, что-то еще подгружается и определяет функцию (test). Мне как-то не видать отседова

[alex8888]

Кулик Алексей aka kpblc, проверь, пожалуйста, что то не пашет

Код:

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

(vl-load-com)

(begin_activeX)

(defun at_save_dwg-dxf (/ filename active_document)

  
  (setq	filename
		 (strcat
		   (getvar "dwgprefix")
		   (getvar "dwgname")
		 )			;strcat
 
  ) ;_ end of setq

  (vla-saveas
    active_document
    (strcat (vl-filename-directory filename)
	    "\\"
	    (vl-filename-base filename)
	    );strcat
    acr12_dxf
  ) ;_ end of vla-SaveAs
;;;  (vla-close doc)
) ;_ end of defun

Ошибка: Fehlerhafter Argumenttyp: VLA-OBJECT nil

Вложенная функция:

Код:

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

(defun begin_activex (/)
  
  (vl-load-com)				;Çàãðóçêà ðàñøèðåííèé VLisp
  
  (setq acad_application (vlax-get-acad-object))
  					;äîê-ò Àâòîêàäà
  (setq active_document (vla-get-ActiveDocument acad_application))
					;àêòèâíûé äîê-ò Àâòîêàäà
  (setq model_space (vla-get-modelspace active_document))
					;ïð-âî ìîäåëè àêòèâíîãî äîê-òà
  (setq paper_space (vla-get-paperspace active_document))
					;ïð-âî ëèñòà àêòèâíîãî äîê-òà

)					;defun

[Кулик Алексей aka kpblc]

А на момент вызова vla-saveas разве переменная active_document инициализирована? Тут "запутка" в локальных и глобальных переменных.

[alex8888]

active_document берется из begin_activex, которая грузится раньше в этом же лиспе. И она не локальна. Не так?

А вот так?

Код:

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

(vl-load-com)

(begin_activeX)

(defun at_save_dwg-dxf (/ filename doc)
  
  (setq	filename
		 (strcat
		   (getvar "dwgprefix")
		   (getvar "dwgname")
		 )			;strcat
  doc (vla-add active_document filename)
  ) ;_ end of setq

  (vla-saveas
    doc
    (strcat (vl-filename-directory filename)
	    "\\"
	    (vl-filename-base filename)
	    );strcat
    acr12_dxf
  ) ;_ end of vla-SaveAs
;;;  (vla-close doc)
) ;_ end of defun

Правда, выдает: Fehler: ActiveX-Server gab folgenden Fehler zuruck: unbekannter Name: Add - типа неизвестное имя Add

А самое интересное, что в этом случае сработало:

Код:

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

(vl-load-com)

;;;(begin_activeX)

(defun at_save_dwg-dxf (/ filename doc)
  
  (setq	filename
		 (strcat
		   (getvar "dwgprefix")
		   (getvar "dwgname")
		 )			;strcat
  doc (vla-add (vla-get-documents (vlax-get-acad-object)) filename)
  ) ;_ end of setq

  (vla-saveas
    doc
    (strcat (vl-filename-directory filename)
	    "\\"
	    (vl-filename-base filename)
	    );strcat
    acr12_dxf
  ) ;_ end of vla-SaveAs
;;;  (vla-close doc)
) ;_ end of defun

Совсем замучаю
Нашел: вместо vla-get-documents было vla-get-ActiveDocument
Да уж

[Кулик Алексей aka kpblc]

В качестве иллюстрации к #916:

Код:

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

(defun fun1 ()
  (setq value "1234")
  ) ;_ end of defun

(defun fun2 (/ value)
  (vl-princ-to-string value)
  ) ;_ end of defun

И вызов:

Код:

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

_$ (fun2)
"nil"

Область видимости однако...

[alex8888]

Получается, что переменная value теряет свое значение?

[Кулик Алексей aka kpblc]

Почему? После вызова (fun2) проверь значение value. Просто она внутри функции fun2 "перекрывается" локальной переменной. Это же базовые понятия - область видимости функций и переменных! Как делается локальный обработчик ошибок в лиспе? Да точно по такому же принципу.

[alex8888]

Ну и непутевый же этот Лисп, совсем не понимает, что я от него хочу

Кулик Алексей aka kpblc, совсем за-пу-та-л
Пойду еще раз почитаю "базовые понятия" - видать плохо усвоил.

[Кулик Алексей aka kpblc]

Ну, к примеру: http://www.sernam.ru/c_24.php и http://msdn.microsoft.com/ru-ru/library/1t0wsc67.aspx

[saa]

Вопрос знатокам VisualLisp по поводу команды begin_activex из поста #918.

Как правильнее: получать указатели на объекты (приложения, документа, пространств листа и модели) в каждом случае или хранить их в глобальных переменных?

И второй вопрос по поводу загрузки lisp-функций. Насколько я понимаю основных вариантов два: загружать нужные файлы лисп непосредственно перед выполнением функции и загружать весь набор файлов с функциями при загрузке чертежа *.dwg.
Кто как делает и почему?

[Кулик Алексей aka kpblc]

Тут ответ (по идее) не завязан на какой-то язык...
Указатели на документ, пространство модели, а также коллекции (например, коллекция слоев, или коллекция блоков), я думаю, лучше всего делать глобальными. Инициализировать при самом начале работы.
По загрузке (если рассматривать некомпилированные коды) я вижу несколько вариантов:
1. Хранить все коды по принципу "один файл lsp = одно определение функции".
2. Все коды засовывать в один lsp-файл, который и подгружать
3. Каждый раз по новой прописывать определение нужных функций.
У каждого из подходов есть свои плюсы и свои минусы...

[saa]

Алексей, дилетантский вопрос: если в начале работы получить указатели на коллекции слоев, блоков, пространства модели, то будут ли они корректно восприниматься при добавлении новых слоев и т.д. или нужно будет заново их определять?
По поводу загрузки: прочитал твое эссе и не знаю, то ли оставить загрузку lisp-функций как она есть у меня сейчас (т.е. в каждом файле одна функция, при загрузке чертежа загружается функция, которая определяет все файлы с расширением lsp в указанном каталоге загружает их все подряд) или строить более сложную конструкцию на основе твоих функций. На данный момент все работает с моим топорным подходом, хотя там есть вложенные функции (например обработчик ошибок из "САПР на базе AutoCAD...", а там два или три уровня вложенности)

[Кулик Алексей aka kpblc]

Сообщение от saa если в начале работы получить указатели на коллекции слоев, блоков, пространства модели, то будут ли они корректно восприниматься при добавлении новых слоев и т.д. или нужно будет заново их определять?

Ну так давай проверим
Создаем новый файл, в нем сразу (vl-load-com) и следом:

Код:

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

_$ (setq layers (vla-get-layers (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object)))))
#<VLA-OBJECT IAcadLayers 00000000269d42a8>

На всякий случай:

Код:

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

_$ (vla-get-count layers)
1

Добавим несколько слоев, используя обычный _.layer и проверяем:

Код:

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

_$ (equal layers (vla-get-layers adoc))
T
_$ (vla-get-count layers)
5

Т.е. указатель на коллекцию не меняется.
Теперь насчет загрузки. Если (подчеркиваю - если!) у тебя AutoCAD до 2006 включительно (на 2007 не проверял); если у тебя в каждом lsp-файле только одна функция, которая не обращается к другим; или у тебя каждый lsp вручную засунут в автозагрузку,- то все, что я писал, становится неактуальным. Если же хотя бы одно из условий не соблюдается, то приходится изворачиваться.
P.S. Что такое "вложенность" функций в твоем понимании? В моей интертрепации интерпретации - это определения локальных функций внутри основного кода. А у тебя?

[saa]

AutoCAD 2009.

В каждом файле одна функция.

Загрузка организована посредством такой функции

Код:

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

;|
Функция поиска файла или файлов в указанной папке и всех вложенных папках
файл задается именем или маской
Аргументы:
P - начальный путь поиска,
например "C:" или "C:\\Program Files"
F - название файла,
возможно использование подстановочных символов.
например
"*.dwg" - найдет все dwg-файлы
или "acad*.lsp"
Вызывать
(getfile "acad*.lsp" "C:\\Program Files")
Возвращает список файлов с полным путем до них и названием без маски.
'("C:\\Program Files\\AutoCAD 2004\\Express\\acadinfo.lsp"
    "C:\\Program Files\\AutoCAD 2004\\Support\\acad2004.lsp"
    "C:\\Program Files\\AutoCAD 2004\\Support\\acad2004doc.lsp"
    "C:\\Program Files\\AutoCAD 2004\\Support\\acadinfo.lsp"
  )
|;
(defun GetFile (f p)
;; By ElpanovEvgeniy
;; (getfile "acad*.lsp" "C:\\Program Files")
(apply (function append)
        (cons (if (vl-directory-files p f)
               (mapcar (function (lambda (x) (strcat p "\\" x))) (vl-directory-files p f))
              ) ;_ if
              (mapcar (function (lambda (x) (GetFile f (strcat p "\\" x))))
                      (vl-remove ".." (vl-remove "." (vl-directory-files p nil -1)))
              ) ;_ mapcar
        ) ;_ cons
) ;_ apply
)

С ее помощью получаем список с именами файлов. Далее добавляем такую функцию

Код:

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

(defun START (file_name folder / file_list)
  (setq file_list (GetFile file_name folder))
  (if (foreach file file_list
        (load file (strcat "\nФайл " file " не найден"))
      ) ;_ end of foreach
    (princ (strcat "\nБиблиотека " folder " загружена"))
  ) ;_ end of if
) ;_ end of defun

(START "*.lsp" "Z:\\Настройки\\LISP\\Sourse")

Про вложенность наверно я не так выразился. Я имел ввиду, что в какой-либо функции используется другая функция, определенная в другом файле.

[Кулик Алексей aka kpblc]

Наверное, дело в том, что у меня используется около 700 функций, при этом глубина "вложенности" запросто может превысить 10 уровней. К примеру:
Функция _kpblc-ent-create-scheduletable вызывает около 200 служебных функций. Есть там одна _kpblc-xml-nodes-get-child-by-tag - вызывает _kpblc-conv-value-to-string, _kpblc-property-get и _kpblc-xml-nodes-get-child. Последняя обращается к _kpblc-xml-conv-nodes-to-list. Эта, в свою очередь,- к _kpblc-error-catch, _kpblc-property-get, _kpblc-error-print. При этом для того, чтобы вызвать эту функцию (точнее, передать корректные параметры), приходится еще десяток функций вызывать с такими же "хвостами". В таких случаях мне приходится отслеживать приоритет загрузки функций, чтобы потом при вызове _kpblc-ent-create-scheduletable не получить сообщение вида "_kpblc-xml-conv-nodes-to-list не определена".

[saa]

Если не секрет, что делает _kpblc-ent-create-scheduletable?

В целом ясно. Пока проблем с загрузкой не возникает оставлю все как есть.
И с функциями для работы с объектной моделью не буду велосипед изобретать, а возьму из ruCAD.

Спасибо за разъяснения.

[ShaggyDoc]

а возьму из ruCAD

В ruCAD сделано так:

1. Исходные библиотечные функции находятся в отдельных LSP-файлах. Иногда в одном файле несколько родственных, хотя это отступление от концепции из-за лени автора. Всего таких функций около 2000. Все они записаны в файл проекта.

2. Из них компилируется один FAS. Размер примерно 600 кб. Этот файл автоматически загружается в каждый чертеж. Все библиотечные функции всегда доступны. Они обращаются друг друг к другу, но проблем не возникает, так как они всегда загружены в память одновременно.

3. Прикладные "программы" находятся в отдельных LSP и компилируются в отдельные FAS. Они используют только библиотечные функции и, иногда, какие-то функции, определенные в этом же файле. Но никогда из каких-то других.

4. Вызов "программ" осуществляется из меню AutoCAD, XML, с кнопок и т.п. При этом всегда в макрос вызова включается загрузка соответствующего FAS, или макрос вызывает библиотечную функцию.

[saa]

ShaggyDoc, такой вопрос: компиляция функций происходит непосредственно перед загрузкой в файл чертежа или отдельно (т.е. все написали, собрали в один проект, скомпилировали и пользуемся, а если нужно что-то изменить, то компилировать заново).

У меня то тоже вроде все сразу загружается (хотя может я что-то не так понимаю), но Алексей говорит, что критичен порядок загрузки и сложность в этом.

И еще: есть вот такой файл

Код:

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

(setq *ru_acad-object* nil)
(defun ru-obj-get-acad-object ()
  (cond	(*ru_acad-object*)
	(t
	 (setq *ru_acad-object*
		(vlax-get-acad-object)
	 ) ;_ end of setq
	)
  ) ;_ end of cond
) ;_ end of defun

Поясните пожалуйста зачем нужна строка

Код:

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

(setq *ru_acad-object* nil)

и в каких случаях может понадобиться уничтожение глобальной переменной *ru_acad-object*?

[ShaggyDoc]

компиляция функций происходит непосредственно перед загрузкой в файл чертежа или отдельно (т.е. все написали, собрали в один проект, скомпилировали и пользуемся, а если нужно что-то изменить, то компилировать заново)

Библиотека функций компилируется разом из проекта, после изменения каких-то функций. В период разработки - часто, хотя во время непосредственной работы функции просто загружаю из VL. А потом уже компилирую. Но последний раз компилировал год назад.

Алексей говорит, что критичен порядок загрузки и сложность в этом

Порядок загрузки важен в том случае, если вызовы функций выполняются вне самих функций. А если в библиотеке только определения, функции загрузятся в том порядке, как записаны в PRJ-файле. У меня - в алфавитном, просто для удобства ориентирования в тексте проекта.

(setq *ru_acad-object* nil) - это как раз вызов функции вне тела. Сделал такой вызов для сброса указателя на объект во время процесса загрузки библиотеки. Затем, во время выполнения функции ru-obj-get-acad-object этот указатель восстановится.

Такое "обниление" можно и не выполнять. Но тогда в памяти остаётся глобальная переменная, инициализированная при предыдущей загрузке библиотеки. Мало ли что я мог сделать потом - например присвоить глобальной *ru_acad-object* указатель на что-то другое, хотя бы ошибочно. Вот и страхуюсь. Чтобы после перегрузки указатель был правильный.

[saa]

Для особо непонятливых (для меня то бишь): если мы загружаем файл А с определением функции 1 (в которой содержится обращение к фун.2) и вызовом фун.1 до загрузки файла В с определением функции 2, то будут проблемы, а если в файле А нет вызова функции 1, только ее определение, то загружать файлы А и В можно в любом порядке, лишь бы загрузить оба. Правильно я понимаю?

[ShaggyDoc]

Сообщение от saa Для особо непонятливых (для меня то бишь): если мы загружаем файл А с определением функции 1 (в которой содержится обращение к фун.2) и вызовом фун.1 до загрузки файла В с определением функции 2, то будут проблемы, а если в файле А нет вызова функции 1, только ее определение, то загружать файлы А и В можно в любом порядке, лишь бы загрузить оба. Правильно я понимаю?

Вот даже с таким простым случаем особо непонятливым (то бишь мне) в понедельник с утреца трудно сообразить, чего хочется. А если функций будет хотя бы десяток, да с вложенными вызовами? Поэтому надо делать просто и надежно:

1. Отделять загрузку от использования. То есть формировать библиотеку функций. В файлах библиотечных функций не должно быть никаких вызовов других функций. Кроме "штатных", например setq. В этом случае загрузка может выполняться в любом порядке, но до использования.

Не забываем, что функции могут перегружаться, заменяя прежнее определение. Если при загрузке сразу что-то используется могут быть обращения к старой версии. Такие ошибки трудно найти.

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

3. Загрузку библиотеки надо делать автоматически, например в acaddoc.lsp. Вот пример такого файла из ruCAD - он сгенерирован программой-стартером из шаблона, в момент загрузки выглядит так (дополнил комментариями):

Код:

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

;;Загружаем COM - единственный раз
(vl-load-com)
;; Штатной функцией присваиваем значения глобальным переменным
;; которые постоянно используются
;; Здесь именно глобальные, так как ещё не загруженная библиотека 
;; не знает расположения файлов, но зато это известно стартеру,
;; который и сгенерировал acaddoc.lsp
(setq 
 *ru_root_dir* "c:\\ruCAD\\Install\\PF\\ru\\CAD-2008\\"
 *ru_acad_version* "17"
 *ru_acad_version_r* "R17.1"
 *ru_acad_menu* "ruCAD"
 *ru_profile_name* "ruCAD"
 *ru_common_dir*  "c:\\ruCAD\\Install\\LocalAppData\\ru\\CAD-2008\\"
 *ru_app_data_dir*  "c:\\ruCAD\\Install\\LocalAppData\\ru\\CAD-2008\\AppData\\"
 *ru_help_dir*  "c:\\ruCAD\\Install\\PF\\ru\\CAD-2008\\Help\\"

 *ru_archives_dir*  "c:\\ruCAD\\Install\\LocalAppData\\ru\\CAD-2008\\Archives\\"
 *ru_docs_dir*  "c:\\ruCAD\\Install\\LocalAppData\\ru\\CAD-2008\\Docs\\"
 *ru_layers_dir*  "c:\\ruCAD\\Install\\LocalAppData\\ru\\CAD-2008\\Layers\\Слои\\"
 *ru_libs_dir*  "c:\\ruCAD\\Install\\LocalAppData\\ru\\CAD-2008\\Libs\\"
 *ru_add_dir*  "c:\\ruCAD\\Install\\LocalAppData\\ru\\CAD-2008\\Add\\"
 *ru_xml_menu_dir*  "c:\\ruCAD\\Install\\LocalAppData\\ru\\CAD-2008\\XML\\Menu\\"
 *ru_xml_images_dir*  "c:\\ruCAD\\Install\\LocalAppData\\ru\\CAD-2008\\XML\\Images\\"
 *ru_topo_dir*  "c:\\ruCAD\\Install\\LocalAppData\\ru\\CAD-2008\\Archives\\Topo\\"

 *ru_main_ini*  "c:\\ruCAD\\Install\\PF\\ru\\CAD-2008\\Bin\\rucad.ini"
 *is_win_nt*  NIL
 *ru_user_login* "AdminRU"
 *ru_user_title* "Уважаемый"
 *ru_user_long_name* "пользователь ruCAD"
 *ru_user_department* "ruCAD Community"
 *ru_user_work_dir* "C:\\ruCAD"
 *ru_user_workspace* "ru-Профи"
 )
;; Загружается главная библиотека функций
 (if (equal (load (strcat *ru_common_dir* "Libs\\App\\common\\ru-lib-main.fas") "Failed") "Failed")
;; Если по каким-то причинам не загружена, сообщаем штатной функцией
	(alert "Не загружена библиотека ruCAD. Работа в ruCAD невозможна.") 
;; если загружена, проверяется допустимость версии Автокад (не ниже 2008)
;; Далее уже могут использоваться только что назначенные глобальные переменные
;; Здесь уже используются функции из загруженной библиотеки
	(if (ru-acad-2008-test)
		(progn
;; Загружаются дополнительные библиотеки
			(ru-express-load)
			(ru-app-load-3d-lib)
;; Инициализируется система - тут могут быть любые вызовы функций.
			(ru-init-start-rucad)
		)	
	)	
 )
(princ)

Вот теперь могут в любом порядке загружаться и выполняться любые LISP, использующие библиотечные функции.

[saa]

ShaggyDoc, спасибо, теперь разобрался и уяснил.

[alex8888]

Кулик Алексей aka kpblc, с помощью vla-wblock можно также изменить тип записываемого файла (например, Dxf) , или он будет всегда Dwg текущей настройки?
2. Код:

Код:

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

(defun at_save_dwg-dxf (/ filename doc)

;;;  (vla-open (vla-get-Documents (vlax-get-acad-object)) "-filename-")

  (setq	filename
	 (strcat
	   (getvar "dwgprefix")
	   (getvar "dwgname")
	 )				;strcat

;;;	doc	 (vla-add
;;;		   (vla-get-documents
;;;		     (vlax-get-acad-object)
;;;		   )				;vla-get-documents
;;;		   filename
;;;		 )				;vla-add documents
  ) ;_ end of setq

  (vla-saveas
    (vla-get-documents
      (vlax-get-acad-object)
    )					;vla-get-documents
;;;    doc
    filename
;;;    	(strcat
;;;	  (vl-filename-directory filename)
;;;	  "\\"
;;;	  (vl-filename-base filename)
;;;    	)					;strcat
    acr12_dxf				;als R12.dxf
  ) ;_ end of vla-SaveAs

;;;  (vla-close doc)

) ;_ end of defun

сохраняет пустой файл как dxf R12 (то есть создает новый чертеж и ищменяет его тип) . Где изменить, чтобы сохранялся готовый чертеж под другим типом? Копаю в сторону vla-open, но тут загвоздка (для меня ) - наверное, надо как-то активизировать текущим этот файл?

[Кулик Алексей aka kpblc]

alex8888, я несколько раз перечитал вопрос, но так и не понял - ты про что спрашиваешь? Про vla-wblock или про vla-saveas?

[alex8888]

Кулик Алексей aka kpblc,
прошу прощения за туманность.
Ищу способ сохранить выбранные примитивы в файле Dwg и сохранить из в виде Dxf, причем самой ранней версии. Встал вопрос - или vla-wblock или vla-saveas. Первым пока не понял - возможно ли в принципе? А второй правильно создает файл, но тот почему то пустой, то есть я ничего не сохраняю кроме как просто пустой файл с нужным его типом.

Offtop: Предыстория такая. Фирма, в которой мне доводится батрачить по устоявшимся здесь традициям делает все через "мягкое место". Пытаюсь немного привести все в порядок и оптимизировать. Одной из моих задач является подготовка разверток деталей из листового металла для нарезки лазером. Как идет сам процесс: все развертки скидываются в кучу (хорошо еще что сортируясь по толщине материала), затем я их компоную по формату листа, чтобы был как можно лучший коэффициент расхода материала. После этого идет зоопарк Сначала выбранные примитивы на выбранных слоях сохраняются в файле *-1.dwg (это уже ты проходил, когда мне программу для записи файла давал), потом этот файл переводится в dxf самой ранней версии, потом ее читает лазерный станок, ну и вообщем все. Хочу избавиться от промжуточного шага с лишними файлами *-1.dwg
Но желательно бы до этого доковылять своими мозгами , правда без подсказок не получается, вот и третирую по сотни раз одно и тоже.

[Кулик Алексей aka kpblc]

vla-wblock сохраняет файл только в текущей версии. Не лечится.
vla-saveas по идее позволяет сохранить файл в формате R12. Что бы попытался сделать я: выбрать примитивы в текущем документе; создать новый документ (скорее всего, добавлением в коллекцию документов; ObjectDBX тут поможет как мертвому припарки) и через vla-CopyObjects выполняется копирование в сторонний файл. Потом этот файл и попытаться сохранить.
P.S. Хотя я бы на твоем месте серьезно задумался о том, чтобы делать полноценную программную реализацию алгоритма оптимизации кроя листовых материалов, потом изучение DXF R12 и прямая запись нужных данных в файл. Голову, конечно, сломаешь (и не раз).

[alex8888]

Кулик Алексей aka kpblc,

Хотя я бы на твоем месте серьезно задумался о том, чтобы делать полноценную программную реализацию алгоритма оптимизации кроя листовых материалов, потом изучение DXF R12 и прямая запись нужных данных в файл. Голову, конечно, сломаешь (и не раз).

Могу ответить только словами Софико Чиаурелли (кажется так) из фильма "Ищите женщину" :"Лили, ты сейчас сказал что то такое сложное - я не поняла".
Так вот не совсем въезжаю что ты имеешь ввиду.
Мой алгоритм такой:
1. Составление разверток компонентов изделия.
2. Поиск подходящего по формату листового материала.
3. Оптимальное размещение по листу разверток деталей.
4. Подготовка и печать сопроводительной документации.
5. Подготовка и пересылка DXF файла фирме, осуществляющей нарезку лазером.

по 1 пункту имею как собственные наработки, так и сторонние программы.
по 2-му все ясно, там кад почти не требуется, но программу составления формата листа я накатал - худо-бедно- работает.
по 3-му - чисто художественное соображение - интуиция, расчет и тп. Так как все развертки индивидуальны и единичны в большинстве своем, то программным путем решить для меня пока не представляется вообразимым.
Далее п.4 и 5. Здесь мне нужно как раз то о чем весь сыр-бор. Из вышеизложенного тобой делаю заключение, что без промежуточного файла не обойтись. Получается по-старому: файл *.dwg -> файл *-1.dwg (с выбранными примитивами и сопроводительным текстом к ним - только самое необходимое) с помощью vla-wblock -> файл DXF R12 для отправки. Здесь, наверное файл *-1.dwg надо преобразовывать в тип DXF R12 с помощью vla-open -> vla-SaveAs, но пока не получилось. Попытки преобразования описаны в посте 937.
Если есть какие соображения - буду очень признателен

[ShaggyDoc]

5. Подготовка и пересылка DXF файла фирме, осуществляющей нарезку лазером

По этому пункту проще записать непосредственно DXF как текстовый файл из LISP, а не мучиться с отбором, преобразованиями и прочим. Вклчая сопроводительный текст. "Подумаешь, бином Ньютона"(С)

[alex8888]

ShaggyDoc, ты "ето" к чему?
Таков существующий расклад, ты просто не представляешь, насколько немцы любят все усложнять
Что же по существу, то я тоже не представляю пока твою мысль

записать непосредственно DXF как текстовый файл из LISP

Прошу пояснить как?

[ShaggyDoc]

Прошу пояснить как?

Дык элементарно
Например, такой функцией

(defun ru-list-write-to-file (filename stringlist / f result) (if (setq f (open filename "w")) (progn (foreach x stringlist (princ (strcat x "\n") f) ) ;_ end of foreach (close f) (setq result filename) ) ;_ end of progn (princ (strcat "\nНе могу создать файл \n" filename)) ) ;_ end of if result )

А предварительно создать список строк stringlist, в котором будет находиться, что именно писать. Лиспом его и сформировать. Лисп работает внутри AutoCAD, AutoCAD знает, что внутри него нарисовано, Лисп знает, как получить DXF-коды и их значения. Остается найти программиста, который отдаст соответсвующие команды. Путем написания текста функции, формирующей список строк. Можно и сопроводительный текст. Даже на немецком языке.

[alex8888]

Технически записать в файл строку за строкой понятно как, а вот:

А предварительно создать список строк stringlist, в котором будет находиться, что именно писать.

как узнать, что же мне именно писать Вручную все задолбаешься прописывать.
В качестве примера подброшу какой-нибудь из dxf и на нем посмотреть механизм обработки хотя бы приближенно?
Во вложении все 3 файла - основной для разработки, промежуточный для перезаписи в dxf и сам dxf.

[Дмитрий_Leo]

Добрый день. Столкнулся с проблемой и уже длительное время не могу ее решить. Суть в том что написал програмку на lisp. Алгоритм программы построен на функции "grread" (было необходимо отслеживание координат курсора "в реальном времени" плюс возврат ключей в зависимости от нажатой кнопки на клавиатуре и мыши). И программа работает, но только при открытом Visual Lisp Editor. Если Visual Lisp Editor не открыт, то grread не отслеживает нажатие кнопок на клавиатуре и мыши (хотя координаты возвращает). Кто-нибудь сталкивался с подобной ситуацией?

[alex8888]

Кулик Алексей aka kpblc,помучаю дальше
Изменил твою программу записи блока в файл в надежде решить свою задачу "тупым" методом, т.е. как вручную, без намеков уважаемого ShaggyDoc, потому как пока не представляю способа решения по его совету.

Код:

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

(vl-load-com)

(defun kbplc_save_new_dxf
       
       (/ adoc selsets selsetname vla_selset dwg_file wb_file wb-file1)	;перечень локальных переменных

(begin_activex)							;функция получения ссылки на активный документ (текущий чертеж)
  
  (setq
    	selsets	   (vla-get-selectionsets active_document)	;создание пустой выборки в текущем документе
	selsetname "wb"						;присвоение имени выборке
  ) ;_ end of setq

  (if (/=
	(setq dwg_file (vla-get-fullname active_document))	;Получение пути и имени файла и сохранение его в dwg_file
	""							;имя файла пустое
      )								;Если имя файла есть

    (progn							;выполнение если
      (vl-catch-all-apply					;защита от ошибки
	(function
	  (lambda ()
	    (vla-delete (vla-item selsets selsetname))		;очистка выборки (от хвостов и мусора)
	  ) ;_ end of lambda
	) ;_ end of function
      ) ;_ end of vl-catch-all-apply

      (setq vla_selset (vla-add selsets selsetname))		;создание пустого выбора

      (if (and (not (vl-catch-all-error-p			;если не было ошибки и см. vla-get-count
		      (vl-catch-all-apply
			(function				;создание бм - безопасных массивов
			  (lambda (/ group data) 		;Выборка по условию
			    (setq group	(vlax-make-variant	;создание варианта
					  (vlax-safearray-fill	;заполнение бм
					    (vlax-make-safearray;создание бм
					      vlax-vbinteger	;тип данных бм - целые числа
					      '(0 . 0)		;размерность массива (не определенный)
					    ) ;_ end of vlax-make-safearray
					    '(8)		;заполнение бм (8- dxf код слоя (Layer))
					  ) ;_ end of vlax-safearray-fill
					) ;_ end of vlax-make-variant
				  data	(vlax-make-variant	;создание варианта
					  (vlax-safearray-fill	;заполнение бм
					    (vlax-make-safearray;созлание бм
					      vlax-vbvariant	;тип данных бм - неопределенные значения
					      '(0 . 0)		;размерность массива (не определенный)	
					    ) ;_ end of vlax-make-safearray
					    '("0,SF-TEXT,LASER-TEXT");заполнение бм (перечисление названий уровней(слоев))
								;'("ИменаСлоев,ЧерезЗапятую")
					  ) ;_ end of vlax-safearray-fill
					) ;_ end of vlax-make-variant
			    ) ;_ end of setq
			    (vla-selectonscreen			;интерактивный выбор графических объектов (без group и data выберет всё)
			      vla_selset 			;объект документа
			      group				;бм цел.чисел в виде варианта (фильтр по типу)
			      data				;бм с данными типа "вариант" (данные фильтра)
			    ) ;_end of vla-selectOnScreen		
			  ) ;_ end of lambda
			) ;_ end of function
		      ) ;_ end of vl-catch-all-apply
		    ) ;_ end of vl-catch-all-error-p
	       ) ;_ end of not
	       (> (vla-get-count vla_selset) 0)			;число выбранных объектов не равно 0 (что то выбрано)
	  ) ;_ end of and

	(progn
	  (setq wb_file (strcat				;куда пишем -> создание имени файла:
			    (vl-filename-directory dwg_file)	;путь текущего файла без "\" на конце
			    "\\"				;вставка "\" в конец пути тек.файла
			    (vl-filename-base dwg_file)		;имя текущего файла без расширения
			  ) ;_ end of strcat
	    ) ;_ end of setq
	  (vla-wblock						;Запись в файл:
	    active_document					;что берем за основу -> текуший документ
	    (setq wb_file1 (strcat				;куда пишем -> создание имени файла:
			    (vl-filename-directory dwg_file)	;путь текущего файла без "\" на конце
			    "\\"				;вставка "\" в конец пути тек.файла
			    (vl-filename-base dwg_file)		;имя текущего файла без расширения
			    "-1.dwg"				;добавка окончания "-1" к имени файла
			  ) ;_ end of strcat
	    ) ;_ end of setq
	    vla_selset						;что будем записывать -> выборку
	  ) ;_ end of vla-Wblock
	  


	  (princ (strcat "\nНабор был сохранен в файл " wb_file1));Отметка о выполнении

	  
		(at_save_dwg-dxf)
	  (princ "\nСоздание dxf завершено")
	) ;_ end of progn
      ) ;_ end of if
      
      (vl-catch-all-apply					;защита от ошибки
	(function
	  (lambda ()
	    (vla-delete (vla-item selsets selsetname))		;очистка выборки
	  ) ;_ end of lambda
	) ;_ end of function
      ) ;_ end of vl-catch-all-apply
    ) ;_ end of progn
    
    (alert							;выполнение иначе
     "Файл не сохранялся еще ни разу! Выполнение невозможно!")	;Действие, если еще не было сохранение файла изначально
) ;_ end of if

  (princ)							;очистка строки статуса от отчета о выполнении функции (nil)
  
) ;_ end of defun

Изменения выделены красным.
Но вызываемая программа at_save_dwg-dxf

Код:

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

(defun at_save_dwg-dxf (wb_file / doc)

  (vla-open
    (setq doc
	   (vla-get-Documents (vlax-get-acad-object)))
    wb_file)

(vla-saveas
  	(vla-get-documents (vlax-get-acad-object))	;vla-get-documents
  	wb_file						;filename
  	acr12_dxf					;als R12.dxf
) ;_ end of vla-SaveAs

  (vla-close doc)

) ;_ end of defun

вощвращает :
ActiveX-Server gab folgenden Fehler zuruck: unbekannter Name: SaveAs
то есть неизвестное имя SaveAs
Что и где я накосячил

Код не оптимизирован (пока он еще не работоспособный), отлова ошибок тоже еще не вставлял

[Кулик Алексей aka kpblc]

Код:

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

(vla-saveas
  (vla-item (vla-get-documents (vlax-get-acad-object)) "DWGName")
  "FileNameToSave"
  acr12_dxf
  ) ;_ end of vla-saveas

[alex8888]

Кулик Алексей aka kpblc,
здесь "DWGName" - какое имя (чего)? Или так и оставить?
А "FileNameToSave" что?
Имя сохраняемого документа у меня в переменной wb_file. Куда его подставить и нужны ли кавычки?

[Кулик Алексей aka kpblc]

Первый аргумент - vla-указатель на открытый документ.
Второй аргумент - имя файла, под которым надо выполнять сохранения
Третий - формат сохранения.

[alex8888]

vla-указатель на открытый документ - это (vla-get-documents (vlax-get-acad-object)),
а (vla-item (vla-get-documents (vlax-get-acad-object)) "DWGName") - это получение свойства у открытого документа, в частности имя? Или нет?
Со вторым и третьим аргументом вроде бы ясно. Но вот первый вызывает сомнение и не только у меня - кад пишет ошибку автоматизации именно на этом месте.
Вот здесь:

Код:

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

(vla-open
      (vla-get-Documents (vlax-get-acad-object))
    wb_file1)
  
(vla-saveas
  (vla-item (vla-get-documents (vlax-get-acad-object)) "DWGName")
  wb_file
  acr12_dxf
  ) ;_ end of vla-saveas


  (vla-close wb_file)

сохраненный файл открывается и потом ничего не происходит. Надо наверное переключится в него, чтобы был активным, чтобы его потом записать в dxf? Иначе ошибка

[Кулик Алексей aka kpblc]

(vla-get-documents (vlax-get-acad-object)) - это коллекция (или массив) открытых документов AutoCAD. Через vla-item ты получаешь указатель на конкретный элемент этой коллекции / массива. Ты же оперируешь с каким-то конкретным документом, верно?

[alex8888]

То есть это не один документ, а несколько? А я то думал, что тот, с которым оперируем в данный момент, но не активным.
А почему тогда вылетает в ошибку? Чем же каду не нравится "DWGName"?
Через (vlax-dump-object (vla-get-documents (vlax-get-acad-object)) T) увидел, что

Код:

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

; IAcadDocuments: Die Gruppierung aller in der aktuellen Sitzung geoffneten AutoCAD-Zeichnungen
; Eigenschaftswerte:
;   Application (RO) = #<VLA-OBJECT IAcadApplication 0000000140a62e28>
;   Count (RO) = 1
; Unterstutzte Methoden:
;   Add (1)
;   Close ()
;   Item (1)
;   Open (3)

Item присутствует в списке. Можно как-то посмотреть, где отображается то, что называется "DWGName"?

Как получить указатель на открываемый объект (файл) в этой коллекции документов? Мне нужно знать имя открываемого файла (теоретически то верно). Только чей-то недоеду никак

[Кулик Алексей aka kpblc]

DWGNAme - ну я так обозвал имя файла, который ты собираешься сохранять под другим именем и в другом формате.

[alex8888]

В моем случае это wb_file?
Так а кавычки нужны, если это переменная, в которой лежит имя файла?

[Кулик Алексей aka kpblc]

Сообщение от alex8888 В моем случае это wb_file?

Да

Сообщение от alex8888 Так а кавычки нужны, если это переменная, в которой лежит имя файла?

А сам как думаешь?

[alex8888]

Думаю что не надо и получаю в ответ многозначащее:
Automatisierungsfehler. Keine Beschreibung verfugbar.
(ошибка автоматизации. описание отсутствует)

Как понять где?
Затыка как писал выше в: (vla-item (vla-get-documents (vlax-get-acad-object)) wb_file1)
Уже методом "тыка" все пререпробывал - не пускает дальше этой строки и все тут.

[Кулик Алексей aka kpblc]

wb_file1 на момент вызова чему равна? А файл с таким именем открыт?

[alex8888]

1. На момент открытия wb_file1 равна названию файла, полученному при сохранении выборки примитивов с помощью vla-wblock. Проверил в окне наблюдения - там правильно.
2. Файл открывается в фоне, затем затыкается выполнение программы в этом месте и соответственно файл обратно не закрывается.

Посмотри, может у тебя возникнет получше идея как из одного файла dwg получить dxf с выбранными элементами минуя промежуточный файл-1dwg. Пример файлов в посте:
http://forum.dwg.ru/showpost.php?p=587269&postcount=945

Вот получившийся код, проблемное место выделено красным.

Код:

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

(vl-load-com)

(defun kbplc_save_new_dxf
       
       (/ adoc selsets selsetname vla_selset dwg_file wb_file wb-file1)	;перечень локальных переменных

(begin_activex)							;функция получения ссылки на активный документ (текущий чертеж)
  
  (setq
    	selsets	   (vla-get-selectionsets active_document)	;создание пустой выборки в текущем документе
	selsetname "wb"						;присвоение имени выборке
  ) ;_ end of setq

  (if (/=
	(setq dwg_file (vla-get-fullname active_document))	;Получение пути и имени файла и сохранение его в dwg_file
	""							;имя файла пустое
      )								;Если имя файла есть

    (progn							;выполнение если
      (vl-catch-all-apply					;защита от ошибки
	(function
	  (lambda ()
	    (vla-delete (vla-item selsets selsetname))		;очистка выборки (от хвостов и мусора)
	  ) ;_ end of lambda
	) ;_ end of function
      ) ;_ end of vl-catch-all-apply

      (setq vla_selset (vla-add selsets selsetname))		;создание пустого выбора

      (if (and (not (vl-catch-all-error-p			;если не было ошибки и см. vla-get-count
		      (vl-catch-all-apply
			(function				;создание бм - безопасных массивов
			  (lambda (/ group data) 		;Выборка по условию
			    (setq group	(vlax-make-variant	;создание варианта
					  (vlax-safearray-fill	;заполнение бм
					    (vlax-make-safearray;создание бм
					      vlax-vbinteger	;тип данных бм - целые числа
					      '(0 . 0)		;размерность массива (не определенный)
					    ) ;_ end of vlax-make-safearray
					    '(8)		;заполнение бм (8- dxf код слоя (Layer))
					  ) ;_ end of vlax-safearray-fill
					) ;_ end of vlax-make-variant
				  data	(vlax-make-variant	;создание варианта
					  (vlax-safearray-fill	;заполнение бм
					    (vlax-make-safearray;создание бм
					      vlax-vbvariant	;тип данных бм - неопределенные значения
					      '(0 . 0)		;размерность массива (не определенный)	
					    ) ;_ end of vlax-make-safearray
					    '("0,SF-TEXT,LASER-TEXT");заполнение бм (перечисление названий уровней(слоев))
								;'("ИменаСлоев,ЧерезЗапятую")
					  ) ;_ end of vlax-safearray-fill
					) ;_ end of vlax-make-variant
			    ) ;_ end of setq
			    (vla-selectonscreen			;интерактивный выбор графических объектов (без group и data выберет всё)
			      vla_selset 			;объект документа
			      group				;бм цел.чисел в виде варианта (фильтр по типу)
			      data				;бм с данными типа "вариант" (данные фильтра)
			    ) ;_end of vla-selectOnScreen		
			  ) ;_ end of lambda
			) ;_ end of function
		      ) ;_ end of vl-catch-all-apply
		    ) ;_ end of vl-catch-all-error-p
	       ) ;_ end of not
	       (> (vla-get-count vla_selset) 0)			;число выбранных объектов не равно 0 (что то выбрано)
	  ) ;_ end of and

	(progn
	  (setq wb_file (strcat				;куда пишем -> создание имени файла:
			    (vl-filename-directory dwg_file)	;путь текущего файла без "\" на конце
			    "\\"				;вставка "\" в конец пути тек.файла
			    (vl-filename-base dwg_file)		;имя текущего файла без расширения
			  ) ;_ end of strcat
	    ) ;_ end of setq
	  (vla-wblock						;Запись в файл:
	    active_document					;что берем за основу -> текуший документ
	    (setq wb_file1 (strcat				;куда пишем -> создание имени файла:
			     wb_file
;;;			    (vl-filename-directory dwg_file)	;путь текущего файла без "\" на конце
;;;			    "\\"				;вставка "\" в конец пути тек.файла
;;;			    (vl-filename-base dwg_file)		;имя текущего файла без расширения
			    "-1.dwg"				;добавка окончания "-1" к имени файла
			  ) ;_ end of strcat
	    ) ;_ end of setq
	    vla_selset						;что будем записывать -> выборку
	  ) ;_ end of vla-Wblock
	  


	  (princ (strcat "\nНабор был сохранен в файл " wb_file1));Отметка о выполнении

	  
;;;		(at_save_dwg-dxf)
;------------------------------------------------------------------------
(vla-open						;Открываем документ
      (vla-get-Documents (vlax-get-acad-object))	;из коллекции документов Автокада
    wb_file1)						;с именем из переменной wb_file1
  
(vla-saveas						;Сохраняем как
  (vla-item (vla-get-documents (vlax-get-acad-object)) wb_file1);указатель на конкретный элемент коллекции / массива
  wb_file						;Имя сохраняемого файла
  acr12_dxf						;Формат файла DXF версии 12
  ) ;_ end of vla-saveas


  (vla-close wb_file1)					;Закрываем файл wb_file1
;-----------------------------------------------------------------------	  
	  (princ "\nСоздание dxf завершено")
	  
	) ;_ end of progn
      ) ;_ end of if
      
      (vl-catch-all-apply					;защита от ошибки
	(function
	  (lambda ()
	    (vla-delete (vla-item selsets selsetname))		;очистка выборки
	  ) ;_ end of lambda
	) ;_ end of function
      ) ;_ end of vl-catch-all-apply
    ) ;_ end of progn
    
    (alert							;выполнение иначе
     "Файл не сохранялся еще ни разу! Выполнение невозможно!")	;Действие, если еще не было сохранение файла изначально
) ;_ end of if

  (princ)							;очистка строки статуса от отчета о выполнении функции (nil)
  
) ;_ end of defun

[Кулик Алексей aka kpblc]

Проверяй работу

Код:

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

(vl-load-com)

(defun copy-selset-to-dxf (/ adoc selsets selset ss_name vla_selset doc_to_save)

  (setq adoc    (vla-get-activedocument (vlax-get-acad-object))
        selsets (vla-get-selectionsets adoc)
        ss_name "wb"
        ) ;_ end of setq

  (if (/= (setq dwg_name (vla-get-fullname adoc)) "")
    (progn
      (vl-catch-all-apply
        (function
          (lambda ()
            (vla-delete (vla-item selsets ss_name))
            ) ;_ end of lambda
          ) ;_ end of function
        ) ;_ end of vl-catch-all-apply
      (setq vla_selset (vla-add selsets ss_name))
      (if (and (not (vl-catch-all-error-p ;если не было ошибки и см. vla-get-count
                      (vl-catch-all-apply
                        (function ;создание бм - безопасных массивов
                          (lambda (/ group data) ;Выборка по условию
                            (setq group (vlax-make-variant ;создание варианта
                                          (vlax-safearray-fill ;заполнение бм
                                            (vlax-make-safearray ;создание бм
                                              vlax-vbinteger ;тип данных бм - целые числа
                                              '(0 . 0) ;размерность массива (не определенный)
                                              ) ;_ end of vlax-make-safearray
                                            '(8) ;заполнение бм (8- dxf код слоя (Layer))
                                            ) ;_ end of vlax-safearray-fill
                                          ) ;_ end of vlax-make-variant
                                  data  (vlax-make-variant ;создание варианта
                                          (vlax-safearray-fill ;заполнение бм
                                            (vlax-make-safearray ;создание бм
                                              vlax-vbvariant ;тип данных бм - неопределенные значения
                                              '(0 . 0) ;размерность массива (не определенный)	
                                              ) ;_ end of vlax-make-safearray
                                            '("0,SF-TEXT,LASER-TEXT")
          ;заполнение бм (перечисление названий уровней(слоев))
          ;'("ИменаСлоев,ЧерезЗапятую")
                                            ) ;_ end of vlax-safearray-fill
                                          ) ;_ end of vlax-make-variant
                                  ) ;_ end of setq
                            (vla-selectonscreen
          ;интерактивный выбор графических объектов (без group и data выберет всё)
                              vla_selset ;объект документа
                              group ;бм цел.чисел в виде варианта (фильтр по типу)
                              data ;бм с данными типа "вариант" (данные фильтра)
                              ) ;_end of vla-selectOnScreen		
                            ) ;_ end of lambda
                          ) ;_ end of function
                        ) ;_ end of vl-catch-all-apply
                      ) ;_ end of vl-catch-all-error-p
                    ) ;_ end of not
               (> (vla-get-count vla_selset) 0) ;число выбранных объектов не равно 0 (что то выбрано)
               ) ;_ end of and
        (progn
          (setq doc_to_save (vla-add (vla-get-documents (vlax-get-acad-object))))
          (vla-copyobjects
            adoc
            (vlax-safearray-fill
              (vlax-make-safearray
                vlax-vbobject
                (cons 0 (1- (vla-get-count vla_selset)))
                ) ;_ end of vlax-make-safearray
              ((lambda (/ lst)
                 (vlax-for ent vla_selset
                   (setq lst (cons ent lst))
                   ) ;_ end of vlax-for
                 ) ;_ end of lambda
               )
              ) ;_ end of vlax-safearray-fill
            (vla-get-modelspace doc_to_save)
            ) ;_ end of vla-CopyObjects
          (vla-saveas doc_to_save (strcat dwg_name "-1") acr12_dxf)
          ) ;_ end of progn
        ) ;_ end of if
      ) ;_ end of progn
    (alert "Active file doesn't saved!")
    ) ;_ end of if
  ) ;_ end of defun

[alex8888]

Кулик Алексей aka kpblc, спасибо, на работе завтра проверю

Вроде бы проходит, только с именем файла я помудрю - пока пишется с двойным расширением (*.dwg.dxf)
Что касаемо самого процесса, то опять темный лес. И почему я такой тупой
Что происходит в этой строке: (cons 0 (1- (vla-get-count vla_selset))) ?
В книге Полещука выглядит так: (vla-copyobjects <объекты - БМ объектов> [<владелец - vla-объект места назначения>] [<пары клонирования - переменная в которой массив пар клонирования>]).
А что у нас:

Код:

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

(vla-copyobjects		;Клонирование объектов в другой док-т, блок или пр-во
	    adoc			;текущий документ
	    (vlax-safearray-fill	;заполнение бм
	      (vlax-make-safearray	;создание бм
		vlax-vbobject		;тип данных бм - vbobject
		(cons 0 (1- (vla-get-count vla_selset)))    ;- что это?
	      ) ;_ end of vlax-make-safearray
	      ((lambda (/ lst)                     ;это тоже темный лес
		 (vlax-for ent vla_selset
		   (setq lst (cons ent lst))
		 ) ;_ end of vlax-for
	       ) ;_ end of lambda
	      )
	    ) ;_ end of vlax-safearray-fill
	    (vla-get-modelspace doc_to_save)
	  ) ;_ end of vla-CopyObjects

Думал про себя что проще будет в Активах-Х разбираться.

Не понравилось. Когда вручную открываешь документ, сохраняешь как dxf последней модели (R12), то при последующем открытии его для предпросмотра - все, что вручную выбирал видно в окне, а когда все тоже но через твою программу - то видно пустое поле, а выбранные элементы спрятаны где-то за пределами экрана. Грешу на привязку к системам координат (уж больно похоже, что показывается та часть, которая топчется около центра МСК) Можно как то изменить?

[Кулик Алексей aka kpblc]

Сообщение от alex8888 Что происходит в этой строке: (cons 0 (1- (vla-get-count vla_selset))) ?

Задается размер безопасного массива.

Код:

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

(vla-copyobjects ;Клонирование объектов в другой док-т, блок или пр-во
  adoc    ; указатель, откуда копируем - текущий документ
  (vlax-safearray-fill ;заполнение бм
    (vlax-make-safearray ;создание бм
      vlax-vbobject ;тип данных бм - vbobject
      (cons 0 (1- (vla-get-count vla_selset))) ; размерность безопасного массива
      ) ;_ end of vlax-make-safearray
    ((lambda (/ lst) ; преобразование полученного через ActiveX набора в список
       ; Дело в том, что в safearray можно передавать только список элементов,
       ; и никак иначе.
       (vlax-for ent vla_selset
         (setq lst (cons ent lst))
         ) ;_ end of vlax-for
       ) ;_ end of lambda
     )
    ) ;_ end of vlax-safearray-fill
  (vla-get-modelspace doc_to_save) ; указатель на "получателя"
  ; То есть пространство модели добавленного документа.
  ) ;_ end of vla-CopyObjects

[alex8888]

Кулик Алексей aka kpblc, теперь все встало на свои места
А то голову сломал в этих ухищрениях.

Как насчет:

Когда вручную открываешь документ, сохраняешь как dxf последней модели (R12), то при последующем открытии его для предпросмотра - все, что вручную выбирал видно в окне, а когда все тоже но через твою программу - то видно пустое поле, а выбранные элементы спрятаны где-то за пределами экрана. Грешу на привязку к системам координат (уж больно похоже, что показывается та часть, которая топчется около центра МСК) Можно как то изменить?

Алексей, поясни пожалуйста как понять: (setq lst (cons ent lst)). Присвоение переменной lst (список, как я понял) точечной пары из символа ent и той же переменной? Какова роль символа ent?

[Кулик Алексей aka kpblc]

Скажу честно - я код гонял только на предмет "работает / не работает". Попробую посмотреть, но результат гарантировать не могу.

[alex8888]

Прошу помощи опять
Хочу скопировать объекты определенного фильтра (в данном случае со слоя 0) и вставить сюда же, но где то рядом.
Что пропустил в vla-copyobjects или неправильно сделал. До точки "до сюда функция дошла" - все в порядке, а дальше посылают ...

Код:

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

(defun begin_activex (/)
  
  (vl-load-com)				;Загрузка расширенний VLisp
  
  (setq acad_application (vlax-get-acad-object))
  					;док-т Автокада
  (setq active_document (vla-get-ActiveDocument acad_application))
					;активный док-т Автокада
  (setq model_space (vla-get-modelspace active_document))
					;пр-во модели активного док-та
  (setq paper_space (vla-get-paperspace active_document))
					;пр-во листа активного док-та

)					;defun
(defun at_select_objects_to_copy
       ( /
	selsets ss_name
;;;	vla_selset doc_to_save
	)
  
  (begin_activex)

  (setq selsets	(vla-get-selectionsets active_document)	;указатель на семейство наборов
	ss_name	"wb"				;имя для набора
  ) ;_ end of setq

  (vl-catch-all-apply		;ловля ошибок
	(function
	  (lambda ()
	    (vla-delete (vla-item selsets ss_name))	;удалить объект selsets с именем ss_name из раннего набора, если таковой был
	  ) ;_ end of lambda
	) ;_ end of function
      ) ;_ end of vl-catch-all-apply

  (setq vla_selset			;присвоить
	     (vla-add			;vla-
	       selsets			;набору
	       ss_name			;имя
	       );vla-add
	    );setq

  (if
   (and			;и см. vla-get-count (число выбранных элементов не нулевое)
	    (not			;не
		 (vl-catch-all-error-p	;равна ошибке (не возвращается объект типа ошибки)
		      (vl-catch-all-apply	;ловля ошибок
			
			(function		;создание бм - безопасных массивов
			  (lambda (/ group data) ;Выборка по условию
			    (setq group	(vlax-make-variant	;создание варианта
					  (vlax-safearray-fill  ;заполнение бм
					    (vlax-make-safearray;создание бм
					      vlax-vbinteger	;тип данных бм - целые числа
					      '(0 . 0)		;размерность массива (не определенный)
					    ) 			;_ end of vlax-make-safearray
					    '(8)		;заполнение бм (8- dxf код слоя (Layer))
					  ) ;_ end of vlax-safearray-fill
					);_ end of vlax-make-variant
				  
				  data	(vlax-make-variant	;создание варианта
					  (vlax-safearray-fill  ;заполнение бм
					    (vlax-make-safearray;создание бм
					      vlax-vbvariant	;тип данных бм - неопределенные значения
					      '(0 . 0)		;размерность массива (не определенный)	
					    ) 			;_ end of vlax-make-safearray
					    '("0");заполнение бм (перечисление названий уровней(слоев))
								;'("ИменаСлоев,ЧерезЗапятую")
					  );_ end of vlax-safearray-fill
					);_ end of vlax-make-variant
			    );_ end of setq
			    
			    (vla-selectonscreen			;интерактивный выбор графических объектов (без group и data выберет всё)
			      vla_selset 			;объект документа
			      group				;бм цел.чисел в виде варианта (фильтр по типу)
			      data				;бм с данными типа "вариант" (данные фильтра)
			    ) 			;_end of vla-selectOnScreen		
			  ) 			;_ end of lambda
			) 			;_ end of function
		      ) 		;_ end of vl-catch-all-apply
		    ) 			;_ end of vl-catch-all-error-p
	       ) 		;_ end of not
	    
	       (>			;2-е условие для "если Да" - число выбранных элементов не ничего
		 (vla-get-count vla_selset) 0) 	;число выбранных объектов не равно 0 (что то выбрано)
	  );and
   (
    (progn
      (alert "До сюда функция дошла")
      
      (vla-copyobjects			;Клонирование объектов в другой док-т, блок или пр-во
  active_document			; указатель, откуда копируем - текущий документ
  (vlax-safearray-fill			;заполнение бм
    (vlax-make-safearray		;создание бм
      vlax-vbobject			;тип данных бм - vbobject
      (cons 0 (1-			;создание точечной пары (0 . (число_элементов -1, потому что считается от 0))
		(vla-get-count		;получение числа объектов (элементов)
		  vla_selset)))		;объект
					; размерность безопасного массива
    ) ;_ end of vlax-make-safearray

    
    ((lambda (/ lst)			; преобразование полученного через ActiveX набора в список
					; Дело в том, что в safearray можно передавать только список элементов,
					; и никак иначе.
       (vlax-for			;Вычисляет выражение со всеми объектами семейства
		 ent			;символ, вместо которого в выражения нужно поочередно подставлять объекты семейства
		 vla_selset		;VLA-объект, соответствующий семейству, к объектам которого применяются выражения
	 (setq lst (cons ent lst))	;составление списка из VLA-объектов
       ) ;_ end of vlax-for
     ) ;_ end of lambda
    )
  ) ;_ end of vlax-safearray-fill
  model_space	; указатель на "получателя"
					; То есть пространство модели 
)
;;;    (vla-copy vla_selset)
    );progn
    );if true
   (alert "Function abort!"
    );if false
  );if
  
  );defun

[Кулик Алексей aka kpblc]

Это не сработает. Если надо копировать "рядом", не меняя пространство-владелец, то (если не прибегать, например, к командным методам), то проще будет воспользоваться командами vla-copy и vla-move - именно так, сначала одно, потом второе. Причины объяснены в справке, да и так видны
Я не рассматриваю вариант "прочитать все примитивы, пересчитать все точки, построить примитивы заново".

[alex8888]

Алексей,
vla-copyobjects - клонирование объектов в:
1. другой файл,
2. другое пространство,
3. блок. <- это подходит для копирования объектов и последующей их вставки в текущее же пространство, файл, чертеж? Или это что-то другое? Можно ли создать блок, перенести его и расчленить? Или это работа через ж...?

Набрал в предыдущий лисп (vla-copy vla_selset) , меня послали : VLA-OBJECT nil. Какой объект ему нужен? Я правильно понял, что в vla_selset у меня набор отфильтрованных элементов (выборка), или это только указатель на них, или это одно и тоже?

Какова должна быть последовательность действий? 1. vla-copy выбираемых объектов - они должны быть сохранены в какой-то переменной?
2. vla-move - указать 2 точки -откуда и куда переместить?

[Кулик Алексей aka kpblc]

Ну ты ета... Короче, не того. И не этого

Код:

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

(vl-load-com)

(defun test (/ fun_create-variant adoc ss_name ss_vla copy_res pt_base pt_end)

  (defun fun_create-variant (datas data-type)
    (vlax-make-variant
      (vlax-safearray-fill (vlax-make-safearray data-type (cons 0 (1- (length datas)))) datas)
      ) ;_ end of vlax-make-variant
    ) ;_ end of defun

  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (setq ss_name "wb")
  (vl-catch-all-apply
    (function
      (lambda ()
        (vla-delete (vla-item (vla-get-selectionsets adoc) ss_name))
        ) ;_ end of lambda
      ) ;_ end of function
    ) ;_ end of vl-catch-all-apply
  (setq ss_vla (vla-add (vla-get-selectionsets adoc) ss_name))
  (if (and (not (vl-catch-all-error-p
                  (vl-catch-all-apply
                    (function
                      (lambda (/ group data)
                        (setq group (fun_create-variant '(8) vlax-vbinteger)
                              data  (fun_create-variant '("0") vlax-vbvariant)
                              ) ;_ end of setq
                        (vla-selectonscreen ss_vla group data)
                        ) ;_ end of lambda
                      ) ;_ end of function
                    ) ;_ end of vl-catch-all-apply
                  ) ;_ end of vl-catch-all-error-p
                ) ;_ end of not
           (> (vla-get-count ss_vla) 0)
           (= (type (setq pt_base (vl-catch-all-apply
                                    (function
                                      (lambda ()
                                        (getpoint "\nBase point <Cancel> : ")
                                        ) ;_ end of lambda
                                      ) ;_ end of function
                                    ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'list
              ) ;_ end of =
           (= (type (setq pt_end (vl-catch-all-apply
                                   (function
                                     (lambda ()
                                       (getpoint pt_base "\End point <Cancel> : ")
                                       ) ;_ end of lambda
                                     ) ;_ end of function
                                   ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'list
              ) ;_ end of =
           (setq pt_base (vlax-3d-point pt_base)
                 pt_end  (vlax-3d-point pt_end)
                 ) ;_ end of setq
           ) ;_ end of and
    (progn
      (foreach ent 
;; Каждый из объектов копируем
(mapcar
                     (function
                       (lambda (x)
                         (vla-copy x)
                         ) ;_ end of lambda
                       ) ;_ end of function
;;; Преобразование набора в список примитивов
                     ((lambda (/ res)
                        (vlax-for ent ss_vla
                          (setq res (cons ent res))
                          ) ;_ end of vlax-for
                        res
                        ) ;_ end of lambda
                      )
                     ) ;_ end of mapcar
;; А теперь переносим копии
(vla-move ent pt_base pt_end)
        ) ;_ end of foreach
      ) ;_ end of progn
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)

  ) ;_ end of defun

[alex8888]

Кулик Алексей aka kpblc, вот это оперативность!
Только мне теперь опять неделю надо обсасывать твой код
Как все-таки кардинальным образом меняется код только лишь от изменения крохотного условия задачи
Спасибо.

Алексей, код работает на ура.

[Кулик Алексей aka kpblc]

Ни фига себе - "крохотного"... Есть принципиальная разница между копированием объектов между владельцами и копированием объектов внутри одного владельца.
Кстати, все вот это можно заменить элементарным:

Код:

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

(command "_.copy")
(while (/= (getvar "cmdactive") 0)
(command pause))

Вроде так...

[alex8888]

Я в шоке!

Но, в этом случае выбирать приходится вручную, можно попросту скопировать ненужное и упустить важное. Т.е. мне важнее все-таки отфильтрованные значения.

Не знал, что копирование со сменой владельца и просто копирование это сильно разные вещи. Ведь там копирование и там, Ctrl+C + Ctrl+V работают одинаково. А тут такие страшности! Я уж подумал, что ты просто не хочешь меня подпустить к объектному методу программирования , поэтому и меняешь код почти на 100%

Маленький вопросик (просьбочка ): а можно сделать в твоем лиспе так, чтобы скопированные объекты "висели" на курсоре, как при штатном копировании-вставке, а то неудобно - не видно куда вставляешь?

[Кулик Алексей aka kpblc]

Лиспом это слишком геморройно. Если коротко, то надо а) создавать анонимный блок и б) искать тему "На заметку программистам" и брать оттуда готовые коды.

[alex8888]

Алексей, понятно. Спасибо.

Кулик Алексей aka kpblc, а командными методами получилось проще:

Код:

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

(defun at_copy_paste ()			;определение функции, переменных нет

  (command)				;прерывает действие любой неоконченной команды

  (command "_.copy" (ssget '((8 . "0,Schrift"))) "")
					;копирует выбор со слоев 0 и Schrift

)					;defun

[gomer]

Прошу прощения за глупый вопрос... Но в чем разница

Сообщение от Кулик Алексей aka kpblc Код: [Выделить все] (defun test (/ fun_create-variant adoc ss_name ss_vla copy_res pt_base pt_end) (defun fun_create-variant (datas data-type) (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray data-type (cons 0 (1- (length datas)))) datas) ) ;_ end of vlax-make-variant ) ;_ end of defun .......

и

Код:

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

(defun test (/ fun_create-variant adoc ss_name ss_vla copy_res pt_base pt_end)

 (setq
  fun_create-variant
  (lambda (datas data-type)
    (vlax-make-variant
      (vlax-safearray-fill (vlax-make-safearray data-type (cons 0 (1- (length datas)))) datas)
    ) ;_ end of vlax-make-variant
  )
)
    .......

[Кулик Алексей aka kpblc]

Принципиально - наверное, ни в чем. Привычка у меня такая - функция должна быть функцией ))

[alex8888]

Кулик Алексей aka kpblc, пожалуйста посмотри мой код ниже.
1. Проблема состоит в том, что у меня не получается объединить 2 полилинии в одну. Вручную они объединяются нормально.
2. Можно как-нибудь упростить расчет точек для сплайна или уменьшить их количество не в ущерб развертки?

Код:

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

;|****************************************************************************
*        Программа построения развертки отвода                               *
*    Пример вызова: (at_stutzen 200 100 300), где                            *
*                          200 - диаметр основной трубы                      *
*                          100 - диаметр отвода                              *
*                          300 - длина отвода                                *
*  Составлена 13.07.2010  Автор: Tutubalin Alexander                         *
****************************************************************************|;


(defun at_stutzen (
		   Kopf_D
		   Stutzen_D
		   Stutzen_hoehe
		   /
		   pt_input
		   m
		   pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 pt10
		   pt11 pt12 pt13 pt14 pt15 pt16 pt17 pt18 pt19 pt20
		   pt21 pt22 pt23 pt24 pt25
		   m1 m2 m3 m4
		   otkat_pcm oldosm oldlay
		   spline1 rec poly
		   )
  
  (defun *error* (msg)
     (princ msg)				;text bei error
    (if	oldosm
      (setvar "OSMODE" oldosm)
    )					;if oldosm - zadano -> oldosm=oldosm
    (if	oldlay
      (setvar "CLAYER" oldlay)
    )					;if layer gewechselt -> zurueck
    (if otkat_pcm
      (setvar "plineconvertmode" otkat_pcm)

  )				;if
);error

					;Parametry privjazki

  (setq oldosm (getvar "osmode"))
  (setvar "osmode" 0)
  (setq oldlay (getvar "clayer"))
  (setq otkat_pcm (getvar "plineconvertmode"))
  (setvar "plineconvertmode" 1)


(if (< Kopf_D Stutzen_D)
  (progn
    (alert "\nKopf Durchmesser muss groesse als Stutzen Durchmesser sein")
    (exit)
    );progn
  );if

  (if (< Stutzen_hoehe (/ Kopf_D 2.0))
    (progn
    (alert "\nStutzen Hoehe muss laenge sein")
    (exit)
    );progn
  );if
    
(setq
  pt_input (getpoint "\nInsert point")
  m (/ (* pi Stutzen_D) 12.0)
	
  pt1 (polar pt_input 0 m)
  pt2 (polar pt1 0 m)
  pt3 (polar pt2 0 m)
  pt4 (polar pt3 0 m)
  pt5 (polar pt4 0 m)
  pt6 (polar pt5 0 m)
  pt7 (polar pt6 0 m)
  pt8 (polar pt7 0 m)
  pt9 (polar pt8 0 m)
  pt10 (polar pt9 0 m)
  pt11 (polar pt10 0 m)
  pt12 (polar pt_input 0 (* pi Stutzen_D))

  m1 (- Stutzen_hoehe (* 0.5 (sqrt (- (* Kopf_D Kopf_D) (* Stutzen_D Stutzen_D)))))
  m2 (- Stutzen_hoehe (* 0.5 (sqrt (- (* Kopf_D Kopf_D) (* 0.75 Stutzen_D Stutzen_D)))))
  m3 (- Stutzen_hoehe (* 0.5 (sqrt (- (* Kopf_D Kopf_D) (* 0.25 Stutzen_D Stutzen_D)))))
  m4 (- Stutzen_hoehe (* 0.5 Kopf_D))

  pt13 (polar pt12 (* 0.5 pi) m4)
  pt14 (polar pt11 (* 0.5 pi) m3)
  pt15 (polar pt10 (* 0.5 pi) m2)
  pt16 (polar pt9 (* 0.5 pi) m1)
  pt17 (polar pt8 (* 0.5 pi) m2)
  pt18 (polar pt7 (* 0.5 pi) m3)
  pt19 (polar pt6 (* 0.5 pi) m4)
  pt20 (polar pt5 (* 0.5 pi) m3)
  pt21 (polar pt4 (* 0.5 pi) m2)
  pt22 (polar pt3 (* 0.5 pi) m1)
  pt23 (polar pt2 (* 0.5 pi) m2)
  pt24 (polar pt1 (* 0.5 pi) m3)
  pt25 (polar pt_input (* 0.5 pi) m4)

  
  );setq


  
  (vl-cmdf "_spline" pt13 pt14 pt15 pt16 pt17 pt18 pt19 pt20 pt21 pt22 pt23 pt24 pt25 "" "" "")
	(setq spline1 (entlast)) ;setq spline1
    
  (vl-cmdf "_splinedit" spline1 "_p" "10")
  	(setq poly (entlast))

  (vl-cmdf "_pline" pt25 pt_input pt12 pt13 "")
	(setq rec (entlast))

  (vl-cmdf "_pedit" "_join" poly rec "")
    
  
  (setvar "osmode" oldosm)
  (setvar "clayer" oldlay)
  (setvar "plineconvertmode" otkat_pcm)

  (princ)

  
  );defun

[Кулик Алексей aka kpblc]

alex8888, с точками я не стал разбираться. А объединение попробуй так:

Код:

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

(vl-cmdf "_pedit" "_m" poly rec "" "_j" 0. "_close" "")

[alex8888]

Кулик Алексей aka kpblc, наверное, с точками ничего не поделаешь - там массив должен быть большой.

С объединением я решил по-другому: изменения в коде:

Код:

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

  pta (polar pt12 0 m)
  ptb (polar pta 0 m)
  ptc (polar ptb 0 m)
  ptd (polar pt_input pi m)
  pte (polar ptd pi m)
  ptf (polar pte pi m)

  pt26 (polar ptd (* 0.5 pi) m3)
  pt27 (polar pte (* 0.5 pi) m2)
  pt28 (polar ptf (* 0.5 pi) m1)
  pt29 (polar pta (* 0.5 pi) m3)
  pt30 (polar ptb (* 0.5 pi) m2)
  pt31 (polar ptc (* 0.5 pi) m1)

  ptm (polar pt6 (* 0.5 pi) (/ m4 2))




  
  );setq


  
  (vl-cmdf "_spline" pt31 pt30 pt29 pt13 pt14 pt15 pt16 pt17 pt18 pt19 pt20 pt21 pt22 pt23 pt24 pt25 pt26 pt27 pt28 "" "" "")
	(setq spline1 (entlast)) ;setq spline1
    
  (vl-cmdf "_splinedit" spline1 "_p" "10")
  	(setq poly (entlast))

  (vl-cmdf "_pline" pt25 pt_input pt12 pt13 "")
	(setq rec (entlast))

;;;  (vl-cmdf "_pedit" "_join" poly rec "")

  (vl-cmdf "_-boundary" ptm "")

  (vl-cmdf "_erase" poly "")
  (vl-cmdf "_erase" rec "")

Пришлось ввести еще 13 точек, потому что сплайн неверно обрабатывал края развертки. Получились "усы" в обе стороны.
Единственное, что boundary что то долго просчитывает у себя в уме (секунд 3-5), но это не смертельно.

[alex8888]

Помогите пожалуйста немного с оптимизацией.
Произвожу расчет координат по горизонтали (L) и по вертикали (H) для построения кривой опираясь на координаты базовой точки, задаваемой извне (здесь - пользователем):

Код:

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

(setq 	pt_insert (getpoint "\nInput start_point")
			
			spisok_sin (mapcar 'sin (list 0 (/ pi 8.0) (/ pi 4.0) (* 3.0 (/ pi 8.0)) (/ pi 2.0)))
			r2r (/ radius_stutzen radius_truba)
			
			L0 (sqrt (- (expt radius_stutzen 2.0) (* (expt (* radius_stutzen (nth 0 spisok_sin)) 2.0))))
			L1 (sqrt (- (expt radius_stutzen 2.0) (* (expt (* radius_stutzen (nth 1 spisok_sin)) 2.0))))
			L2 (sqrt (- (expt radius_stutzen 2.0) (* (expt (* radius_stutzen (nth 2 spisok_sin)) 2.0))))
			L3 (sqrt (- (expt radius_stutzen 2.0) (* (expt (* radius_stutzen (nth 3 spisok_sin)) 2.0))))
	  		L4 (sqrt (- (expt radius_stutzen 2.0) (* (expt (* radius_stutzen (nth 4 spisok_sin)) 2.0))))

	  		H0 (* radius_truba (at_arcsin (* r2r (nth 0 spisok_sin))))
	  		H1 (* radius_truba (at_arcsin (* r2r (nth 1 spisok_sin))))
	  		H2 (* radius_truba (at_arcsin (* r2r (nth 2 spisok_sin))))
	  		H3 (* radius_truba (at_arcsin (* r2r (nth 3 spisok_sin))))
			H4 (* radius_truba (at_arcsin (* r2r (nth 4 spisok_sin))))

	  		koordX (car pt_insert)
	  		koordY (cadr pt_insert)
 
			pt0 (list (+ koordX L0) (+ koordY H0) 0.0)
			pt1 (list (+ koordX L1) (+ koordY H1) 0.0)
			pt2 (list (+ koordX L2) (+ koordY H2) 0.0)
			pt3 (list (+ koordX L3) (+ koordY H3) 0.0)
			pt4 (list (+ koordX L4) (+ koordY H4) 0.0)
			pt5 (list (- koordX L3) (+ koordY H3) 0.0)
			pt6 (list (- koordX L2) (+ koordY H2) 0.0)
			pt7 (list (- koordX L1) (+ koordY H1) 0.0)
			pt8 (list (- koordX L0) (+ koordY H0) 0.0)
			pt9 (list (- koordX L1) (- koordY H1) 0.0)
			pt10 (list (- koordX L2) (- koordY H2) 0.0)
			pt11 (list (- koordX L3) (- koordY H3) 0.0)
			pt12 (list (- koordX L4) (- koordY H4) 0.0)
			pt13 (list (+ koordX L3) (- koordY H3) 0.0)
			pt14 (list (+ koordX L2) (- koordY H2) 0.0)
			pt15 (list (+ koordX L1) (- koordY H1) 0.0)
	)

а хотелось бы изменить так, чтобы количество L(x) и H(x) могло быть другим, т.е. как бы сделать мини-функцию в зависимости от х, чтобы получить переменные и сохраненные в них значения для дальнейшей обработки. Или создать список L-H и из него получать значения.

Попробовал применить что то типа (strcat "L" (itoa i)) и (sqrt .... i...), где i - счетчик количества углов (синусов), используемых для построения, но не могу сделать переменную Li - она получается в виде "Li" и ее нельзя использовать например для setq

[Кулик Алексей aka kpblc]

AtroksAlold, это ты про что?

[alex8888]

Кулик Алексей aka kpblc, наверное, AtroksAlold про меня так написал

[Frigate]

Добрый день

Изучаю понемногу ЛИСП, в том числе и на примерах книги создателей РУ-КАДа.
Периодически возникают вопросы, на которые не всегда удается найти ответ на форумах и в учебниках.

Пока простой вопрос, может он даже слишком простой:

записываю функцию только с локальными переменными, заданными явно

Код:

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

(defun function ( / a b c )
...
)

и БЕЗ переменных, заданных явно (локальные переменные задаются в теле самой функции через "setq"), например:

Код:

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

(defun C:obj_prop ()
(setq ent 647)
(princ)
)

Есть ли разница, как задавать локальные аргументы в функции? Может тут какие подводные камни, о которых я не знаю?

[gomer]

Второй случай менее предпочтителен, так как ent - глобальная переменная и может в других функциях использоваться, как следствие возможность возникновения ошибки

[Дима_]

Сообщение от Frigate Есть ли разница, как задавать локальные аргументы в функции?

когда ты обращаешся к ent - ты создаешь не локальную а ГЛОБАЛЬНУЮ переменную (т.к. в локальных ее нет), она доступна для всех лисп приложений - но на деле вероятность "конфликта" возрастает, если ими и пользоваться - то только с сильно уникальным именем (например например "название-функции_номер-подвресии_имя-автора_ent").

[superkot007]

Доброго времени суток! Пробовал искать, но не нашел - lisp для преобразования полилиний в отрезки
Помогите, пожалуйста...

[Кулик Алексей aka kpblc]

_.explode, что ли?

[Frigate]

Спасибо за ответ. Теперь ясно )

Появились еще пара вопросов.

Вот в этом коде, взятом из справки

Код:

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

(setq mycircle (vla-addCircle mSpace 
(vlax-3d-point '(3.0 3.0 0.0)) 2.0))

мне выкидывает ошибку

неверный тип аргумента: VLA-OBJECT nil

Я не совсем понимаю пока объектную модель, как в ЛИСПе задать mySpace. В VBA понятно - текущий документ.modelspace (примерно так), а вот в ЛИСПе - не знаю...

Если брать функцию для работы с другим объектом, напр. таблицей, то здесь мне почти все уже понятно:

Код:

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

 
(defun C:test ( / ent )
(setq ent   (vlax-ename->vla-object (car (entsel "\nВыбрать таблицу : "))) 
            ) ;_ end of setq 
(vla-setcelltextheight
ent
2
2
5.0
)
)

Хотя в следующем примере, указанном КРЫСом, вылетает ошибка

ActiveX Server возвратил ошибку: Параметр является обязательным

Код:

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

 
(vl-load-com)
(setq ent   (vlax-ename->vla-object (car (entsel "\nВыбрать таблицу : "))) 
      ) ;_ end of setq 
(vla-setcellgridlineweight
        ent
        row_counter
        col_counter
        (+ acleftmask acrightmask)
        aclnwt050
        ) ;_ end of vla-SetCellGridLineWeight

И может мне кто объяснить что значат

Код:

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

acleftmask

и

acrightmask

здесь? ПО справке - это некий EDGE, но я не понимаю точный смысл EDGE, если это граница, то что тогда GRID? Видимо нужно ставить англ. версию АвтоКАДа, чтобы видеть оригинальные названия...

Надеюсь на ваши ответы )

[superkot007]

Сообщение от Кулик Алексей aka kpblc _.explode, что ли?

Блин, интересно, как же я пробовал и не получалось?!
Спасибо!

Не могу найти тему с переводом таблицы из AutoCAD (построена из отрезков) в Excel (помню же, была такая...)
Нашел еще это - http://sites.google.com/site/bushman...tablic-v-excel, но что с ним делать?

[Кулик Алексей aka kpblc]

Frigate, mspace сначала надо определить. Например, так:

Код:

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

(vl-load-com)

(setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))

Насчет ошибки... row_counter (счетчик строк) и col_counter (счетчик столбцов) должны быть заданы предварительно и не быть nil. Номера строк/столбцов начинаются с 0.
Я на autolisp.ru рассказывал о клавиатурных сокращениях. А в справке можно посмотреть, что означает acleftmask Я сейчас уже сам не помню.
superkot007, я на ру-борде ответил.

[Frigate]

Кулик Алексей aka kpblc

Спасибо большое

[puma]

Начинаю разбираться в lisp. Возник такой вопрос: можно ли как-то обрабатывать прерывание (например, escape) выполнения команд в (command...), не прибегая к vla-? поиском не нашел
Пример кода:

Код:

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

(defun c:dimension_M ()
(Setq *oldlayer* (getvar "CLAYER"))
(setvar "CLAYER" "dimension")
(command "_DIMLINEAR" pause pause pause )
(setvar "CLAYER" *oldlayer*)
(setq *oldlayer* "nill")
)
 (princ)
 )

Offtop: за код просьба не ругать, только начинаю ковыряться

[gomer]

Причем тут vla-? юзай *error* Пиши туда все... вплоть до полного игнора...

[puma]

Сообщение от gomer Причем тут vla-? юзай *error* Пиши туда все... вплоть до полного игнора...

посмотрел справку - смысл понятен, но каким образом узнать, что команда была отменена? так как command возвращает nill, хотя могу здесь ошибаться .

[gomer]

При нажатии эскейп *error* выполняется автоматически

[ShaggyDoc]

Возник такой вопрос: можно ли как-то обрабатывать прерывание (например, escape) выполнения команд в (command...), не прибегая к vla-?

Полноценной обработки прерывания без VLA-функций не сделать. Нажатие ESC прерывает программу и передает управление функции *error*.

каким образом узнать, что команда была отменена? так как command возвращает nill

Надо использовать не command, а vl-cmdf. Она уже не только nil возвращает.

Но, чтобы например, в программе рисования чего-то можно было бы прервать, например, простановку размера, но продолжить выполнение кода дальше, надо использовать vl-catch-all-apply, vl-catch-all-error-p, vl-catch-all-error-message

Эту святую троицу надо обернуть в свою функцию обработки ошибок, которую можно использовать тысячи раз. В очередной раз привожу код ловушки ошибок:

Код:

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

(defun ru-error-catch
       (protected_expression on_error_expression / catch_error_result)
;|
Пример вызова
(ru-error-catch
    (function (lambda ()
                ;;; защищаемое выражение  
                (
                
                )
                ;;; То что вернет - будет результатом
              ) ;_ end of lambda
    ) ;_ end of function
    (function
      (lambda (err_msg)
        ;; если надо - выводим сообщение. err_msg подставит Автокад
        (princ (strcat "\nОШИБКА такой-то функции: " err_msg))
        ;; возвращаем NIL при ошибке
        nil
      ) ;_ end of lambda
    ) ;_ end of function
  )

|;
  
  (setq catch_error_result
         (vl-catch-all-apply protected_expression)
  ) ;_ end of setq
  (if (and (vl-catch-all-error-p catch_error_result)
           on_error_expression
      ) ;_ end of and
    (apply on_error_expression
           (list (vl-catch-all-error-message catch_error_result))
    ) ;_ end of apply
    catch_error_result
  ) ;_ end of if
)

Вот теперь программу можно "насмерть" защитить. Вплоть до полного игнора нажатия ESC. Или, наоборот, разрешив по ESC прерывать только кусок кода.
Пример:

Код:

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

(defun _draw_dim_rotated (pnt1 pnt2 ang)
  (while
   (not
    (ru-error-catch
     (function (lambda ()
                (princ "\nПоложение размерной линии: ")
                (vl-cmdf "_.DIMLINEAR"
                         pnt1
                         pnt2
                         "_Rotated"
                         (ru-conv-rad-to-deg ang)
                         pause
                ) ;_ end of vl-cmdf
               ) ;_ end of lambda
     ) ;_ end of function
     nil
    ) ;_ end of ru-error-catch
   ) ;_ end of not
  ) ;_ end of while
 )

Это локальная функция простановки размера между заданными точками.

И еще есть возможность обработки ERRNO. Вот пример:

Код:

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

(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
 ;; (PRINT (getvar "errno"))
  (cond
    ((equal (getvar "errno") 52)
     ;; пустой ответ
     nil
    )
    (t
     (list (car ent) (trans (cadr ent) 1 0))
    )
  ) ;_ end of cond
) ;_ end of defun

Эта функция заменяет entsel. При работе со штатной entsel неизвестно, то ли пользователь просто промазал при указании объекта, то ли нажал ESC (а это может быть знак отказа от выбора, но продолжения программы).

Используя такие простые приемы мы добиваемся, чтобы до *error* вообще никогда не доходило дело.

[Кулик Алексей aka kpblc]

Может быть, ситуацию прояснит http://autolisp.ru/2009/09/20/howto_undo/

[Do$]

Сообщение от ShaggyDoc Полноценной обработки прерывания без VLA-функций не сделать

Озадачили... Может быть VL- имелось в виду?

[ShaggyDoc]

Сообщение от Do$ Озадачили... Может быть VL- имелось в виду?

Ну да. Может быть. Вообще всякие "страшные", сверх базовых функций LISP. "Ну ты, мужик, понял" (С)
Здесь иногда спрашивают, а потом выясняется, что под какой-то "аналог" Автокада пишут.

[puma]

Сообщение от ShaggyDoc Вообще всякие "страшные", сверх базовых функций LISP. "Ну ты, мужик, понял" (С)

Имелось ввиду именно это . Всем спасибо за точные подсказки.

[Frigate]

Еще раз здравствуйте, коллеги :-)

Продолжаю по возможности разбираться в LISPе.
Назрели вопросы, которые необходимо уяснить для полноценного понимания программирования в LISP.

1. Почему для поиска всех блоков на рисунке используются следующие аргументы у функции ssget:

(ssget '((0 . "INSERT")))

По DXF-кодам INSERT, как я понимаю, описывает ссылки на блок, блоки. А что же тогда значат DXF коды самого объекта “BLOCK” и как воспользоваться кодами объекта “BLOCK”? Причем там есть интересный такой код, под кодом 3 - тоже "Block name", как и код 2. Что это?

2. Когда набор (set selection) остался пустым – все его члены были удалены – как удалить сам набор, чтобы переменная, которой он присвоен, была nil? Я пока переменную, которой присвоет набор, приравниваю сначала к "0", а затем к nil (сразу nil не присваивается).