dwg.ru forum rss xml
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу)

Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу)

Версия для печати
 
Ответ
Опции темы Поиск в этой теме
Непрочитано 20.07.2008, 20:12
Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу)
Red Nova
 
ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Торонто
Регистрация: 23.10.2007
Сообщений: 1,968
Отправить сообщение для Red Nova с помощью Skype™

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
_____________________________________________________________________________________________________________

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

Последний раз редактировалось Red Nova, 12.07.2017 в 05:43.
Просмотров: 1414285
 
Непрочитано 14.11.2017, 18:49
#3421
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 4,699


Цитата:
Сообщение от Setvar Посмотреть сообщение
Сергей812, а ты разве Wolkodaw?
здесь общий форум)
Сергей812 вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 27.11.2017, 13:34
#3422
gnuvse


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


Здравствуйте, есть вот такая программа.

Код:
[Выделить все]
 
; Cуммирование текста вер. 0.0.1
; 
;

(defun c:sum()
  (setq flag 1)
  (setq sum 0)

  (while (/= flag 0)
    (setq txt (vla-get-TextString (vlax-ename->vla-object (car (entsel "\nУкажите текст: ")))))
    (princ "\n")
    (setq sum (+ sum (atof txt)))
    (princ sum)
  )
)
Я хочу сделать обработку получаемой строки - заменить вещственный знак запятой на точку.

В Си бы я сделал вот так
Код:
[Выделить все]
 
// -*C*-
#include <stdio.h>
#include <string.h>
#include <stdlib.h>



int main()
{

    char *str = "15,9";
    char new_str[strlen(str)];
    unsigned int i;

    for (i = 0; i < strlen(str); i++)
        if (str[i] == ',')
            new_str[i] = '.';
        else
            new_str[i] = str[i];
    new_str[i] = '\0';

    double num = atof(new_str);
    printf("%f\n", num);

    return 0;
}

Как так же провернуть в AutoLisp?

Спасибо за ваше время
gnuvse вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 28.11.2017, 12:44
#3423
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 4,699


vl-string-translate ?
Сергей812 вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 28.11.2017, 15:33
#3424
Кулик Алексей aka kpblc
Moderator

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


Скорее уж vl-string-subst
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 29.11.2017, 16:33
#3425
gnuvse


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


Цитата:
Сообщение от Сергей812 Посмотреть сообщение
vl-string-translate ?
Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Скорее уж vl-string-subst

Спасибо, что ответили, именно vl-string-subst, в тот же день нашел ответ на свой вопрос в справочнике Полещука.
Впредь буду туда заглядывать.
gnuvse вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 09.01.2018, 23:23
#3426
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,968
Отправить сообщение для Red Nova с помощью Skype™


Доброго. Вопрос про обработку ошибок.
При нажатии esc в каком случае может выход из команды произойти не через *error* ?
Для моего кода если Vlide закрыт то при esc обработка ошибок не происходит, если Vlide открыт то при esc либо Vlide зависает либо после многократного нажатия esc вычисления останавливаются и приходится выходить через Debug - reset to top level.
Код обрабатывает очень длинные списки.
__________________
Блог
Red Nova вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 09.01.2018, 23:25
#3427
Кулик Алексей aka kpblc
Moderator

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


Поскольку код не показан, могу порекомендовать:
а) исключить рекурсию
б) найти в "Библиотеке функций" обработчик ошибок (нечто типа _dwgru-catch-error) и использовать именно его.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 09.01.2018, 23:56
| 1 #3428
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,968
Отправить сообщение для Red Nova с помощью Skype™


Попытаюсь вечером почистить код и привести пример.
_dwgru-catch-error кстати не нашел, но до error дело просто не доходит.
__________________
Блог
Red Nova вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 10.01.2018, 03:03
#3429
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,968
Отправить сообщение для Red Nova с помощью Skype™


Вот более менее короткий пример и файл в котором следует тестировать.
После вызова test нужно задать 3 точки, очередность указана в файле.
Если по середине процесса нажать esc, то *error* не сработает.
Вложения
Тип файла: dwg
DWG 2013
example.dwg (139.5 Кб, 9 просмотров)
Тип файла: lsp example.lsp (11.7 Кб, 18 просмотров)
__________________
Блог
Red Nova вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 10.01.2018, 06:00
#3430
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,665
Отправить сообщение для VVA с помощью ICQ Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от Red Nova Посмотреть сообщение
_dwgru-catch-error кстати не нашел, но до error дело просто не доходит
dwgru-error-catch - Как организовать досрочный выход из цикла?
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 10.01.2018, 17:29
#3431
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,968
Отправить сообщение для Red Nova с помощью Skype™


