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

_____________________________________________________________________________________________________________

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

Дима_ · 30.09.2008, 12:56

To Елпанов Евгений, наверное не внимательно #459 читал - список надо предварительно отсортировать - он не все подряд перебирает, как другие:
Из 459: ""Скорострельность" проверять на больших списках (например из #445), предварительно отсортированных - (setq spisok (vl-sort spisok '<))"

P.S. ну в нашем случае вместо spisok lst разумеется и будет CHECK3_1 "20 \U+E712" LST) T

Red Nova · 30.09.2008, 13:40

Крыс
На работе до сих пор прессуют.Пока придется забыть про обучение лиспу в рабочие часы.

Прошу, если не затруднит, подправь то о чем я говорил в твоем последнем коде и соедини этот код с лиспом где присутствуют последние фильтры от VVA. (он на #465 прикреплен отдельным файлом.)

P.S. Знаю что от просьб объяснить я постепенно перешел к просьбам просто сделать за меня. Ну очень уж хочется окончательный лисп заполучить. А на нем учиться оказалось чересчур сложно. Колонну я еще лиспом чертил, а на списки не тяну.

Кулик Алексей aka kpblc · 30.09.2008, 13:48

Red Nova, так и мне в общем-то тоже не особо вздохнуть... Я за сегодня с 8 утра еще ни строки кода не написал (а сдавать результат надо в пятницу).

Red Nova · 30.09.2008, 13:53

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

Red Nova · 30.09.2008, 14:35

ALL
Самому не получается скрестить новый код преобразования выносок в список (от крыса, пост #472) и последний вариант кода со старым алгоритмом преобразования выносок содержащим фильтры (последний вариант от VVA в прикрепленном файле на #465)
Приведу их по отдельности
новый код преобразования выносок в список

Код:

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

(defun _dwgru-get-spds-text-and-range (/ 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
  lst
  ) ;_ end of defun

последний вариант кода со старым алгоритмом преобразования выносок содержащим фильтры

Код:

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

(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 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" 
"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 (filtr lst)) ; можно и просто оставить в первом setq - но чтоб было понятней.
  
);end of test


(defun test2 ()
  (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 '(("1" "-10х100x200") ("1" "-10х100x200") ("2" "Швеллер 12, L=1000, шаг 1000") ("2" "Швеллер 12, L=1000")
            ("2" "Швеллер 12") ("3" "8 %%c12 Ас1, ?L=10000") ("3" "?12 Ас1") ("4" "?20 Ас1")
            ("5" "8 ?20 А500c, L=1000") ("5" "8 ?20 А500c")))
(setq lst (filtr lst)) ; можно и просто оставить в первом setq - но чтоб было понятней.
)

Пытался просто переставить местами коды выбора вот так

Код:

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

(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 _dwgru-get-spds-text-and-range (/ 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 (filtr lst)) ; можно и просто оставить в первом setq - но чтоб было понятней.
  ) ;_ end of defun

Но не работает. Пишет

Код:

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

Command: (_dwgru-get-spds-text-and-range)

Select objects: Specify opposite corner: 19 found

Select objects:
nil

Прошу помочь скрестить правильно эти коды.

Red Nova · 30.09.2008, 14:41

Вай, забыл. Это же из за того, что новый аглоритм крыса выдает список вот в каком виде.

Код:

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

(("Узел" "" "1" 1) ("Цепная" "Выноска" 2) ("Греб" "Выноска" 2) ("Поз" "Выноска" 1))

Надо сперва удрать последние цифры списка

VVA · 30.09.2008, 15:07

Цитата:

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

Надо сперва удрать последние цифры списка

Код:

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

(setq lst  (_dwgru-get-spds-text-and-range)) ;_Получаем список СПДС выносок
;;;Так как у меня нет СПДС, забъем список ручками
(setq lst '(("Узел" "" "1" 1) ("Цепная" "Выноска" 2) ("Греб" "Выноска" 2) ("Поз" "Выноска" 1)))
;;;Удаляем все кроме первых двух
(setq lst (mapcar '(lambda(x)(list (car x)(cadr x))) lst)) ;;;-> (("Узел" "") ("Цепная" "Выноска") ("Греб" "Выноска") ("Поз" "Выноска"))

Кулик Алексей aka kpblc · 30.09.2008, 15:10

VVA, в выноске может быть и 3 строковых элемента )

Red Nova · 30.09.2008, 15:18

kpblc, Ты должно быть про узловую выноску говоришь. Так я закомментировал ее на #485

Код:

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

                           '("spdsNotePosition"
                             ;"spdsNoteKnot" закомментировал тапорно, чтобы исключить из выбора узловые выноски
                             "spdsNoteComb"
                             "spdsNoteChain"
                             )

Она в общем то было не нужна.
Теперь может быть точно только 2 строковых элемента

Кулик Алексей aka kpblc · 30.09.2008, 15:21

Цитата:

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

<...>Теперь может быть точно только 2 строковых элемента

Я бы все же разрабатывал более универсальный код )

Red Nova · 30.09.2008, 15:40

В узловых выносках я ни разу не ставил позиции, да и не видел чтобы другие ставили. Не думаю что это кому-то пригодится.
Но зато в узловых выносках я часто отмечаю номер узла и адрес страницы.
("1" "Лист-5")
Получается так, что установленные мною фильтры пропустят этот список

. Так что лучше от узловых выносок держаться по дальше

Кулик Алексей aka kpblc · 30.09.2008, 16:12

Кхе, это зависит от специфики работы. У меня, например, как раз узловые являются основными

Red Nova · 30.09.2008, 16:22

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

Red Nova · 30.09.2008, 16:31

А пока, учитывая последнюю заметку от VVA, код получился такой. (Работает)

Код:

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

(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 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))

  ) ;_ end of defun

