Научите лиспу на примере (или как 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

_____________________________________________________________________________________________________________

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

Кулик Алексей aka kpblc · 25.09.2008, 22:58

Кто сказал, что нельзя объявлять вложенные функции? Где это сказано, ткни носом!
Живейший пример - локальное переопределение *error* - как собираешься делать без локальных функций?

Дима_ · 25.09.2008, 23:26

Да можно их объявлять - просто по моему 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 · 26.09.2008, 00:06

Red Nova, Дима_, простите, мужики, но мне бы со своим кодом разобраться...
Кстати, касательно #417: я в свое время пропустил объявление _dwgru-conv-pickset-to-list в качестве локальной переменной, хотя это и не очень хорошо (это что увидел "сразу").

CB · 26.09.2008, 10:19

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

Код:

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

(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

Дима_ · 26.09.2008, 10:28

Цитата:

Сообщение от 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 · 26.09.2008, 10:56

Дима_,

Цитата:

К моменту обращения к списку он еще не определен, перенеси (setq spisok ... в начало.

Верно. Щас попробую.

Цитата:

обще у тебя все функции объявляються внутри функции тест - не правильно это - не должно быть вложенных defun'ов:

Думаю это все же не принципиально, просто у нас так кусками пошло

Цитата:

Уточни могут ли быть двузначные номера - 10, 11 и.т.д.

Могут

Цитата:

и соответственно буквы только до 'g' и 'е' или возможно продолжение по алфавиту

Если я верно понял, ты имел в виду дойти только до 'е' или можно и продолжить алфавит. Если так то да. Можно до конца.

Цитата:

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

Можно и заглавные

Цитата:

Значки ' и " могут только последними находиться?

Верно подметил все. Только в конце.

CB, Спасибо за участие. Начало понял. А вот начиная с этой строчки - нет.

Цитата:

;|Фильтр по первому элементу подсписка сделан по условиям #419

Red Nova · 26.09.2008, 11:41

Дима_,
А теперь что не так ?

Код:

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

 (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

Дима_ · 26.09.2008, 12:47

Вобщем вот-так, добавлен 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 · 26.09.2008, 16:57

Дима_
Пока не заработало

Цитата:

Command: (test)

Select objects: Specify opposite corner: 32 found

Select objects:
nil

CB · 26.09.2008, 17:11

>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 · 26.09.2008, 18:01

CB,
Спасибо за объяснение. Очень подробно и понятно. Есть один вопрос.
Так получается что образец wcmatch работает только тогда, когда количество символов совпадает с количественным параметром образца. А что если мы напишем образцы для строк содержащих до 4-х символов, а в строке их пять?

Дима_ · 26.09.2008, 22:34

Цитата:

Сообщение от Red Nova

Дима_
Пока не заработало

Дай файлик (dwg) посмотрю.

Red Nova · 26.09.2008, 22:38

Файл примера dwg прикреплен на #418

Дима_ · 26.09.2008, 23:27

К сожалению нету СПДС-ки но:

Код:

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

Команда: (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 · 26.09.2008, 23:49

Попробую разобрать мой код из #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 · 27.09.2008, 11:02

Дима_
Укоротил список до минимума, не помогло.

Код:

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

(setq spisok (list "-" "Фл"))

Red Nova · 27.09.2008, 11:15

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\"" и что с этим делать?

Дима_ · 27.09.2008, 11:32

Цитата:

Сообщение от Red Nova

Кстати, не знаешь почему "1"" в списке становится "1\"" и что с этим делать?

А как ты тогда " в текст втавишь? Интерпритатор воспимет ее как закрывающию.

Дима_ · 27.09.2008, 11:37

Цитата:

Сообщение от Red Nova

Дима_
Укоротил список до минимума, не помогло.

Код:

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

(setq spisok (list "-" "Фл"))

Чудеса какие-то, проверь filtr на тестовом списке? Если работает, то посмотри в отлдчике что lst до него предствляет, наверняка какая-нибудь глупость типа lst в скобках два раза прописан, если сам ошибку найдешь это гораздо полезней, чем тебе ее покажут.

Red Nova · 27.09.2008, 12:17

Дима_

Цитата:

А как ты тогда " в текст втавишь? Интерпритатор воспимет ее как закрывающию.

Ну раз так, то и наш лисп в будущем при записи в текст должен изменять 1\" на 1".

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

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
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