Спасибо за ссылку.
Подскажите плиз как именно мне следует использовать dwgru-error-catch?
Скажем у меня проблема в цикле while.
Вот участок кода
Код:
[Выделить все]
 (while (not (= QDeckNormal 0))
	  (command "_.COPY" CSNormalblk "" "0,0" (strcat "0," (rtos (* -24 ScaleFactor))))
	  (setq QDeckNormal (- QDeckNormal 1))
	  (setq CSNormalblk (entlast))
	  )
Пока тут идут вычисления пользователь нажал esc. Требуется выйти через *error*.
Пробую подставить весь while под dwgru-error-catch
Код:
[Выделить все]
 (dwgru-error-catch
	(while 
.............
    )
	nil
	)
Моей задаче это не помогло.

Вообще я наивно полагал что при esc выход всегда через *error*, а тут нет. Почему так?
__________________
Блог
Red Nova вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 10.01.2018, 18:35
#3432
Кулик Алексей aka kpblc
Moderator

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


Red Nova, ты не поверишь, но считай весь твой код надо переделывать (это если по-хорошему )
Основной вопрос - тебе обязательно применение прямоугольника или можно обойтись без привязок?

----- добавлено через ~29 мин. -----
О, кстати! Обрати внимание на строку
Код:
[Выделить все]
 (progn (alert "Too narrow for a Bay") (*error*))
ничего странного не замечаешь? ))

----- добавлено через ~50 мин. -----
Еще момент - сделай блок безразмерным и тогда не надо будет мучаться с масштабами.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 10.01.2018, 21:47
#3433
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,968
Отправить сообщение для Red Nova с помощью Skype™


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Red Nova, ты не поверишь, но считай весь твой код надо переделывать (это если по-хорошему )
Поверю. Ломай меня полностью. Только давай если можно разделим на 2 части.
1. Вариант по хорошему, с переделкой по полной программе.
2. Вариант полегче. Хоть какой костыль чтоб error заработала.
Основная проблема не именно в этом коде. Я просто выбрал тот что покороче и поменьше вложенных функций.
У меня десятки схожих кодов более сложной конструкции.

Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Основной вопрос - тебе обязательно применение прямоугольника или можно обойтись без привязок?
Прямоугольник я уже не использую, беру взамен полилинию. Но для некоторых вариаций привязка нужна.
Затем (этого в приведенном коде нет) задаю мертвые зоны (куда не должно попасть ребро панели), потом создаю списки со всевозможными положениями ребер. Нахожу наилучшее положение ребер сочитая эти списки у уже тогда строю блоки.
В процессе составления списков и возникла нужда останавливать процесс вычисления про помощи escape. Так как в зависимости от площади список может состоять из десяток или сотен тысяч элементов. Вычисление займет много времени и если желаемое положение сравнительно быстро не найдено то нужно остановить вычисление.


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
О, кстати! Обрати внимание на строку
Код: (progn (alert "Too narrow for a Bay") (*error*))
Верно. Приписал nil
Код:
[Выделить все]
 (progn (alert "Too narrow for a Bay") (*error* nil))
Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Еще момент - сделай блок безразмерным и тогда не надо будет мучаться с масштабами.
Как-то замарочился на этот счет. Так и не смог заставить безразмерные блоки работать так как нужно мне. Но теперь уже поздно к этому возвращаться.
__________________
Блог
Red Nova вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 10.01.2018, 22:14
#3434
Кулик Алексей aka kpblc
Moderator

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


М-да... Тогда все мои переделки можно смело выбрасывать
В качестве пожеланий (и прошу не рассматривать ссылки как рекламу):
  1. Не контролируется наличие слоя, на который надо помещать блоки
  2. Не контролируется - а есть ли в файле вообще такой блок
  3. Только INSUNITS учитывать недостаточно. Во-первых, у нее чуть больше чем два значения. Во-вторых, INSUNITS совсем необязательно коррелирует с INSUNITSDEFSOURCE, INSUNITSDEFTARGET, MEASUREMENT, LUNITS и параметрами, регулируемым командой _.dwgunits. И до фига чем еще.
  4. Вычисления (особенно длительные) лучше делать с прогресс-баром.
  5. Постарайся вообще не использовать командные методы - они самые медленные. Намного быстрее будет создать определение анонимного блока, в него выполнять вставку объектов с заранее вычисленными параметрами, а потом уже выполнять его вставку, разбитие и (возможно) уничтожение.
  6. Если таких кодов "десятки", постарайся использовать все же не *error*, а другие способы. Частенько они становятся более внятными и предсказуемыми.
  7. Настоятельно рекомендую решить - то ли ты пишешь код для работы только в мировой системе координат, то ли в любой. Второй подход может значительно усложнить решение.
