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

Red Nova · 20.07.2008, 20:12

Со школы не ладится у меня с программированием. Все предметы щелкал, а на экзамене по информатике (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 · 25.09.2008, 09:49

Дима_
Попробую разобраться.

(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) я не понемаю.

Дима_ · 25.09.2008, 10:15

погоди - parsing - это название функции которую надо сделать - про нее ни читать а делать надо.

Дима_ · 25.09.2008, 10:19

Короче подразумеваеться функция которая проверят все вышеперечисленные условия к параметру и в зависимости от результат возращает T или nil, ну а дальше применяешь ее к всему списку либо как я написал - либо по КРЫС'овски.

Red Nova · 25.09.2008, 10:27

Дима_
Можно полный пример, я так не пойму? Принцип ясен, а с исполнение туманно.
Вот функция от крыса, которая преобразует выноски в список. Прицепи к ней пожалуйста какой–нибудь фильтр из мною упомянутых.

Код:

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

(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

Дима_ · 25.09.2008, 10:48

Код:

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

(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 · 25.09.2008, 11:03

Дима_, функцию parsing можно сделать проще

Код:

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

(defun parsing (tmp)
  (not (member "" tmp))
)

Добавлено:
Хотя нет, что-то я немного не туда. Только сейчас заметил фразу "блок условий который надо расширять до твоих требований". У тебя всё глобальней.

Дима_ · 25.09.2008, 11:14

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

Red Nova · 25.09.2008, 12:09

Дима_
Вроде как начал понимать.

Функция (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 · 25.09.2008, 13:13

Значит так. Ставишь выноски со своими текстами (всеми, которые надо использовать в дальнейшем), получаешь с нее строки и результат на форум (код используй в #404. Хотя номер поста, конечно, вгоняет в дрожь

)

Red Nova · 25.09.2008, 13:56

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-го дойдем.

Дима_ · 25.09.2008, 14:04

С 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 · 25.09.2008, 14:12

Дима_
Не понял что ты имел в виду говоря

Цитата:

составляешь список (spisok) возможных начал и

Код:

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

(defun check3 (var lst / flag) 
(foreach tmp lst
(if (= var (substr tmp 1 (strlen var))) (setq flag T))
)
flag 
);end of check3

Какова связь между (spisok) и приведенным кодом?

Дима_ · 25.09.2008, 14:19

(setq spisok (list "Труба" "Тр." "Дверь")); список всех "правильных" начал
(check3 "Тр." spisok); верент T
(check3 "ПП." spisok); верент nil

Кулик Алексей aka kpblc · 25.09.2008, 14:36

> #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 · 25.09.2008, 16:10

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 · 25.09.2008, 16:24

Тогда надо образец. Я проверял на 12 выносках, работало вроде корректно...

Red Nova · 25.09.2008, 16:50

Пытался сделать как Дима_ говорит, лисп перестал работать.
Что я сделал не так? (последние изменения отмечены красным)

Код:

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

 (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 · 25.09.2008, 16:52

kpblc,
Вот образец

Red Nova · 25.09.2008, 17:26

Дима_
Попробую еще раз объяснить про пункт 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”
не подходят.

Дима_ · 25.09.2008, 22:05

Цитата:

Сообщение от 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...)

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

20.07.2008, 20:12
Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу) Red Nova ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ. Торонто Регистрация: 23.10.2007 Сообщений: 1,980 Со школы не ладится у меня с программированием. Все предметы щелкал, а на экзамене по информатике (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.
Просмотров: 1973530