Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу) - Страница 27
| Правила | Регистрация | Пользователи | Сообщения за день |  Справка по форуму | Файлообменник |

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

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

Ответ
Поиск в этой теме
Старый 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.
Просмотров: 2049419
 
Автор темы   Старый 02.10.2008, 18:01
#521
Red Nova

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


Пока СВ размышляет над исправлением #512 хочу напомнить остальным про мою просьбу написать фильтр подобных позиций.

Допустим имеем такой список.
Код:
[Выделить все]
(("2" "Швеллер 12, L=1000") ("2" " 12, L=1000") ("2" "Швеллер 12") ("2" " 12"))
Все подсписки имеют ту же позицию, а это значит, что необходимо оставить только один из этих элементов. Для этого нужно.
А. Проверить есть ли в одном из списков запятая. Если есть, то надо удалить все, которые запятой не содержат, если ни один элемент не содержит запятых, то ничего не удаляем. На данном этапе получим
Код:
[Выделить все]
(("2" "Швеллер 12, L=1000") ("2" " 12, L=1000"))
Б. Проверяем который из списков самый длинный, и оставляем его, а все оставшиеся удаляем. Если длина равна, то удаляем на угад.
Получим
Код:
[Выделить все]
(("2" "Швеллер 12, L=1000"))
__________________
Блог
Red Nova вне форума  
 
Старый 02.10.2008, 18:05
#522
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