Я думаю, что тебе надо делать одновременно две задачи: ускорять вычисления и ускорять вставку. Для ускорения вычислений используй, например, ассоциативные списки и передачу параметров по ссылке, а не по значению. Для ускорения построений - я уже написал.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 11.01.2018, 00:09
#3435
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,968
Отправить сообщение для Red Nova с помощью Skype™


Спасибо за ответ.

Цитата:
Не контролируется наличие слоя, на который надо помещать блоки
Не контролируется - а есть ли в файле вообще такой блок
Только INSUNITS учитывать недостаточно. Во-первых, у нее чуть больше чем два значения. Во-вторых, INSUNITS совсем необязательно коррелирует с INSUNITSDEFSOURCE, INSUNITSDEFTARGET, MEASUREMENT, LUNITS и параметрами, регулируемым командой _.dwgunits. И до фига чем еще.
В идеале согласен. Поскольку по факту учил лисп в процессе то пошел более легким путем. Делаю соответствующий шаблон и работаю в нем.
Цитата:
Вычисления (особенно длительные) лучше делать с прогресс-баром.
Нужно почитать.
Цитата:
Постарайся вообще не использовать командные методы - они самые медленные.
Что командные методы - самые медленные знаю. Но поскольку само построение сравнительно недолгое то на это забил.
Цитата:
Намного быстрее будет создать определение анонимного блока, в него выполнять вставку объектов с заранее вычисленными параметрами, а потом уже выполнять его вставку, разбитие и (возможно) уничтожение.
Хорошая идея. Нужно потыкать. Может использую в будущем.
Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Настоятельно рекомендую решить - то ли ты пишешь код для работы только в мировой системе координат, то ли в любой. Второй подход может значительно усложнить решение.
Сперва намеревался делать для любой. Потом встретил пару сучков и теперь все делаю под мировую систему координат.

Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Если таких кодов "десятки", постарайся использовать все же не *error*, а другие способы. Частенько они становятся более внятными и предсказуемыми.
Вот об этом прошу поподробнее.
Пока не понял что мне делать с основной задачей? Через *error* никак не выйти?

Цитата:
Сообщение от Red Nova Посмотреть сообщение
Скажем у меня проблема в цикле while.
Вот участок кода
Код:
(while (not (= QDeckNormal 0))
(command "_.COPY" CSNormalblk "" "0,0" (strcat "0," (rtos (* -24 ScaleFactor))))
(setq QDeckNormal (- QDeckNormal 1))
(setq CSNormalblk (entlast))
)
Пока тут идут вычисления пользователь нажал esc. Требуется выйти через *error*.
Почитаю вечером твою статью "Код без ошибок – возможно ли?" . Может что и переварю...

----- добавлено через ~2 ч. -----
Ну вот, добрался до дома, читаю твою статью и не пойму. Разве это мой случай?

Цитата:
Если попытаться вызвать (lispru-func-1), мы получим в консоли:

call (fun_func-2)
fun_func-2 error : divide by zero
_$

То есть такой обработчик заканчивает выполнение функции - обратите внимание, текст "(fun_func-2) finished" даже не пытается напечататься: срабатывает обработчик, прописанный в fun_func-2, и на этом выполнение кода заканчивается. А если продолжать все равно надо? В таком случае приходит на помощь вариант 2:
Использование функции vl-catch-*:
Мне и не нужно продолжать. Переход к моей локальной *error* у меня как раз и не происходит.
Давай забудем про мой предыдущий пример.
Вот специально под вопрос написал задачку, своеобразный светофор.
Создаю простой но требующий несколько секунд для исполнения цикл while. (5 миллионов простых вычислений у меня машина считает примерно за 5 секунд).

