[Red Nova]

Со школы не ладится у меня с программированием. Все предметы щелкал, а на экзамене по информатике (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, шаг 1000
Швеллер 12, шаг 1000, 2000
возвращяет
(("1" "Швеллер 12" "-") ("2" "Швеллер 12" "шаг 1000"))

[CB]

Ну тогда так:

Код:

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

(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
          (if (wcmatch (cadr lst-temp) "*L=*")
            (car n)
            (car (reverse n))
          ) ;_ end of if
  ) ;_ end of substr
  (cadr lst-temp)
) ;_ end of if

[Red Nova]

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

Знак “-” должен приписываться третьим элементом только для позиций, вторая строка которых начинается на “-”, “Лист”, “Фл” Для остальных позиций третьим элементом должно приписываться “L=”

[CB]

Код:

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

(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 (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
                                      (if (wcmatch (cadr lst-temp) "*L=*")
                                        (car n)
                                        (car (reverse n))
                                      ) ;_ end of if
                              ) ;_ 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
;;;                    lst
                    (_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
                   (if (wcmatch (cadr x) "-*,Лист*,Фл*")
                     (append x '("-"))
                     (append x '("L="))
                   ) ;_ end of if
                 ) ;_ 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

[Red Nova]

Код:

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

Command: (cb-test)
; error: too few arguments

[CB]

Это из-за того, что у меня нет СПДС, так я для себя сделал ввод списка...
Исправлено в #544

[Red Nova]

CB,
Отлично. Спасибо. Теперь все оно.
Осталось совсем мало. Добавить ГОСТы и вписать все в заранее подготовленный шаблон.
Во первых подспискам нужно приписать новый четвертый элемент, причем сначала. Этот элемент будет содержать информацию о ГОСТе.
Алгоритм такой.
-Проверяем на какие символы начинается второй элемент, и в зависимости от этого приписываем спереди различные госты.
Вот список возможных профилей и гостов.

ГОСТ 19903-74 соответствует профилям начинающимся на символы “-”, “лист -”, “лист-”, “Фл”, Причем если профиль начинается на “-”, то должно проверяться условие, что третья строка подсписка содержит только “-”, если она содержат что-то другое, то это другой гост, о нем далее.

ГОСТ 103-76 соответствует профилям начинающимся на символы “-”, “Полоса”, сюда для символа “-” попадают все позиции не вошедши в предыдущий гост.
К примеру
("1" "-10х100x100" "-") ("2" "-5х50" "L=1000")
("ГОСТ 19903-74" "1" "-10х100x100" "-") ("ГОСТ 103-76" "2" "-5х50" "L=1000")

ГОСТ 8568-77 соответствует профилям начинающимся на символы “ Лист ромб”, “Лист чечевица”

ГОСТ 30245-03 соответствует профилям начинающимся на символ “\\U+E72E” (символ квадрата)

ГОСТ 10704-91 соответствует профилям начинающимся на “Тр” (В англ и рус правописании)

ГОСТ 8509-93 соответствует профилям начинающимся на “Уголок”, “\\U+E720”, и содержащим далее в тексте только один символ “х” (В англ и рус правописании)

ГОСТ 8510-86 соответствует профилям начинающимся на “Уголок”, “\\U+E720”, и содержащим далее в тексте два символа “х” (В англ и рус правописании)
К примеру
("1" "Уголок 75х5" "-") ("2" "Уголок 80х50х5" "-")
Станет
("ГОСТ 8509-93" "1" "Уголок 75х5" "-") ("ГОСТ 8510-86" "2" "Уголок 80х50х5" "-")

ГОСТ 8239-89 соответствует профилям начинающимся на “Двутавр”, “\\U+E729”

ГОСТ 8240-97 соответствует профилям начинающимся на “Швеллер”, “\\U+E725”

ГОСТ 5781-82 соответствует профилям начинающимся на “%%c”, “\\U+E712”

[ShaggyDoc]

Что-то мне кажется, что тема научите лиспу разлилась по древу и ушла в частности. Начиная с поста #397 прицепились к позиционным выноскам СПДС и далее пошли многочисленные разборки. Конечно, по ходу были и очень хорошие примеры, которые будут полезны всем, но всё же....

Red Nova еще долго будет сообщать "осталось совсем мало". Типа, только все ГОСТ добавить (а все не добавить). Какой ГОСТ чему соответствует и т.д.

А ведь задачу надо решать в общем виде и универсально. Сводится-то к тому, что надо записать в спецификацию. Частный случай (пока) из выносок СПДС. Потом появятся множество других вариантов (из простых текстов, из атрибутов, из Leader, из MLeader, из черта рогатого, из дьявола хвостатого.

И никакой гарантии, что спецификация правильная, так как может быть что-то вообще не нарисованное, или нарисованное, но не позиционированное, или позиционированное, но не так.

Если уж учиться, то, как я уже писал где-то в начале ветки - с продумывания и постановки задачи. С тщательного продумывания, а не латания дыр на мосту, который строят вдоль реки, а не поперёк.

[CB]

>ShaggyDoc
Собственно говоря, прочитав вчера вечером #547, я пришел приблизительно к тому же выводу - это все до бесконечности и сегодня хотел предложить Red Nova продолжить программу самостоятельно, тем более, что задача в #547 не сложная - правильно составленный ассоциативный список, apply, mapcar - это практически и все. А помощь я думаю будет оказана...

[Red Nova]

ShaggyDoc

Что-то мне кажется, что тема научите лиспу разлилась по древу и ушла в частности.

Правильно все. Давно уже не о том. Можно вообще переместить все это в другую тему (тем более что она есть). В начале я пытался эту задачу сам решить, но она оказалась больно сложной. Изначальна не правильно рассчитал какую задачу тут начинать. Дальше просто пошло выпрашивание кодов у всех, больно полезная штука.

Red Nova еще долго будет сообщать "осталось совсем мало"

Я думаю, что на этот раз действительно осталось совсем мало.

Типа, только все ГОСТ добавить

Ну это не так. Задача так не стояла (если интересно). Нужно ввести только текущие ГОСТы (причем только названия). То есть каждому профилю на данный момент соответствует только один ГОСТ, надо - правь файл, и меняй к примеру гост для уголка с одного на другой. А расчет спецификации будет проводится уже совсем другим лиспом (к стати его VVA давно уже написал.)

И никакой гарантии, что спецификация правильная,

Дык стока времени фильтруем.

Частный случай (пока) из выносок СПДС. Потом появятся множество других вариантов

Не надо других вариантов. Это разработка для пользователей СПДС

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

С этим трудно не согласиться. Как я уже признался, я тут давно не учусь, а бесстыдно выпрашиваю то что мне надо.

CB,

сегодня хотел предложить Red Nova продолжить программу самостоятельно

Ну раз ты говоришь что задача не сложная, то буду пробовать. Ждите вопросов...

[Red Nova]

Крыс
Как смотришь на то, чтобы перенести все начиная с #397 в
Копирование данных для спецификаций из выносок СПДС в таблицу из мтекстов?
А-то темка когда-то действительно была полезной многим. Надо бы тут подчистить.

[Кулик Алексей aka kpblc]

Проблема в том, что эти темы (обе) слишком сильно переплелись. В текущей теме и обучение, и спор, и готовые коды...
У меня сейчас нет никаких шансов вдумчиво разбираться. Но если хочешь - могу перетащить все, начиная с #397 в указанную тобой тему. Только, боюсь, как бы кавардака не получилось...
У меня другое предложение: в "Копировании выносок..." ты создаешь новый пост, в котором указываешь ссылки на самые интересные и нужные коды в этой теме. Доработку продолжать в той теме. Эту (временно) закрыть. Захочешь продолжить самообучение - сообщи, открою. Как тебе такой вариант?

[Red Nova]

Согласен, но думаю тему можно и не закрывать. Просто просим всех продолжить данные дебаты в новом месте.

Объявление

Чтобы не засорять этот топик, дальнейшее обсуждение по теме о преобразовании списков переходит в топик Копирование данных для спецификаций из выносок СПДС в таблицу из мтекстов
Всех тех, кому еще не окончательно надоели мои просьбы прошу посетить эту тему. Все дальнейшие дебаты продолжим там.

[Red Nova]

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

[Кулик Алексей aka kpblc]

Загоняй в автозагружаемый лисп и всего делов...

[DEM]

Red Nova
Acaddoc.lsp
в него все пихай

[Red Nova]

Кулик Алексей aka kpblc,
Блин, действительно.
DEM,
У меня для лиспов свой каталог, я просто недапетрил что если в файл lsp записать не команду а просто строчку к примеру типа
(setvar "mirrtext" 1)
то она будет каждый раз прогонятся при открытие нового файла.

[DEM]

Red Nova
Просто Acaddoc.lsp всегда подгружается при любых профилях.
И его проще использовать для этих целей.

[Кулик Алексей aka kpblc]

DEM, acaddoc имеет одну неприятную особенность... Если встречается первый, то все остальные acaddoc'и не грузятся.

[wetr]

Помогите. Нужна идея.
Нужно ограничить неправильный ввод точки юзером. Начальные данные - точки P1 P2 P3.
Условие такое (angle p1 p2) < (angle p1 p3) < (angle p1 p2) +180
т.е. если условие не выполняется, заново задается точка P3.
Реализую через while. Проблема в том, что условие для while задается через and. А когда какое либо из условий and не выполняется, and возвращает nil, что естественно, и цикл прекращается. Есть какой-то другой способ решить мою задачку? А то я многого не знаю... Надеюсь понятно объяснил

Код:

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

(setq 	p1 (getpoint "\nПервая точка <Выход>: ")
	           p2 (getpoint p1 " \nВторая <Выход>: ")
                      p3 (getpoint "\nТретья <Выход>:"))
    (while (and
	   ( > (angle p1 p3) (+ pi (angle p1 p2)))
	   ( < (angle p1 p3) (+ pi pi (angle p1 p2)))
	  )
     (princ "\n Неверная точка. Повторите ввод")
  (setq         p3 (getpoint "\nТретья (Опции/Помощь):"))
      );_while