А чего там размышлять, пробуй:
Код:
[Выделить все]
(defun CB-test (/ CB-filtr lst)
  (defun CB-filtr (lst)
    (setq 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
      lst
    ) ;_ end of vl-remove-if
    ) ;_ end of setq
    (setq lst
    ((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 setq
  ) ;_ 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 вне форума  
 
Автор темы   Старый 02.10.2008, 19:41
#523
Red Nova

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


CB,
Спасибо. То о чем я говорил исправленно, но заметил, что при испытании не вошли в список следующие выноски
("а1" "-10х100х200")
("а2" "-10х100х300")
__________________
Блог
Red Nova вне форума  
 
Старый 03.10.2008, 13:13
#524
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


Надеюсь теперь все нормально:
Код:
[Выделить все]
(defun CB-test (/ CB-filtr lst)
  (defun CB-filtr (lst)
    (setq 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
                    ((lambda (f str)
                       (or
                         (wcmatch str "@,#")
                         (and (wcmatch str "@*") (f (substr str 2)))
                         (and (wcmatch str "*@,*#")
                              (f (substr str 1 (1- (strlen str))))
                         ) ;_ end of and
                       ) ;_ end of or
                     ) ;_ end of lambda
                      (lambda (str)
                        (apply 'and
                               (mapcar
                                 '(lambda (el)
                                    (wcmatch el "#")
                                  ) ;_ end of lambda
                                 (mapcar 'chr
                                         (vl-string->list str)
                                 ) ;_ end of mapcar
                               ) ;_ end of mapcar
                        ) ;_ end of apply
                      ) ;_ end of lambda
                      (if (or (wcmatch (car x) "*'") (wcmatch (car x) "*\""))
                        (substr (car x) 1 (1- (strlen (car x))))
                        (car x)
                      ) ;_ end of if
                    )
                  ) ;_ end of not
                ) ;_ end of or
              ) ;_ end of lambda
             lst
           ) ;_ end of vl-remove-if
    ) ;_ end of setq
    (setq lst
           ((lambda (lst / poz temp)
              (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 setq
  ) ;_ 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 вне форума  
 
Автор темы   Старый 03.10.2008, 16:14
#525
Red Nova

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


CB, Спасибо. Теперь заработало. Правда я тебя не собираюсь оставлять в покое.
Соеденив твой код с сортирующим кодом от VVA я получил
Код:
[Выделить все]
;;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 '<))
)





(defun CB-test (/ CB-filtr lst)
  (defun CB-filtr (lst)
    (setq 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
                    ((lambda (f str)
                       (or
                         (wcmatch str "@,#")
                         (and (wcmatch str "@*") (f (substr str 2)))
                         (and (wcmatch str "*@,*#")
                              (f (substr str 1 (1- (strlen str))))
                         ) ;_ end of and
                       ) ;_ end of or
                     ) ;_ end of lambda
                      (lambda (str)
                        (apply 'and
                               (mapcar
                                 '(lambda (el)
                                    (wcmatch el "#")
                                  ) ;_ end of lambda
                                 (mapcar 'chr
                                         (vl-string->list str)
                                 ) ;_ end of mapcar
                               ) ;_ end of mapcar
                        ) ;_ end of apply
                      ) ;_ end of lambda
                      (if (or (wcmatch (car x) "*'") (wcmatch (car x) "*\""))
                        (substr (car x) 1 (1- (strlen (car x))))
                        (car x)
                      ) ;_ end of if
                    )
                  ) ;_ end of not
                ) ;_ end of or
              ) ;_ end of lambda
             lst
           ) ;_ end of vl-remove-if
    ) ;_ end of setq
    (setq lst
           ((lambda (lst / poz temp)
              (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 setq
  ) ;_ 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)


(setq tmp (SortStringWithNumberAsNumber (mapcar 'car lst) t)) 
(setq lst (mapcar '(lambda(x)(assoc x lst)) tmp))


) ;_ end of defun
VVA При упорядочивании возникла одна проблема. Поскольку "1"" в списках записывается как "1\"", то при сортировке он попадает не после "1’" а до.

Теперь очередная просьба:
1. Во первых я кое о чем забыл. В самом начале фильтрации списка нужно удалить первые и последние пробелы элементов подсписка, если таковые есть, на пример ("1 " " -10х100x100"), тут после позиции и до знака – есть такие пробелы. Часто бывает поставишь лишний пробел, а он потом не виден. Не хотелось бы из за этого терять некоторые позиции. Удаление лишних пробелов нам понадобится еще раз, но чуть позже.
2. Следующим шагом я наметил раздел списка на три части. Напомню что вторая строка некоторых позиций содержит запятую.
На пример
("7" "-4х50, L=1000")
А некоторые позиции запятой не содержат вовсе.
Нужно определить содержит ли вторая строка запятую, если да, то надо взять все то что идет после запятой, и записать в новый, третий элемент подсписка. Если вторая строка не содержит запятых, то нужно записать в новый, третий элемент подсписка знак –
Пример. Имеем.
(("7" "-4х50х1000") ("8" "Уголок 50х5, L=1000"))
Получим
(("7" "-4х50х1000" "-") ("8" "Уголок 50х5" " L=1000"))
3. К полученному тройному списку опять применяем функцию удаление лишних пробелов.
__________________
Блог
Red Nova вне форума  
 
Старый 03.10.2008, 17:22
#526
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,996


Цитата:
VVA При упорядочивании возникла одна проблема. Поскольку "1"" в списках записывается как "1\"", то при сортировке он попадает не после "1’" а до.
Символ " (ASCII код 34) в кодовой таблице он находится раньше чем ' (ASCII код 34). Соответственно и при сортировке ставится будет на 1-е место.
Выход:
1.Не использовать " (заменить, например, буквами)
2. Вместо " использовать '' (два символа ')

По п.1
Этот фрагмент
Код:
[Выделить все]
 (setq lst
         (mapcar '(lambda (x) (list (car x) (cadr x)))
                 (_dwgru-get-spds-text-and-range) ; из #472 
         ) ;_ end of mapcar
  ) ;_ end of setq
Замени этим
Код:
[Выделить все]
 (setq lst
         (mapcar '(lambda (x) (list (vl-string-trim " \t\n" (car x))
				    (vl-string-trim " \t\n"(cadr x))
				    )
		    )
                 (_dwgru-get-spds-text-and-range) ; из #472 
         ) ;_ end of mapcar
  ) ;_ end of setq
*** Добавлено
По п.2,3
Дополнительны ф-ции
Код:
[Выделить все]
;;;Сервисные ф-ции
;|
* Ф-ция 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 red-trim (str)(vl-string-trim " \t\n" str))
Реализация
Код:
[Выделить все]
(setq lst '(("7" "-4х50х1000")
	    ("8" "Уголок 50х5, L=1000")
	    ("7" "Уголок 60х5")
	   )
) ;_ end of setq
(setq lst
       (mapcar
	 '(lambda (y)
	    (setq y (mapcar 'red-trim y))
	    (if	(nth 2 y)
	      y
	      (progn
		(if (wcmatch (nth 1 y) "-*,Лист*,Фл*")
		  (append y '("-"))
		  (append y '("L="))
		) ;_ end of if
	      ) ;_ end of progn
	    ) ;_ end of if
	  ) ;_ end of lambda
	 (mapcar '(lambda (x) (cons (car x) (str-str-lst (cadr x) ",")))
		 lst
	 ) ;_ end of mapcar
       ) ;_ end of mapcar
) ;_ end of setq
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 04.10.2008 в 19:46. Причина: Изменение аглоритма
VVA вне форума  
 
Автор темы   Старый 03.10.2008, 20:13
#527
Red Nova

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


VVA, Спасибо. Сделал так как ты говоришь.
Код получился такой
Код:
[Выделить все]
;;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 '<))
)


* Ф-ция 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 red-trim (str)(vl-string-trim " \t\n" str))







(defun CB-test (/ CB-filtr lst)
  (defun CB-filtr (lst)
    (setq 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
                    ((lambda (f str)
                       (or
                         (wcmatch str "@,#")
                         (and (wcmatch str "@*") (f (substr str 2)))
                         (and (wcmatch str "*@,*#")
                              (f (substr str 1 (1- (strlen str))))
                         ) ;_ end of and
                       ) ;_ end of or
                     ) ;_ end of lambda
                      (lambda (str)
                        (apply 'and
                               (mapcar
                                 '(lambda (el)
                                    (wcmatch el "#")
                                  ) ;_ end of lambda
                                 (mapcar 'chr
                                         (vl-string->list str)
                                 ) ;_ end of mapcar
                               ) ;_ end of mapcar
                        ) ;_ end of apply
                      ) ;_ end of lambda
                      (if (or (wcmatch (car x) "*'") (wcmatch (car x) "*\""))
                        (substr (car x) 1 (1- (strlen (car x))))
                        (car x)
                      ) ;_ end of if
                    )
                  ) ;_ end of not
                ) ;_ end of or
              ) ;_ end of lambda
             lst
           ) ;_ end of vl-remove-if
    ) ;_ end of setq
    (setq lst
           ((lambda (lst / poz temp)
              (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 setq
  ) ;_ end of defun
(setq lst
         (mapcar '(lambda (x) (list (vl-string-trim " \t\n" (car x)) ; Удаление лишних пробелов
				    (vl-string-trim " \t\n"(cadr x)) ; Удаление лишних пробелов
				    )
		    )
                 (_dwgru-get-spds-text-and-range) ; из #472 
         ) ;_ end of mapcar
  ) ;_ end of setq
  (CB-filtr lst)



(setq tmp (SortStringWithNumberAsNumber (mapcar 'car lst) t)) 
(setq lst (mapcar '(lambda(x)(assoc x lst)) tmp))



(setq lst
       (mapcar
	 '(lambda (y)(setq y (mapcar 'red-trim y))
	    (if (nth 2 y) y (append y '("-"))))
	 (mapcar '(lambda (x) (cons (car x) (str-str-lst (cadr x) ",")))
		 lst
	 ) ;_ end of mapcar
       ) ;_ end of mapcar
) ;_ end of setq



) ;_ end of defun CB-test
Удаление пробелов работает.
1. Третий элемент подсписка создается, но только для тех позиций, которые содержат запятую. Нужно чтобы и для элементов без запятой создавался третий элемент, с минусом в содержании "-". Хотя может и без этого дальше можно обойтись, но лучше чтобы это было реализовано на этом этапе.
Добавлено.
Знак “-” должен приписываться третьим элементом только для позиций, вторая строка которых начинается на
“-” “Лист” “Фл”
Для остальных позиций третьим элементом должно приписываться “L=”

2. К сожелению некоторые фильтры перестали работать. Вот например не отфильтровались данные позиции.
("АС" "Двутавр") ("Торец" "фрезеровать") ("1АС" "Швеллер")

Добавлено
Обнаружил, что указанные в пункте 2 неполадки появились когда я в #525 пытался скрестить код от СВ с кодом сортировки от VVA, опять напортачил ...
__________________
Блог

Последний раз редактировалось Red Nova, 04.10.2008 в 19:11.
Red Nova вне форума  
 
Старый 04.10.2008, 12:16
#528
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,996


Red Nova, А что будет, если ни в одной строке не будет запятой? Мне кажется, что минус не нужет. Признаком отсутствия третьего элемента может быть длина списка или nil при попытке вдять третий элемент списка.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Автор темы   Старый 04.10.2008, 13:16
#529
Red Nova

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


VVA,
Цитата:
А что будет, если ни в одной строке не будет запятой?
В таком случае все новые третьи элементы подсписка должны содержать либо “-” либо “L=”.
Цитата:
Мне кажется, что минус не нужен.
Все элементы подсписка, (когда добавим гост их будет 4) должны в дальнейшем вписаться в четыре текстовых примитива, которые составляют строку одной позиции в спецификации, которую в дальнейшем нужно рассчитать командой SPEC5D. То есть рамкой отметим шаблон спецификации, в котором 4 столбца (номер поз, ГОСТ, профиль, длина) и N-ное количество строк, и весь список перейдет в спецификацию. То есть в конце нужно иметь для каждой позиции содержание всех граф (в том числе и графы длина). Именно для этого и нужно вписывать туда для позиций не содержащих информацию о длине значения “-” (для листовых позиций) и “L=” (для профильных позиций, чтобы потом добавить вручную нужное значение).
__________________
Блог
Red Nova вне форума  
 
Старый 04.10.2008, 16:34
#530
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,996


Red Nova, Обновил #526 Выделил синим
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Автор темы   Старый 04.10.2008, 19:17
#531
Red Nova

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


VVA, Обновил #527
Теперь для всех элементов не содержащих информации о длине создается третий элемент “-”.
1. А можно удовлетворить и это требование
Цитата:
Знак “-” должен приписываться третьим элементом только для позиций, вторая строка которых начинается на
“-”, “Лист”, “Фл”
Для остальных позиций третьим элементом должно приписываться “L=”
2. Посмотри пожалуйста что я в #527 сделал не так, от чего слетели некоторые фильтры.
Цитата:
К сожалению некоторые фильтры перестали работать. Вот например не отфильтровались данные позиции.
("АС" "Двутавр") ("Торец" "фрезеровать") ("1АС" "Швеллер")
это появилось когда я в #525 пытался скрестить код от СВ с кодом сортировки от VVA, опять напортачил ...
__________________
Блог
Red Nova вне форума  
 
Старый 04.10.2008, 19:47
#532
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,996


По п.1. изменил #526
по п.2 нет времени, еду в командировку.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Автор темы   Старый 04.10.2008, 20:59
#533
Red Nova

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


VVA,
Спасибо,
Приятного времяпровождения

All
Кто знает как правильно соединить код от CB c #524 и код сортировки списка от VVA c #518? Я в #527 пытался это сделать, чета напортачил, и лисп перестал работать корректно.
__________________
Блог
Red Nova вне форума  
 
Старый 05.10.2008, 17:54
#534
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


>Red Nova
Окончательная сортировка сделана по тому же алгориту, что и у VVA #518, только по другому реализовано, соответственно остались и те же недостатки...
Код:
[Выделить все]
(defun CB-test (/ CB-filtr lst)
  (defun CB-filtr (lst)
    (setq 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
                    (or
                      (and
                        (wcmatch (car x) "@*")
                        (wcmatch (vl-string-right-trim "1234567890'\"" (car x))
                                 "@"
                        ) ;_ end of wcmatch
                      ) ;_ end of and
                      (and (wcmatch (car x) "#*")
                           (wcmatch (vl-string-left-trim "1234567890" (car x))
                                    ",@,@',@\",',\""
                           ) ;_ end of wcmatch
                      ) ;_ end of and
                    ) ;_ end of or
                  ) ;_ end of not
                ) ;_ end of or
              ) ;_ end of lambda
             lst
           ) ;_ end of vl-remove-if
    ) ;_ end of setq
    (setq lst
           ((lambda (lst / poz temp)
              (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 setq
  ) ;_ end of defun
  (setq lst (mapcar '(lambda (x)
                       (list (vl-string-trim " " (car x))
                             (vl-string-trim " " (cadr x))
                       ) ;_ end of list
                     ) ;_ end of lambda
                    (_dwgru-get-spds-text-and-range) ; из #472 
            ) ;_ end of mapcar
        lst (CB-filtr lst)
        lst (mapcar '(lambda (x / p)
                       (if (setq p (vl-string-position (ascii ",") (cadr x)))
                         (list (car x)
                               (substr (cadr x) 1 p)
                               (vl-string-left-trim " " (substr (cadr x) (+ 2 p)))
                         ) ;_ end of list
                         (append x '("-"))
                       ) ;_ end of if
                     ) ;_ end of lambda
                    lst
            ) ;_ end of mapcar
  ) ;_ end of setq
  (mapcar
    '(lambda (x) (nth x lst))
    (vl-sort-i
      ((lambda (lst)
         (mapcar
           '(lambda (str1 str2)
              (if (wcmatch str2 "@*")
                (strcat (substr str2 1 1) str1 (substr str2 2))
                (strcat str1 str2)
              ) ;_ end of if
            ) ;_ end of lambda
           (mapcar
             '(lambda (x / str)
                (setq str "0")
                (repeat x
                  (setq str (strcat str "0"))
                ) ;_ end of repeat
                str
              ) ;_ end of lambda
             ((lambda (a)
                (mapcar '(lambda (x) (- (apply 'max a) x)) a)
              ) ;_ end of lambda
               (mapcar
                 '(lambda (str)
                    (length
                      (vl-remove-if-not
                        '(lambda (x)
                           (wcmatch x "#")
                         ) ;_ end of lambda
                        (mapcar 'chr (vl-string->list str))
                      ) ;_ end of vl-remove-if-not
                    ) ;_ end of length
                  ) ;_ end of lambda
                 lst
               ) ;_ end of mapcar
             )
           ) ;_ end of mapcar
           lst
         ) ;_ end of mapcar
       ) ;_ end of lambda
        (mapcar ' strcase (mapcar 'car lst))
      )
      '<
    ) ;_ end of vl-sort-i
  ) ;_ end of mapcar
) ;_ end of defun