Код:
[Выделить все]
 (defun c:test ( / i var val *error*)
  (defun *error* ( msg )
    (mapcar 'setvar var val)
    (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
                 (princ (strcat "\nError: " msg)))
    (vla-endundomark adoc)
    )

  (vl-load-com)
  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  
  (setq var '(clayer cecolor) 
        val  (mapcar 'getvar var))

  (setvar "cecolor" "1")
  (setq i 1)
  (while
    (< i 5000000)
    (setq i (1+ i))
    )
  (setvar "cecolor" "2")
  (*error* nil)
  )
Выставляем текущий цвет - Зеленый.
Вызываем test.
А. Если while и *error* отработали то на исходе цвет Зеленый (3).
Б. Если промеж цикла while что-то не так (к примеру если нажать escape) то на выходе цвет Красный (1) (ни while ни *error* не отработали).
В. Ну а если while отработала а до escape дело не дошло то выходе цвет Желтый (2).
С вариантами А и В все ясно. (В в такой постановке по сути и не достегаем)
Как быть с вариантом Б? Прошу привести решение.
__________________
Блог

Последний раз редактировалось Red Nova, 11.01.2018 в 02:15.
Red Nova вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 11.01.2018, 08:07
#3436
Кулик Алексей aka kpblc
Moderator

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


Ну, как вариант (без проверок):
Код:
[Выделить все]
 (vl-load-com)
(defun c:test1 (/ adoc sysvars i)
  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (princ (strcat "\nCeColor = " (getvar "cecolor")))
  (setq sysvars (vl-remove nil
                           (mapcar (function (lambda (x / tmp)
                                               (if (setq tmp (getvar (car x)))
                                                 (progn (if (cdr x)
                                                          (setvar (car x) (cdr x))
                                                          ) ;_ end of if
                                                        (cons (car x) tmp)
                                                        ) ;_ end of progn
                                                 ) ;_ end of if
                                               ) ;_ end of lambda
                                             ) ;_ end of function
                                   '(("cecolor" . "1"))
                                   ) ;_ end of mapcar
                           ) ;_ end of vl-remove
        i       0
        ) ;_ end of setq
  (princ (strcat "\nCeColor = " (getvar "cecolor")))
  (vl-catch-all-apply (function (lambda () (while (< 1 5e9) (setq i (1+ i))))))
  (setvar "cecolor" "2")
  (princ (strcat "\nCeColor = " (getvar "cecolor")))
  (foreach item sysvars (setvar (car item) (cdr item)))
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun
И ты так радостно готовишься к ошибке отмены, что аж оторопь берет
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 11.01.2018, 21:19
#3437
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,968
Отправить сообщение для Red Nova с помощью Skype™


kpblc,
Спасибо. Постараюсь сделать костыль на основе vl-catch-all-apply.

На англоязычном форуме проверили мой код, дык у коллеги с Итальянским интерфейсом при escape по середине while *error* отрабатывает. А у меня нет. Баг акада?

Код:
[Выделить все]
 (defun c:test ( / i var val *error*)
  (defun *error* ( msg )
    (print (getvar "cecolor")) (princ " < color on start *error*")
    (mapcar 'setvar var val)
    (print (getvar "cecolor")) (princ " < color after mapcar *error*")
    (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
                 (princ (strcat "\nError: " msg)))
    (vla-endundomark adoc)
    (print (getvar "cecolor")) (princ " < color after endundomar *error*")
  )
  (vl-load-com)
  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (print (getvar "cecolor")) (princ " < color on start test")
  (setq var '(clayer cecolor)
        val  (mapcar 'getvar var))
  (setvar "cecolor" "1")
  (print (getvar "cecolor")) (princ " < color after cecolor 1")
  (setq i 1)
  (while
    (< i 5000000)
    (setq i (1+ i))
  )
  (setvar "cecolor" "2")
  (print (getvar "cecolor")) (princ " < color after cecolor 2")
  (*error* nil)
  (print (getvar "cecolor")) (princ " < color on end test")
)
Цитата:
Comando: TEST
"3" < color on start test
"1" < color after cecolor 1
"1" < color on start *error*
"3" < color after mapcar *error*
Error: Funzione annullata <<< ESC
"3" < color after endundomar *error*

Comando: test
"3" < color on start test
"1" < color after cecolor 1
"2" < color after cecolor 2
"2" < color on start *error*
"3" < color after mapcar *error*
"3" < color after endundomar *error*
"3" < color on end test" < color on end test"
__________________
Блог
Red Nova вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 12.01.2018, 07:57
#3438
Кулик Алексей aka kpblc
Moderator

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


Может быть, дело в настройках среды
Миниатюры
Нажмите на изображение для увеличения
Название: 2018-01-12_07-56-10.png
Просмотров: 27
Размер:	6.3 Кб
ID:	197618  
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 12.01.2018, 19:19
#3439
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,968
Отправить сообщение для Red Nova с помощью Skype™


Неа, у меня галочка не стоит.
На theswamp мне подсказали заменить mapcar в *error* на foreach.
В начале это помогло (хотя почему mapcar приводило к ошибке так и не ясно). Переделанный код с #3437 заработал при нажатии escape.
Но я рано радовался. Попытался добавить в *error* изменение системы координат и *error* опать сломалась.

Цитата:
Command: TEST1
"3" < color on start test
"1" < color after cecolor 1
"1" < color on start *error*
"3" < color after variavle reset using foreach *error*
"3" < color after endundomar *error*
Command:
Command: *Cancel*
Цитата:
Command: TEST2
"3" < color on start test
"1" < color after cecolor 1ucs
Current ucs name: *WORLD*
Specify origin of UCS or [Face/NAmed/OBject/Previous/View/World/X/Y/Z/ZAxis] <World>: z
Specify rotation angle about Z axis <90d0'0">: 45
Command:
"UCS rotated"
"1" < color on start *error*
"3" < color after variavle reset using foreach *error*Function cancelled
Command: *Cancel*
При этом оба кода работают нормально если не нажимать escape и дать коду отработать до конца.

Код:
[Выделить все]
 (defun c:test2 (/ i val *error*)
  (defun *error* (msg)
    (print (getvar "cecolor"))
    (princ " < color on start *error*")
    (foreach v val (setvar (car v) (cdr v)))
    (print (getvar "cecolor"))
    (princ " < color after variavle reset using foreach *error*")
    (command-s "_.ucs" "_w")
    (print "UCS reset *error*")
    (if	(and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
      (princ (strcat "\nError: " msg))
    )
    (vla-endundomark adoc)
    (print (getvar "cecolor"))
    (princ " < color after endundomar *error*")
  )
  (vl-load-com)
  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (print (getvar "cecolor"))
  (princ " < color on start test")
  (setq val (mapcar (function (lambda (v) (cons v (getvar v)))) '("clayer" "cecolor")))
  (setvar "cecolor" "1")
  (print (getvar "cecolor"))
  (princ " < color after cecolor 1")
  (command "ucs" "z" "45")
  (print "UCS rotated")
  (setq i 1)
  (while (< i 5000000) (setq i (1+ i)))
  (setvar "cecolor" "2")
  (print (getvar "cecolor"))
  (princ " < color after cecolor 2 (while completed)")
  (*error* nil)
  (print (getvar "cecolor"))
  (princ " < color on end test")
)

(defun c:test1 (/ i val *error*)
  (defun *error* (msg)
    (print (getvar "cecolor"))
    (princ " < color on start *error*")
    (foreach v val (setvar (car v) (cdr v)))
    (print (getvar "cecolor"))
    (princ " < color after variavle reset using foreach *error*")
    (if	(and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
      (princ (strcat "\nError: " msg))
    )
    (vla-endundomark adoc)
    (print (getvar "cecolor"))
    (princ " < color after endundomar *error*")
  )
  (vl-load-com)
  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (print (getvar "cecolor"))
  (princ " < color on start test")
  (setq val (mapcar (function (lambda (v) (cons v (getvar v)))) '("clayer" "cecolor")))
  (setvar "cecolor" "1")
  (print (getvar "cecolor"))
  (princ " < color after cecolor 1")
  (setq i 1)
  (while (< i 5000000) (setq i (1+ i)))
  (setvar "cecolor" "2")
  (print (getvar "cecolor"))
  (princ " < color after cecolor 2 (while completed)")
  (*error* nil)
  (print (getvar "cecolor"))
  (princ " < color on end test")
)
__________________
Блог
Red Nova вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 12.01.2018, 20:38
#3440
Кулик Алексей aka kpblc
Moderator

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


Offtop: Я бы постарался вообще обойтись без применения командных методов в *error*. Как-то не доверяю я подобному подходу...
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума вставить имя Обратить внимание модератора на это сообщение  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу)

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

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

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
LISP. Вставка в таблицу поля, соотвествующего площади примитива Profan Готовые программы 261 04.05.2018 12:45
Сейсмозащита и сейсмоизоляция существующих, построенных зд. IANationalInformAgentstvo Прочее. Архитектура и строительство 216 20.01.2015 16:51
Мониторы LCD CRT Разное 94 17.06.2008 10:51
ЮМОР 2006 =) Perezz!! Разное 1122 04.01.2007 00:46

|| Главная || Каталог САПР || Тендеры || Публикации || Объявления || Биржа труда || Download || Галерея ||
|| Библиотека || Кунсткамера || Каталог предприятий || Контакты || Файлообменник || Блоги ||