VVA · 30.09.2008, 17:51

Вот вариант с удалением ВСЕХ НЕ СТРОК

Код:

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

(setq lst  (_dwgru-get-spds-text-and-range)) ;_Получаем список СПДС выносок
;;;Так как у меня нет СПДС, забъем список ручками
(setq lst '(("Узел" "" "1" "1") ("Цепная" "Выноска" 2) ("Греб" "Выноска" 2) ("Поз" "Выноска" 1)))
;;;Удаляем все НЕ СТРОКИ
(setq lst (mapcar '(lambda(x)
                     (vl-remove-if-not '(lambda(y)(= (type y) 'STR)) x)
                    )
                  lst
                  )
      ) ;;;->(("Узел" "" "1" "1") ("Цепная" "Выноска") ("Греб" "Выноска") ("Поз" "Выноска"))

Кулик Алексей aka kpblc · 30.09.2008, 20:16

VVA, VVA, а я так хотел, чтобы Red Nova сам нарисовал вариант...

Red Nova · 30.09.2008, 20:39

All
Обновил код на #494 (c учетом #495).
На данный момент имеем код, который значительно фильтрует не нужную информацию. Почти все фильтры уже готовы. Осталось вот что.

1. Отфильтровать подобные позиции
Допустим имеем такой список.

Код:

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

(("2" "Швеллер 12, L=1000") ("2" " 12, L=1000") ("2" "Швеллер 12") ("2" " 12"))

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

Код:

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

(("2" "Швеллер 12, L=1000") ("2" " 12, L=1000"))

Б. Проверяем который из списков самый длинный, и оставляем его, а все оставшиеся удаляем. Если длина равна, то удаляем на угад.
Получим

Код:

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

(("2" "Швеллер 12, L=1000"))

Это собственно последние фильтры. После этого каждой позиции должен соответствовать один подсписок.

2. Теперь список надо расставить по порядку. Вот на мой взгляд нужная очередность:
1, 1’, 1”, 1a, 1b, 1c, …1d, 1e, 1f, 1g, 1а, …1б, 1в, 1г, 1д, 1е, …2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, … A1, A2, A3, a1, a2, a3, a5, B1, B2, B3, b1, b2, b3, b4, b5, C1, C2, C3, c1, c2, c3, c4, c5, … A1, A2, A3, а1, а2, а3, а5, Б1, Б2, Б2, б1, б2, б3, б4, б5, в1, в2, в3, в4, в5

Как всегда прошу помочь кому не лень.

Red Nova · 30.09.2008, 20:44

kpblc, Мне действительно лучше учиться на более простом. Я так часами могу о стенку головой биться. Вот другое дело было упражнение от VVA про колонну.
А этот лисп засел в мозгах и не выходит. Все хочиться его поскорее пощюпать в работе. Если на нем учиться, то в лучшем случае я его закончу через год-два

Добавлено
К стати, все что связанно с lambda(x) я не понемаю. Читал справку, смотрел примеры, а толку мало

Крыс Еще добавлю.О узловых выносках.
Я не знаю какую у вас в ней пишут информацию (в какой строке что пишут). Подходят ли этой информации наши фильтры?

Кулик Алексей aka kpblc · 30.09.2008, 22:37

У тебя число обязательно присутствует в элементах списка?
P.S. Может, lambda по ходу дела рассказать?
P.P.S. Что-то я, похоже, погорячился с числами... Вариант "число сначала" делается без вопросов, а вот "сначала символ, потом число" - что-то не срослось.

Red Nova · 30.09.2008, 22:54

Цитата:

У тебя число обязательно присутствует в элементах списка?

Не понял о каком ты говоришь числе

Цитата:

P.S. Может, lambda по ходу дела рассказать?

Если есть охота рассказать, то прошу объяснить подробно, на примерах, и типа перед тобой первокласник.

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

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