Последний раз редактировалось CB, 06.10.2008 в 11:21.
CB вне форума  
 
Автор темы   Старый 05.10.2008, 19:55
#535
Red Nova

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


CB, Как всегда большое спасибо .
Почти все работает корректно.
1. Один только баг нашел. Выноски с содержанием типа (“a2” “-10x100x100”) (“a3” “-10x100x200”) не попадают в список. Хотя (“a1” “-10x100x300”) попадает. То есть проблема с выбором позиций, у которых в первой строке после буквы идет цифра отличная от единицы.
2. Еще одна просьба. Я похоже не учел еще один необходимый фильтр. Часто во второй строке позиции после запятой пишут не длину профиля, а его шаг. К примеру (“1” “12 АIII, шаг 200”). Нашими имеющимися фильтрами эта строка может пройти в спецификацию. А она там не нужна. Чтобы это исправить нужен вот какой фильтр.
В том месте, когда мы уже отфильтровали все выноски, получили парный список, но еще не удалили подобные позиции нужно вклинить такой алгоритм.
Проверяем есть ли во второй строке запятая. Если нет, то ничего не делаем. Если запятая есть, то проверяем что идет после запятой (Пробелы не учитываем). Если после запятой написано (L=…..) или (\\U+03A3L=…..), где \\U+03A3 – это знак сигма, то позицию оставляем в покое, если после запятой идет что-то другое, то удаляем все что идет после запятой вместе с ней же. В (\\U+03A3L=…..) и (L=…..) между буквани добускается ставить пробелы.
__________________
Блог
Red Nova вне форума  
 
