[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

_____________________________________________________________________________________________________________

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

[Сергей812]

Сообщение от Setvar Сергей812, а ты разве Wolkodaw?

здесь общий форум)

[gnuvse]

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

Код:

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

 
; 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?

Спасибо за ваше время

[Сергей812]

vl-string-translate ?

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

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

[gnuvse]

Сообщение от Сергей812 vl-string-translate ?

Сообщение от Кулик Алексей aka kpblc Скорее уж vl-string-subst

Спасибо, что ответили, именно vl-string-subst, в тот же день нашел ответ на свой вопрос в справочнике Полещука.
Впредь буду туда заглядывать.

[Red Nova]

Доброго. Вопрос про обработку ошибок.
При нажатии esc в каком случае может выход из команды произойти не через *error* ?
Для моего кода если Vlide закрыт то при esc обработка ошибок не происходит, если Vlide открыт то при esc либо Vlide зависает либо после многократного нажатия esc вычисления останавливаются и приходится выходить через Debug - reset to top level.
Код обрабатывает очень длинные списки.

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

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

[Red Nova]

Попытаюсь вечером почистить код и привести пример.
_dwgru-catch-error кстати не нашел, но до error дело просто не доходит.

[Red Nova]

Вот более менее короткий пример и файл в котором следует тестировать.
После вызова test нужно задать 3 точки, очередность указана в файле.
Если по середине процесса нажать esc, то *error* не сработает.

[VVA]

Сообщение от Red Nova _dwgru-catch-error кстати не нашел, но до error дело просто не доходит

dwgru-error-catch - Как организовать досрочный выход из цикла?

[Red Nova]

Спасибо за ссылку.
Подскажите плиз как именно мне следует использовать 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*, а тут нет. Почему так?

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

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

----- добавлено через ~29 мин. -----
О, кстати! Обрати внимание на строку

Код:

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

 (progn (alert "Too narrow for a Bay") (*error*))

ничего странного не замечаешь? ))

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

[Red Nova]

Сообщение от Кулик Алексей 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 Еще момент - сделай блок безразмерным и тогда не надо будет мучаться с масштабами.

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

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

М-да... Тогда все мои переделки можно смело выбрасывать
В качестве пожеланий (и прошу не рассматривать ссылки как рекламу):

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

Я думаю, что тебе надо делать одновременно две задачи: ускорять вычисления и ускорять вставку. Для ускорения вычислений используй, например, ассоциативные списки и передачу параметров по ссылке, а не по значению. Для ускорения построений - я уже написал.

[Red Nova]

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

Не контролируется наличие слоя, на который надо помещать блоки Не контролируется - а есть ли в файле вообще такой блок Только 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).
С вариантами А и В все ясно. (В в такой постановке по сути и не достегаем)
Как быть с вариантом Б? Прошу привести решение.

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

Ну, как вариант (без проверок):

Код:

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

 (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

И ты так радостно готовишься к ошибке отмены, что аж оторопь берет

[Red Nova]

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"

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

Может быть, дело в настройках среды

[Red Nova]

Неа, у меня галочка не стоит.
На 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")
)

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

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