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

_____________________________________________________________________________________________________________

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

Дима_ · 01.10.2008, 00:06

Что бы было понятней, что такое lambda вначале опишу что такое apply и mapcar:
apply Fn lst - применяет функцию Fn к списку lst, например:
(apply '+ '(1 2 3)) эквивалентно (+ 1 2 3) что вернет 6.
(mapcar Fn lst1 lst2 ... lstn) - применят функцию Fn к каждому элементу из каждого списка, ответ возращает в виде списка ответов, количество списков (lst1, lst2...) должно соответствовать количеству аргументов функции Fn, например:
(mapcar '+ (list 1 2 3) (list 10 20 30)) эквивалентно (list (+ 1 10) (+ 2 20) (+ 3 30)), что вернет (11 22 33).

Если мы, в качестве функции Fn хотим использовать какую-либо свою функцию, то мы должны либо предварительно создать ее используя (defun), но тогда нам придеться придумывать ей имя, либо использовать (lambda), синтаксис точно такой-же как у (defun) только без имени - а с defun'ом мы вроде уже разбирались. Пример:
(mapcar '(lambda (a b c) (- (+ a b) c)) (list 1 2 3) (list 10 20 30) (list 4 5 6))
эквивалентно (list (- (+ 1 10) 4) (- (+ 2 20) 5) (- (+ 3 30) 6)),
что вернет (7 17 27)

Кулик Алексей aka kpblc · 01.10.2008, 00:10

"Первоклассник" уже понимает mapcar?

---
Опа, пока я чесал репу, тут уже практически все рассказали

CB · 01.10.2008, 08:52

>Дима_

Цитата:

apply Fn lst - применяет функцию Fn к списку lst, например:

Небольшое, но на мой взгляд существенное уточнение:
(apply Fn lst) - выполняется функция Fn, аргументы которой заданы списком. Например классика:
(apply 'mapcar (cons 'list '((1 2) (10 20)))) -> ((1 10) (2 20))
Что здесь lst - (cons 'list '((1 2) (10 20))) -> (LIST (1 2) (10 20))
В этом списке первый элемент, зто аргумент функция для (mapcar функция lst1 lst2...), следующие - это аргументы lst1, lst2 для нее же.

Red Nova · 01.10.2008, 11:35

Спасибо, вроде как понял.
Значит это
(setq lst (mapcar '(lambda(x)(list (car x)(cadr x))) lst))
можно понять, как:
к каждому элементу списка lst применить функцию создающую список из первых двух элементов первоначального списка.

Кулик Алексей aka kpblc · 01.10.2008, 12:22

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

Red Nova · 01.10.2008, 13:36

Не у кого идей по #497 нет?

Кулик Алексей aka kpblc · 01.10.2008, 13:49

Пока нет. Лично у меня не получилось абсолютно корректно сформировать список вида '("1" "1'" "1''" "2" "2a" "2A" "3" "4b" "10a" "A1" "A3" "A10" "A21"). Проблема (пока) именно в последних 4 элементах.

Кулик Алексей aka kpblc · 01.10.2008, 13:58

Хотя нет, лови:

Код:

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

(setq lst-sort '("10a" "1" "A21" "2B" "1'" "A3" "1''" "2" "2a" "2A" "3" "4b"
                 "A1" "A10")
      ) ;_ end of setq

(defun fun_sort-list-string (lst / lst_int lst_sym)
  (setq lst_int (vl-sort
                  (vl-remove-if
                    (function
                      (lambda (x)
                        (= (atoi x) 0)
                        ) ;_ end of lambda
                      ) ;_ end of function
                    lst
                    ) ;_ end of vl-remove-if
                  (function (lambda (a b) (< (atoi a) (atoi b))))
                  ) ;_ end of vl-sort
        lst_sym (vl-sort
                  (vl-remove-if-not
                    (function
                      (lambda (x)
                        (= (atoi x) 0)
                        ) ;_ end of lambda
                      ) ;_ end of function
                    lst
                    ) ;_ end of vl-remove-if-not
                  (function
                    (lambda (a b / tmp_a tmp_b)
                      (apply
                        (function <)
                        (mapcar
                          (function
                            (lambda (c)
                              (atoi (vl-list->string
                                      (vl-remove-if-not
                                        (function
                                          (lambda (x)
                                            (<= 48 x 57)
                                            ) ;_ end of lambda
                                          ) ;_ end of function
                                        (vl-string->list c)
                                        ) ;_ end of vl-remove-if-not
                                      ) ;_ end of vl-list->string
                                    ) ;_ end of atoi
                              ) ;_ end of lambda
                            ) ;_ end of function
                          (list a b)
                          ) ;_ end of mapcar
                        ) ;_ end of apply
                      ) ;_ end of lambda
                    ) ;_ end of function
                  ) ;_ end of vl-sort
        ) ;_ end of setq
  (append lst_int lst_sym)
  ) ;_ end of defun

;;; (fun_sort-list-string lst-sort)
;;; '("1" "1'" "1''" "2B" "2" "2a" "2A" "3" "4b" "10a" "A1" "A3" "A10" "A21")

Red Nova · 01.10.2008, 14:56

kpblc, Спасибо. Эту функцию можно применить, когда имеем обычный список. А как ее использовать в нашем случае, когда список парный?

Кулик Алексей aka kpblc · 01.10.2008, 15:46

В качестве параметров в анонимные функции попадают тогда не строки, а списки. Обработка не меняется, просто подставляются первые элементы списка.
P.S. Тут задумался - может, кто более быстрый алгоритм предложит да в библиотеку такую функцию сортировки строкового списка закинет?

Red Nova · 01.10.2008, 16:04

Если я верно понял, то можно добавить этот код в таком виде в наш лисп. Я попробовал, но пока не работает.

Код:

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

(vl-load-com)
(defun parsing (tmp)
(and
(= (length tmp) 2); длина списка равна 2
(/= (car tmp) ""); Первый элемент не равен ""
(/= (cadr tmp) ""); то же со вторым
(check2 (car tmp)); проверка второго условия к первой строке
(check3 (cadr tmp) spisok); проверка первых символов второй строки
);блок условий который надо расширять до твоих требований
);end of parsing


(defun filtr (lst / newlst)
(foreach tmp lst
(if (parsing tmp)
  (setq newlst
         (append newlst
           (list
             (mapcar 'prep-str tmp)))
    )
  )
);end of foreach
(while-remove-lst newlst)
);end filtr

;;;Подготавливает строки
;;; Условия B1 и B2

;(PREP-STR  "21\\U+E712 12 AIII Швеллер 12, L=1000, шаг 1000")
(defun prep-str (str / tmp)
  ;;;Удаление всего после 2-й запятой условие B.1
  (setq tmp (reverse(str-str-lst str ",")))
  (while (> (length tmp) 2)
    (setq tmp(cdr tmp))
    )
  (setq str(substr (apply 'strcat (mapcar '(lambda(x)(strcat "," x))(reverse tmp))) 2))
  ;;;Удаление всего до знака диаметр
  (if (or (wcmatch str "# %%c*,#%%c*,#\\U+E712*,# \\U+E712*")
          (wcmatch str "## %%c*,##%%c*,##\\U+E712*,## \\U+E712*")
          )
    (while (wcmatch (substr str 1 1) "#, ")(setq str (substr str 2)))
    )
    str
  )
(defun check2 (tmp / i str); возращает T либо nil в зависимости от соответствия 2-му условию
(setq i 1 str tmp)
(if (or (= (substr str (strlen str)) "'") (= (substr str (strlen str)) "\"")); если последний ' или "
(setq str (substr str 1 (1- (strlen str))))); убирает последний символ
(repeat (strlen str)
(if (and (>= (substr str i 1) "0") (<= (substr str i 1) "9")); проверка цифра ли это?
(setq str (strcat (substr str 1 (1- i)) (substr str (1+ i)))); если да то убираем ее из str
(setq i (1+ i)); переход к следующими символу, если не было вычитания
);end of if
);end of repeat
; таким образом мы убрали из str все цифры и символы на конце 'и"
(<= (strlen str) 1); остался только 1 символ или меньше?
);end of check2

(defun check3 (var lst / flag) 
(foreach tmp lst
(if (= tmp (substr var 1 (strlen tmp))) (setq flag T))
)
flag 
);end of check3
  (defun _dwgru-conv-pickset-to-list (value / tab item)
    (repeat (setq tab  nil
                  item (sslength value)
                  ) ;_ end setq
      (setq tab (cons (ssname value (setq item (1- item))) tab))
      ) ;_ end repeat
    ) ;_ end defun

;;;Удаление дублирубших элементов
(defun while-remove-lst (lst / temp)
  (while lst
    (setq temp (cons (car lst) temp))
    (setq lst (vl-remove (car lst) (cdr lst)))
  ) ;_ end of while
  (reverse temp)
) ;_ end of defun
;|
* Ф-ция str-str-lst
* Сервисная ф-ция извлечения из строки данных, разделенных
* каким либо символом или строкой символов
* Возвращает список строк
* Аргументы [Type]:
  str - строка для разбора [STRING]
  pat - разделитель [STRING]
*  Пример запуска
  (setq str "мы;изучаем;рекурсии" pat ";")
  (setq str "мы — изучаем — рекурсии" pat " — ")
  (str-str-lst str pat)
* Читать подробнее http://www.autocad.ru/cgi-bin/f1/board.cgi?t=25113OT
|;
(defun str-str-lst (str pat / i)
  (cond ((= str "") nil)
        ((setq i (vl-string-search pat str))
         (cons (substr str 1 i)
               (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)
         ) ;_  cons
        )
        (t (list str))
  ) ;_  cond
) ;_  defun



(defun fun_sort-list-string (lst / lst_int lst_sym) ; Cортировка по порядку  ("1" "1'" "1''" "2B" "2" "2a" "2A" "3" "4b" "10a" "A1" "A3" "A10" "A21")
  (setq lst_int (vl-sort
                  (vl-remove-if
                    (function
                      (lambda (x)
                        (= (atoi x) 0)
                        ) ;_ end of lambda
                      ) ;_ end of function
                    lst
                    ) ;_ end of vl-remove-if
                  (function (lambda (a b) (< (atoi a) (atoi b))))
                  ) ;_ end of vl-sort
        lst_sym (vl-sort
                  (vl-remove-if-not
                    (function
                      (lambda (x)
                        (= (atoi x) 0)
                        ) ;_ end of lambda
                      ) ;_ end of function
                    lst
                    ) ;_ end of vl-remove-if-not
                  (function
                    (lambda (a b / tmp_a tmp_b)
                      (apply
                        (function <)
                        (mapcar
                          (function
                            (lambda (c)
                              (atoi (vl-list->string
                                      (vl-remove-if-not
                                        (function
                                          (lambda (x)
                                            (<= 48 x 57)
                                            ) ;_ end of lambda
                                          ) ;_ end of function
                                        (vl-string->list c)
                                        ) ;_ end of vl-remove-if-not
                                      ) ;_ end of vl-list->string
                                    ) ;_ end of atoi
                              ) ;_ end of lambda
                            ) ;_ end of function
                          (list a b)
                          ) ;_ end of mapcar
                        ) ;_ end of apply
                      ) ;_ end of lambda
                    ) ;_ end of function
                  ) ;_ end of vl-sort
        ) ;_ end of setq
  (append lst_int lst_sym)
  ) ;_ end of defun


(defun test (/ selset lst)
                                      ;|
*    Возвращает список строк выделенных выносок. В набор попадают узловые выноски,
* позиционные выноски, цепные и гребенчатые.
*    Параметры вызова:
	нет
*    Примеры вызова:
(_dwgru-get-spds-text)
	;
|;
  (if
    (and
      (= (type (setq selset (vl-catch-all-apply
                              (function (lambda () (ssget)))
                              ) ;_ end of vl-catch-all-apply
                     ) ;_ end of setq
               ) ;_ end of type
         'pickset
         ) ;_ end of =
      (setq selset
             (vl-remove-if-not
               (function
                 (lambda (x)
                   (member (cdr (assoc 0 x))
                           '("spdsNotePosition"
                             ;"spdsNoteKnot" 
                             "spdsNoteComb"
                             "spdsNoteChain"
                             )
                           ) ;_ end of member
                   ) ;_ end of lambda
                 ) ;_ end of function
               (mapcar
                 (function (lambda (a)
                             (vl-remove-if-not
                               '(lambda (b) (member (car b) '(0 300 301 90)))
                               (entget a)
                               ) ;_ end of vl-remove-if-not
                             ) ;_ end of lambda
                           ) ;_ end of function
                 (_dwgru-conv-pickset-to-list selset)
                 ) ;_ end of mapcar
               ) ;_ end of vl-remove-if-not
            ) ;_ end of setq
      ) ;_ end of and
     (setq
       lst
        (mapcar
          (function
            (lambda (item)
              (cond
                ((= (cdr (assoc 0 item)) "spdsNoteKnot")
                 (append (mapcar
                           (function cdr)
                           (vl-remove-if-not
                             (function
                               (lambda (x)
                                 (= (car x) 300)
                                 ) ;_ end of lambda
                               ) ;_ end of function
                             (reverse
                               (member '(301 . "Выравнивание текста")
                                       (reverse (member '(301 . "Номер узла") item))
                                       ) ;_ end of member
                               ) ;_ end of reverse
                             ) ;_ end of vl-remove-if-not
                           ) ;_ end of mapcar
                         (list 1)
                         ) ;_ end of append
                 )
                ((= (cdr (assoc 0 item)) "spdsNotePosition")
                 (append (mapcar
                           (function cdr)
                           (vl-remove-if-not
                             (function
                               (lambda (x)
                                 (= (car x) 300)
                                 ) ;_ end of lambda
                               ) ;_ end of function
                             (member '(301 . "Первая строка") item)
                             ) ;_ end of vl-remove-if-not
                           ) ;_ end of mapcar
                         (list 1)
                         ) ;_ end of append
                 )
                ((member (cdr (assoc 0 item))
                         '("spdsNoteComb" "spdsNoteChain")
                         ) ;_ end of member
                 (append
                   (mapcar
                     (function cdr)
                     (vl-remove-if-not
                       (function
                         (lambda (x)
                           (= (car x) 300)
                           ) ;_ end of lambda
                         ) ;_ end of function
                       (reverse
                         (member '(301 . "Выравнивание текста")
                                 (reverse (member '(301 . "Первая строка") item))
                                 ) ;_ end of member
                         ) ;_ end of reverse
                       ) ;_ end of vl-remove-if-not
                     ) ;_ end of mapcar
                   (list (cdr (assoc 90 (reverse item))))
                   ) ;_ end of cons
                 )
                ) ;_ end of cond
              ) ;_ end of lambda
            ) ;_ end of function
          selset
          ) ;_ end of mapcar
       ) ;_ end of setq
     ) ;_ end of if

  (setq spisok (list "-" "Фл." "Фл." "Фланец" "Лист" "Полоса" "\\U+E72E" "Тр" "\\U+E720" "Уголок" "\\U+E729" "Двутавр" "\\U+E725" "Швеллер" 
"%%c" "\\U+E712" "2%%c" "3%%c" "4%%c" "5%%c" "6%%c" "7%%c" "8%%c" "9%%c" "10%%c" "11%%c" "12%%c" "13%%c" "14%%c" "15%%c" "16%%c" "17%%c" "18%%c" "19%%c" "20%%c" 
 "2 %%c" "3 %%c" "4 %%c" "5 %%c" "6 %%c" "7 %%c" "8 %%c" "9 %%c" "10 %%c" "11 %%c" "12 %%c" "13 %%c" "14 %%c" "15 %%c" "16 %%c" "17 %%c" "18 %%c" "19 %%c" "20 %%c" 
"2\\U+E712" "3\\U+E712" "4\\U+E712" "5\\U+E712" "6\\U+E712" "7\\U+E712" "8\\U+E712" "9\\U+E712" "10\\U+E712" "11\\U+E712" "12\\U+E712" "13\\U+E712" "14\\U+E712" "15\\U+E712" "16\\U+E712" "17\\U+E712" "18\\U+E712" "19\\U+E712" "20\\U+E712"  
"2 \\U+E712" "3 \\U+E712" "4 \\U+E712" "5 \\U+E712" "6 \\U+E712" "7 \\U+E712" "8 \\U+E712" "9 \\U+E712" "10 \\U+E712" "11 \\U+E712" "12 \\U+E712" "13 \\U+E712" "14 \\U+E712" "15 \\U+E712" "16 \\U+E712" "17 \\U+E712" "18 \\U+E712" "19 \\U+E712" "20 \\U+E712"))

(setq lst (mapcar '(lambda(x)
                     (vl-remove-if-not '(lambda(y)(= (type y) 'STR)) x)
                    )
                  lst
           );_ end of mapcar
  );_ end of setq

(setq lst (filtr lst))
(fun_sort-list-string lst)

  ) ;_ end of defun

CB · 01.10.2008, 22:26

>Red Nova
По скорости, с которой ты выдаешь ТЗ на лисп, Benchmark наверняка бы поставил тебя на первое место.

Не успеешь сделать одно, уже новое задание, сделаешь его - опять новое...
Во всяком случае протестируй пока новый лисп, в котором пока нет окончательной сортировки (над ней стоит еще подумать...)

Код:

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

(defun CB-test (/ CB-filtr lst)
  (defun CB-filtr (lst)
    (vl-remove-if
      '(lambda (x)
  (or
    (not (equal (length x) 2))
    (member "" x)
    (not
      (wcmatch
        (cadr x)
        "\\U+E72E*,Труба*,Тр.*,Лист*,Полоса*,\\U+E720*,Уголок*,\\U+E725*,Швеллер*,\\U+E729*,Двутавр*,Фланец*,Фл.*,-*,%%c*,\\U+E712*,#%%c*,# %%c*,##%%c*,## %%c*,#\\U+E712*,# \\U+E712*,##\\U+E712*,## \\U+E712*"
      ) ;_ end of wcmatch
    ) ;_ end of not
    (not
      (apply
        'and
        ((lambda (str-lst n a)
    (mapcar '(lambda (y)
        (if (<= (setq n (1- n)) a)
          (wcmatch y "[A-Za-zА-Яа-я0-9'\"]")
          (wcmatch y "#")
        ) ;_ end of if
      ) ;_ end of lambda
     str-lst
    ) ;_ end of mapcar
  ) ;_ end of lambda
   (mapcar 'chr (vl-string->list (car x)))
   (strlen (car x))
   (if
     (or (wcmatch (car x) "*'") (wcmatch (car x) "*\""))
      1
      0
   ) ;_ end of if
        )
      ) ;_ end of apply
    ) ;_ end of not
  ) ;_ end of or
       ) ;_ end of lambda
      ((lambda (lst / poz temp)
;;;Создает список позиций pat в str
;;;(reverse (poz "123,456,7 89,0" ",")) -> (3 7 12)
  (defun poz (str pat / p n)
    (while (setq n (vl-string-search pat str n))
      (setq p (cons n p)
     n (1+ n)
      ) ;_ end of setq
    ) ;_ end of while
    p
  ) ;_ end of defun
  (while lst
    (setq
      temp
       (cons
  ((lambda (lst-temp / n)
     (list
       (car lst-temp)
       (vl-string-left-trim
         "1234567890 "
         (if
    (equal
      (length (setq n (poz (cadr lst-temp) ",")))
      2
    ) ;_ end of equal
     (substr (cadr lst-temp)
      1
      (car n)
     ) ;_ end of substr
     (cadr lst-temp)
         ) ;_ end of if
       ) ;_ end of vl-string-left-trim
     ) ;_ end of list
   ) ;_ end of lambda
    (car
      (vl-sort
        (vl-remove-if-not
   '(lambda (x) (equal (caar lst) (car x)))
   lst
        ) ;_ end of vl-remove-if-not
        '(lambda (str1 str2)
    (> (length (poz (cadr str1) ","))
       (length (poz (cadr str2) ","))
    ) ;_ end of >
         ) ;_ end of lambda
      ) ;_ end of vl-sort
    ) ;_ end of car
  )
  temp
       ) ;_ end of cons
    ) ;_ end of setq
    (setq lst
    (vl-remove-if '(lambda (x) (equal (caar lst) (car x))) lst)
    ) ;_ end of setq
    (reverse temp)
  ) ;_ end of while
       ) ;_ end of lambda
 lst
      )
    ) ;_ end of vl-remove
  ) ;_ end of defun
  (setq lst
  (mapcar '(lambda (x) (list (car x) (cadr x)))
   (_dwgru-get-spds-text-and-range);из #472 
  ) ;_ end of mapcar
  ) ;_ end of setq
  (CB-filtr lst)
) ;_ end of defun

CB · 01.10.2008, 22:42

>Кулик Алексей aka kpblc
Как ты делаешь, что у тебя здесь сохраняется форматирование, сделанное в vlide?

Кулик Алексей aka kpblc · 01.10.2008, 22:53

CB, возможно, дело в настройках самой VLIDE:

Supermax · 01.10.2008, 23:24

Извиняюсь, а чего это в результатах сортировки 2В перед 2 стоит?
Должно ведь быть 2, 2а, 2А, 2В? Что-то не так сортирует.

Red Nova · 01.10.2008, 23:47

CB, Спасибо. Правда фильтрует и некоторую полезную информацию. Прикрепляю файл, в котором показано что фильтруется неверно. Зато ты добавил алгоритм удаления подобных позиций. Можно вставить его в код с #494, там все остальное работает нормально.?

Цитата:

По скорости, с которой ты выдаешь ТЗ на лисп, Benchmark наверняка бы поставил тебя на первое место.

Есть такой грех

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

ALL
На данный момент есть три кода, которые хотелось бы объединить в один.
1. Совместный код с #494. Там все работает нормально, не хватает фильтра удаления подобных позиций и функции упорядочивания.
2. Код для упорядочивания списку от Крыса на #508.
3. Код от СВ c #512, который работает не совсем верно, но содержит фильтр удаления подобных позиций.

Возможно взять код с #494 и добавить в него Код для упорядочивания списка с #508 и фильтр подобных позиций c #512? Я сам пытался скрестить код с #494 и с #508. Пока не выходит.

Supermax, Верно подметил.

CB · 02.10.2008, 09:20

>Red Nova #516
В принципе все ясно. Синий текст нужно сделать в одну строчку:
Имеется:

Код:

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

(wcmatch
  (setq a (cdr (assoc 1 (entget (car (entsel))))))
  "\\U+E72E*,Труба*,Тр.*,Лист*,Полоса*,\\U+E720*,Уголок*,\\U+E725*,Швеллер*,\\U+E729*,Двутавр*,Фланец*,Фл.*,
-*,%%c*,\\U+E712*,#%%c*,# %%c*,##%%c*,## %%c*,#\\U+E712*,# \\U+E712*,##\\U+E712*,## \\U+E712*"
) ;_ endwcmatch

Должно быть:

Код:

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

(wcmatch
  (setq a (cdr (assoc 1 (entget (car (entsel))))))
  "\\U+E72E*,Труба*,Тр.*,Лист*,Полоса*,\\U+E720*,Уголок*,\\U+E725*,Швеллер*,\\U+E729*,Двутавр*,Фланец*,Фл.*,-*,%%c*,\\U+E712*,#%%c*,# %%c*,##%%c*,## %%c*,#\\U+E712*,# \\U+E712*,##\\U+E712*,## \\U+E712*"
) ;_ endwcmatch

Исправил в #512

VVA · 02.10.2008, 10:58

Цитата:

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

P.S. Тут задумался - может, кто более быстрый алгоритм предложит да в библиотеку такую функцию сортировки строкового списка закинет?

В свое время здесь (Search of Windows type Sort function ) разработал еще один вариант функции сортировки строковых списков, в которых числа должны сортироваться как числа (т.е. 8 раньше 11). Я ее давно использую. Благодаря CAB'у и Евгению Елпанову она обрела окончательный (?) вид.

Код:

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

;;Published http://www.theswamp.org/index.php?topic=16564.0
;;By VVA --  05.20.07 mods by CAB
;;Usage (SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05") nil)
;;With ignore case (SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05") t)
;;  CAB added Ignore Case Flag as an argument
;;Return ("A1" "A9" "A10" "B2" "B05" "B11")
;;;ListOfString - список строк
;;; IgnoreCase - t (игнорировать) или nil (нет) регистр символов
(defun SortStringWithNumberAsNumber (ListOfString IgnoreCase / NorStrs count)
;;;Function Normalize (add 0 befor number) number in string
;;; Count normalize symbols set in variable count
;;; CAB added count as an argument
  (defun NormalizeNumberInString (str count / ch i pat ret buf)
    (setq i   0
          pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
          ret ""
    ) ;_ end of setq
    (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
      (if (vl-position ch pat)
        (progn
          (setq buf ch) ;_ end of setq
          (while
            (vl-position (setq ch (substr str (setq i (1+ i)) 1)) pat)
             (setq buf (strcat buf ch))
          ) ;_ end of while
          (while (< (strlen buf) count) (setq buf (strcat "0" buf)))
          (setq ret (strcat ret buf))
        ) ;_ end of progn
      ) ;_ end of if
      (setq ret (strcat ret ch))
    ) ;_ end of while
    ret
  ) ;_ end of defun
  ;;-------------------------------------------------
  ;;  function to Count the longest number in string 
  ;;  CAB added to get the correct COUNT
  (defun getcount (lst / count pat)
    (setq count 0)
    (setq pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
    (mapcar
      '(lambda (str / i maxlen ch)
         (setq i 0 maxlen 0)
         (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
           (if (vl-position ch pat) ; number
             (setq maxlen (1+ maxlen))
             (setq count  (max count maxlen) maxlen 0)
           )
         )
	 (setq count  (max count maxlen)) ;_<<< ADD 21.06.2007 by 
       )
      Lst
    )
    count
  )
  ;;===============================================
  (setq count   (GetCount ListOfString)
        NorStrs (mapcar '(lambda (x) (NormalizeNumberInString x count))
                        ListOfString)
  )
  (and IgnoreCase (setq NorStrs (mapcar 'strcase NorStrs)))
  (mapcar '(lambda (x) (nth x ListOfString)) (vl-sort-i NorStrs '<))
)

Кстати она корректнее сортирует списки

Код:

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

(setq lst-sort '("A9" "A1" "A10" "B11" "B2" "B05"))
(fun_sort-list-string lst-sort) ;_("A1" "B2" "B05" "A9" "A10" "B11") 
(SortStringWithNumberAsNumber lst-sort t) ;_("A1" "A9" "A10" "B2" "B05" "B11")

Red Nova · 02.10.2008, 14:53

CB,
Пока не корректно работает.
Если к примеру имею выноски с содержанием
("3" "Фл. 300х8") ("3" "Фланец 300х8")
то отфильтровывается верно
("3" "Фланец 300х8")
Но если имеем
("3" "Фл. 300х8") ("3" "Фланец 300х8") ("3" "дверь")
То возвращяет nil.

VVA, Код с #518 пойдет для нашего лиспа? Может его как-то надо адаптировать к парному списку?

VVA · 02.10.2008, 15:53

Цитата:

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

CB,
VVA, Код с #518 пойдет для нашего лиспа? Может его как-то надо адаптировать к парному списку?

Адаптировать нет необходимости. Заодно mapcar и lambda проанализируй

Код:

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

;;;Список
(setq lst '(("2" "Швеллер") ("2a" "Двутавр")("1" "Полоса")("1'" "Полоска")("2b" "Уголок")))
;;;Список-шаблон
(setq tmp (SortStringWithNumberAsNumber (mapcar 'car lst) t))
(setq lst (mapcar '(lambda(x)(assoc x lst)) tmp)) ;_(("1" "Полоса") ("1'" "Полоска") ("2" "Швеллер") ("2a" "Двутавр") ("2b" "Уголок"))

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.
Просмотров: 2049357

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