Старый 06.10.2008, 08:41
#536
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


>Red Nova
По первому пункту - совершенно не понятно что у тебя за списки
(a2 -10x100x100) (a3 -10x100x200) - чего это у тебя кавычки в разные стороны
Проверил нормальный список - все корректно:
Код:
[Выделить все]
(setq lst '(("a2" "-10x100x100") ("a3" "-10x100x200") ("a1" "-10x100x300")))
-> (("a1" "-10x100x300" "-") ("a2" "-10x100x100" "-") ("a3" "-10x100x200" "-"))
CB вне форума  
 
Автор темы   Старый 06.10.2008, 08:52
#537
Red Nova

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


На кавычки не обращай внимания, это от шрифта в котором я набирал сообщение. Я то проверял на выносках а не на готовом списке. Вообще что-то странное. На работе все заработало корректно, а дома a2, a3 не вписывались. Ну да ладно. Потом проверю опять. Пока забудем это.
__________________
Блог
Red Nova вне форума  
 
Старый 06.10.2008, 10:16
#538
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


По п.2.
Цитата:
В том месте, когда мы уже отфильтровали все выноски, получили парный список, но еще не удалили подобные позиции
В зтот момент список может быть таким:
Код:
[Выделить все]
(setq lst '(("2" "Швеллер 12, L=1000, шаг 1000") ("3" "Швеллер 12, L=1000") ("4" "Швеллер 12, шаг 1000") ("5" "Швеллер 12")))
И что будет по твоему алгоритму?
Короче, если "камень преткновения" это слово "шаг", все можно было бы сделать гораздо проще:
Код:
[Выделить все]
(setq lst '(("2" "Швеллер 12, L=1000, шаг 1000") ("3" "Швеллер 12, L=1000") ("4" "Швеллер 12, шаг 1000") ("5" "Швеллер 12")))
(mapcar '(lambda (x / a)
           (if (setq a (vl-string-search "шаг" (cadr x)))
             (list (car x) (vl-string-right-trim " ," (substr (cadr x) 1 a)))
             x
           ) ;_ end of if
         ) ;_ end of lambda
        lst
) ;_ end of mapcar
-> (("2" "Швеллер 12, L=1000") ("3" "Швеллер 12, L=1000") ("4" "Швеллер 12") ("5" "Швеллер 12"))
CB вне форума  
 
Автор темы   Старый 06.10.2008, 10:32
#539
Red Nova

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


В принципе так тоже пойдет, если только шаг брать в расчет. Но тогда нужно кроме "шаг" добавить и "ш.".
Моим алгоритмом отфильтровалось бы все лишнее, если кто-то написал бы после запятой любое свое примечание. К примеру
("4" "Швеллер 12, сверху") ("4" "Швеллер 12, шаг 1000")...
Цитата:
В зтот момент список может быть таким:
Код:
Код:
[Выделить все]
(setq lst '(("2" "Швеллер 12, L=1000, шаг 1000").......)
И что будет по твоему алгоритму?
По моему алгоритму этот элемент списка остался бы нетронутым. Но дальше у нас есть алгоритм отрезающий все после второй запятой, и все пришло бы в норму.
("2" "Швеллер 12, L=1000")
Но ты прав, я описал принцип не очень точно.
Нужно проверить есть ли во второй строчке запятые. Если есть, то смотрим что идет за первой запятой, если это не (L=…..) или (\\U+03A3L=…..), то все что идет после первой запятой удаляем вместе с ней.
Таким образом если список такой
(setq lst '(("2" "Швеллер 12, L=1000, шаг 1000") ("3" "Швеллер 12, L=1000") ("4" "Швеллер 12, шаг 1000") ("5" "Швеллер 12")))
то станет таким
(setq lst '(("2" "Швеллер 12, L=1000, шаг 1000") ("3" "Швеллер 12, L=1000") ("4" "Швеллер 12,") ("5" "Швеллер 12")))
А далше уже будут работать ранее написанные фильтры.
Если надумаешь написать этот алгоритм, то внедри его пожалйста сразу в основной лисп, а-то я опять перепутаю куда его сувать .
__________________
Блог

Последний раз редактировалось Red Nova, 06.10.2008 в 10:40.
Red Nova вне форума  
 
Старый 06.10.2008, 11:28
#540
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


Попробуй заменить в #534 код, который я выделил красным на такой:
Код:
[Выделить все]
(if (or
      (equal (length
               (setq n (poz (cadr lst-temp) ","))
             ) ;_ end of length
             2
      ) ;_ end of equal
      (not (wcmatch (cadr lst-temp) "*L=*"))
    ) ;_ end of or
  (substr (cadr lst-temp) 1 (car n))
  (cadr lst-temp)
) ;_ end of if
Если будет все нормально (а я надеюсь на это) - изменю в #534
CB вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу)



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