[Red Nova]

Если кто еще не знает, то тут VVA по моей просьбе создал программу для подсчета масс в спецификациях из мтекстов. Программой я очень доволен, все не нарадуюсь. Но как говорится аппетит приходит во время еды. И теперь хотелось бы пойти еще дальше и автоматизировать создание самой спецификации (которую уже потом можно рассчитывать лиспом от VVA). Ведь по большей части на чертеже всегда присутствуют выноски в которых уже есть информация по спецификации, или хотя бы ее часть. Что если одной командой собрать всю информацию из выносок и вписать в шаблон спецификации.
Суть такова.
Я пользуюсь СПДС. Для маркировки позиций использую выноски СПДС. Выноски СПДС имеют две строки, в верхней пишется номер позиции, в нижней данные о профиле.
Предполагаемый лисп должен выбирать все позиционные выноски СПДС имеющиеся в файле (можно и выбрать рамкой часть файла), создавать список из двух столбцов (номер позиции и профиль), затем многократно фильтровать ненужные данные и дублирующие позиции. Полученный список упорядочивается. Затем рамкой выбирается шаблон для спецификации (напомню он из мтекстов), в выбранные строки вписываются данные из упорядоченного списка.

Теперь попробую на конкретном файле объяснить алгоритм более подробно.
Запускаем лисп, создается список с данными из выносок. Затем фильтруем мусор. Для этого надо сперва ввести в лисп пояснение – как выбрать полезные выноски. Дадим определение пригодных для спецификации выносок.
Они должны удовлетворять следующим пунктам.
1. Обе строки выноски содержат информацию.
2. Верхняя строка выноски должна содержать информацию нумерационного характера, нумерация отсчитывается по цифрам и по буквам латинского и русского алфавитов. Можно использовать знак ‘ и “. Допускаемые записи могут иметь такой вид – 1, 2, 3, 4, // а, б, в, г, // a, b, c, d, // 1a, 1b, 1c, // 1, 1’, 1”, 2, 2’ // a1, a2, a3, b, b1, ... (Впрочем для первого приближения можно оставить только 1, 2, 3, 4)
3. Нижняя строка должна начинаться на определенные символы, вот их список
- Знак “-”, слова “Лист” и “Полоса”
- Слово “Труба”, “Тр.” и знак трубы из шрифтов СПДС
- Слово “Уголок” и аналогичные символы из шрифтов СПДС
- Слово “Двутавр” и аналогичные символы из шрифтов СПДС
- Слово “Швеллер” и аналогичные символы из шрифтов СПДС
- Слово “Фланец”, то же “Фл.”
- Стандартный знак диаметра и знак диаметра из шрифтов СПДС
4. Есть и другие критерии, но о них пока не стоит говорить.

Теперь необходимо отсеять дублирующие позиции, но делать это надо так, чтобы отсеять менее информативные выноски. Скажем имеем две выноски первая строка которых имеет тот же номер, а втора строка различается, предположим вотрые строки имеют следующее содержание:
“Тр. Ø89х3.5, L=2500”
“Тр. Ø89х3.5”
Из этих строк выбирается первая, как более информативная, вторая отбрасывается. Если по проще, то для дальнейших действий берем выноску с более длинной второй строкой.

Поскольку информация о профиле вписывается в двух столбцах (Профиль отдельно, длина отдельно) то нам теперь нам надо определится с ними.
Предположим верхняя строка выноски содержит цифру 25. Если нижняя строка выноски не содержит запятых, (на пример “Тр. Ø89х3.5”) то считаем что выноска не несет информацию о длине профиля, тогда в списке соответствующая строка записывается как
(25, Тр. Ø89х3.5, -). Если же запятая есть (на пример “Тр. 89х3.5, L=2500”) То считаем что выноска несет информацию о длине профиля, тогда в списке соответствующая строка записывается как (25, Тр. 89х3.5, L=2500). Если выноска содержит две и более запятых, (на пример “Тр. Ø89х3.5, L=2500, шаг 200”) то отбрасываем информацию идущую после второй запятой.
Далее упорядочиваем список (по номерам позиций).
Если все прошло как планировалось, то применительно к файлу примера список будет такой.
(1, -10х100x100, -)
(2, Тр. Ø89х3.5, L=2500)
(3, “знак уголка шрифта СПДС”75х5, L=800)
(4, “знак двутавра шрифта СПДС”20, -)
(5, “знак швеллера шрифта СПДС”12, L=960)
(6, Ø12 А500c, ΣL=24000)
(7, Ø20 А500c, L=980)

В спецификации есть также столбик с ГОСТ-ом. Чтобы он вписывался автоматически для каждого профиля надо заранее определится с ГОСТ-ом, и записать его в лисп. Так в нашем примере нужно записать следующие госты
Если обозначение профиля начинается на символ “-”, слово “Лист” то это соответствует ГОСТу “ГОСТ 19903-74”
Если обозначение профиля начинается на слова “Труба”или “Тр.” то это соответствует ГОСТу “ГОСТ 10704-91”
Если обозначение профиля начинается на cлово “Уголок” или аналогичные символы из шрифтов СПДС то это соответствует ГОСТу “ГОСТ 8509-93”
Если обозначение профиля начинается на cлово “Двутавр” или аналогичные символы из шрифтов СПДС
то это соответствует ГОСТу “ГОСТ 8239-89”
Если обозначение профиля начинается на слово “Швеллер” или аналогичные символы из шрифтов СПДС
то это соответствует “ГОСТ 8240-97”
Если обозначение профиля начинается на стандартный знак диаметра и знак диаметра из шрифтов СПДС то это соответствует ГОСТу “ГОСТ 5781-82”

Итак добавив ГОСТы к спискам они должны стать такими:
(ГОСТ 19903-74, 1, -10х100x100, -)
(ГОСТ 10704-91, 2, Тр. Ø89х3.5, L=2500)
(ГОСТ 8509-93, 3, “знак уголка шрифта СПДС”75х5, L=800)
(ГОСТ 8239-89, 4, “знак двутавра шрифта СПДС”20, -)
(ГОСТ 8240-97, 5, “знак швеллера шрифта СПДС”12, L=960)
(ГОСТ 5781-82, 6, Ø12 А500c, ΣL=24000)
(ГОСТ 5781-82, 7, Ø20 А500c, L=980)

Формирование списка законченно. Теперь нужно рамкой отметить шаблон спецификации, в которой 4 столбца и n-ное количество строк. Данные их списка вписываются в мтексы спецификации как указанно в файле примера. Если строк выбрано больше чем у списка, то в мтексты лишних строк вписываются символы ###, если строк выбрано меньше чем у списка, то выходит сообщение об ошибке.

Ну вот и все. Больно длинно у меня получилось для первых объяснений. Если вы дошли до этого предложения, то у вас железное терпение. Надеюсь что кому-то эта белиберда покажется интересной.

В конце скажу что крыс сделал первый шаг, и создал лисп формирующий список их строк выносок СПДС. Вот он.

Код:

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

(defun c:get-notes-activex (/ adoc lst)
;; Через ActiveX
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-StartUndoMark
  (vlax-for ent (vla-get-modelspace adoc)
    (if (= (vla-get-objectname ent) "mcsDbObjectNotePosition")
      (setq lst (cons ent lst))
      ) ;_ end of if
    ) ;_ end of vlax-for
  ;; Теперь делай со списком чего хотишь
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

(defun c:get-notes-ent (/ adoc lst _dwgru-conv-pickset-to-list)
;; Через ent*

  (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

  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-StartUndoMark
  (setq lst (vl-remove-if-not
              '(lambda (x) (= (cdr (assoc 0 (entget x))) "spdsNotePosition"))
              (_dwgru-conv-pickset-to-list (ssget "_X"))
              ) ;_ end of vl-remove-if-not
        ) ;_ end of setq
  ;; Теперь делай со списком чего хотишь
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

[DEM]

Сообщение от Red Nova крыс Обломался... Может если подожду свободное время у тебя все же появится? Ато аппетит то уже проснулся.

А ты что думаешь стандартными средствами СПДС-ки это нельзя сделать??
Скоро примерчик будет тебе(только не от меня)

[Red Nova]

крыс
Когда руки дойдут добавь пожалуйста возможность захватывать кроме позиционных еще гребенчатые и цепные выноски. А дальше я попытаюсь сам с фильтрами разобраться в топике Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу)

[dextron3]

Red Nova, чувствуется веткадом начало веять

[Red Nova]

Есть кординальные различия. Но о них позже, когда лисп будет готов. Кстати, создание лиспа продолжилась по ссылке с #22.

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

"Продолжилось" - мягко сказано...

[Red Nova]

Дай бог до конца дойти.

[Red Nova]

Получилось так, что тема продолжила развиваться в топике Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу), там разработка заняла 8 листов, и по ходу дела в не поучаствовали многие программисты. Лисп пока ней закончен, но чтобы не забивать указанную тему лишней информацией было решено все же вернуть дальнейшие действия сюда.

Тут я приведу ссылки на самые важные посты, которые пригодятся далее.
Код от kpblc, для преобразования выносок СПДС в список.#472
Код для упорядочивания списков от VVA#518
И последняя версия главного лиспа, который фильтрует и видоизменяет список полученный кодом от kpblc, который разработал CB#544

На данный момент этот лисп позволяет получить такой список.

Код:

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

(("1" "-10х100x100" "-") ("2" "Швеллер 12" "L=1000") ("8" "Полоса -4х50" 
"L=1000") ("14" "Уголок 75х5" "L="))

Последним шагом перед введением этой информации в спецификацию должно быть добавление информации о ГОСТе профилей. Алгоритм указан тут

[CB]

>Red Nova
Я смотрю ты заскучал, хотя и говорил

...буду пробовать. Ждите вопросов...

1. Для начала нужно создать ассоциативный список. Я начинаю - ты заканчиваешь.

Код:

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

(apply 'append
       (mapcar
         '(lambda (x y)
            (mapcar
              '(lambda (z)
                 (cons z y)
               ) ;_ end of lambda
              x
            ) ;_ end of mapcar
          ) ;_ end of lambda
         (list '("Лист -" "Лист-" "Фл")
               '("Лист чечевица" "Лист ромб")
               '("-")
               '("Полоса")
               '("Уголок")
;;;продолжение здесь
         ) ;_ end of list
         (list "ГОСТ 19903-74"
               "ГОСТ 8568-77"
               '("ГОСТ 19903-74" "ГОСТ 103-76")
               "ГОСТ 103-76"
               '("ГОСТ 8509-93" "ГОСТ 8510-86")
;;;продолжение здесь
         ) ;_ end of list
       ) ;_ end of mapcar
) ;_ end of apply

[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")

и с этим

ГОСТ 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" "-")

[Red Nova]

CB,
Блин. Уже полтора часа бъюсь об стенку и все не пойму как работает лямбда внутри лямбды. Хотя по отдельности все функции понемаю.

[Sleekka]

Блин. Уже полтора часа бъюсь об стенку и все не пойму как работает лямбда внутри лямбды. Хотя по отдельности все функции понемаю.

Цикл в цикле когда нибудь запускал? если нет, то полтора часа - это мало - надо больше.

[VVA]

Выделили цветом, должно стать понятнее

Код:

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

(apply 'append
       (mapcar
         '(lambda (x y)
            (mapcar
              '(lambda (z)
                 (if (listp y)
                   (append (list z) y)
                   (list z y)
                 ) ;_ end of if
               ) ;_ end of lambda
              x
            ) ;_ end of mapcar
          ) ;_ end of lambda
         (list '("Лист -" "Лист-" "Фл")          ;;; 1
               '("Лист чечевица" "Лист ромб")    ;;; 2
               '("-")                            ;;; 3
               '("Полоса")                       ;;; 4
               '("Уголок")                       ;;; 5
;;;продолжение здесь
) ;_ end of list
         (list "ГОСТ 19903-74"                   ;;; 1
               "ГОСТ 8568-77"                    ;;; 2
               '("ГОСТ 19903-74" "ГОСТ 103-76")  ;;; 3
               "ГОСТ 103-76"                     ;;; 4
               '("ГОСТ 8509-93" "ГОСТ 8510-86")  ;;; 5
;;;продолжение здесь
) ;_ end of list
 ;_ end of list
       ) ;_ end of mapcar
) ;_ end of apply

Возьмем к примеру первые элементы двух списков
("Лист -" "Лист-" "Фл") ;;; 1
"ГОСТ 19903-74" ;;; 1
Тогда для '(lambda (x y)
x=("Лист -" "Лист-" "Фл") ;;; 1
y="ГОСТ 19903-74" ;;; 1
Заметь, что элементы 1-го списка - списки
Для (lambda (z) поочередно подставляются элементы x, т.е.
z= "Лист -"
z= "Лист-"
z= "Фл"
и все они собираются в список с y, т.е. "ГОСТ 19903-74"
Получаем список из элементов
("Лист -" "ГОСТ 19903-74")
("Лист-" "ГОСТ 19903-74")
("Фл" "ГОСТ 19903-74")
Внес в код небольшую модификацию для получения однородного списка (раньше мог быть список или точечная пара). Изменения выделил жирным

В общем весь этот код сводится с получению этого списка

Код:

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

(setq lst '(
            ("Лист -" "ГОСТ 19903-74")
            ("Лист-" "ГОСТ 19903-74")
            ("Фл" "ГОСТ 19903-74")
            ("Лист чечевица" "ГОСТ 8568-77")
            ("Лист ромб" "ГОСТ 8568-77")
            ("-" "ГОСТ 19903-74" "ГОСТ 103-76")
            ("Полоса" "ГОСТ 103-76")
            ("Уголок" "ГОСТ 8509-93" "ГОСТ 8510-86")
            ;;;Добавляй сюда списки
           )
) ;_ end of setq

[Red Nova]

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

Код:

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

(apply 'append
       (mapcar
         '(lambda (x y)
            (mapcar
              '(lambda (z)
                 (if (listp y)
                   (append (list z) y)
                   (list z y)
                 ) ;_ end of if
               ) ;_ end of lambda
              x
            ) ;_ end of mapcar
          ) ;_ end of lambda
         (list '("Лист -" "Лист-" "Фл")          
               '("Лист чечевица" "Лист ромб")    
               '("-")                            
               '("Полоса")                       
               '("Уголок" "\\U+E720") 
               '("\\U+E72E")                         
               '("Тр" "Tp" "Тp" "Tр")  
               '("Двутавр" "\\U+E729")     
               '("Швеллер" "\\U+E725")     
               '("%%c" "\\U+E712")     
;;;продолжение здесь 
) ;_ end of list
         (list "ГОСТ 19903-74"                   
               "ГОСТ 8568-77"                    
               '("ГОСТ 19903-74" "ГОСТ 103-76")  
               "ГОСТ 103-76"                     
               '("ГОСТ 8509-93" "ГОСТ 8510-86") 
               "ГОСТ 30245-03"  
               "ГОСТ 10704-91"  
               "ГОСТ 8239-89"  
               "ГОСТ 8240-97"  
               "ГОСТ 5781-82"  
;;;продолжение здесь
) ;_ end of list
 ;_ end of list
       ) ;_ end of mapcar
) ;_ end of apply

А что делать дальше?

[CB]

>Red Nova
Весь день был в командировке, так что к машине добрался только сейчас... VVA объяснил работу кода очень доступно и понятно, правда

небольшая модификация для получения однородного списка

совсем не обязательна. Какая разница для получения второго элемента - либо cdr для списка точечная пара, либо cаdr для простого списка? Зато вместо одной ф-ии cond применяются две, причем одна из них медленная...
Списки ты составил почти правильно, даже нашел засаду для подсписка '("Уголок"), которую я специально устроил... Правда есть и одна неточность, про которую ты наверняка не мог знать. Это подсписок '("Тр" "Tp" "Тp" "Tр"). Я понимаю , что ты хотел решить проблему, что слово Тр может быть написано и русскими буквами и английскими, но:
во-первых - зту проблему нужно было решать раньше, т.к. если в слове Тр будет хоть одна английская буква, список отфильтруется на этапе фильтрации;
во-вторых эта проблема легко решается с помощью функции

Код:

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

(vl-string-translate "Tp" "Тр" тестируемая строка)

Здесь первая "Tp" - символы которые надо заменить (т.е. написанные по английски), вторая "Tp" - символы на которые надо заменить (т.е. на русские), причем первый символ первого теста должен соответствавать первому символ второго теста, второй - второму и т.д. В итоге на выходе ф-ции будет всегда слово Тр на русском языке. Именно оно и должно быть в подсписке.
Теперь продолжаем.
Попробуй сделать сам следующее
1. Создаем глобальную переменную

Код:

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

(setq lst '(("1" "-10х100x100" "-")
            ("3" "Уголок 75х5" "-")
            ("5" "Лист ромб -10х100x300" "-")
            ("9" "Полоса -4х50" "U+03A3L=10000")
           )
) ;_ end of setq

2. Создаем глобальную переменную

Код:

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

(setq LST-AS (код для получения ассоциативного спмска))

3. Теперь с помощью mapcar и функции для lambda

Код:

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

(car
  (vl-remove-if-not
    '(lambda (STR)
       (wcmatch (cadr EL-LST) (strcat (car STR) "*"))
     ) ;_ end of lambda
    LST-AS
  ) ;_ end of vl-remove-if-not
) ;_ end of car

(небольшие подсказки - использовать список lst, EL-LST это имя аргумента для lambda в mapcar'е) нужно для списка lst получить такой список

Код:

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

 
(("-" "ГОСТ 19903-74" "ГОСТ 103-76") ("Уголок" "ГОСТ 8509-93" "ГОСТ 8510-86") ("Лист ромб" . "ГОСТ 8568-77") ("Полоса" . "ГОСТ 103-76"))

Ну и проверить на списке lst с другими "комплектациями" подсписков.
Ну пока хватит, что то я сегодня запарился...

[Red Nova]

Хотя не до конца понял алгоритм, но судя по твоим указаниям код должен быть таким : Но естественно не работает

Код:

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

(setq lst '(("1" "-10х100x100" "-")
            ("3" "Уголок 75х5" "-")
            ("5" "Лист ромб -10х100x300" "-")
            ("9" "Полоса -4х50" "U+03A3L=10000")
           )
) ;_ end of setq lst

setq LST-AS (
(apply 'append
       (mapcar
         '(lambda (x y)
            (mapcar
              '(lambda (z)
                 (if (listp y)
                   (append (list z) y)
                   (list z y)
                 ) ;_ end of if
               ) ;_ end of lambda
              x
            ) ;_ end of mapcar
          ) ;_ end of lambda
         (list '("Лист -" "Лист-" "Фл")          
               '("Лист чечевица" "Лист ромб")    
               '("-")                            
               '("Полоса")                       
               '("Уголок" "\\U+E720") 
               '("\\U+E72E")                         
               '("Тр" "Tp" "Тp" "Tр")  
               '("Двутавр" "\\U+E729")     
               '("Швеллер" "\\U+E725")     
               '("%%c" "\\U+E712")     
) ;_ end of list
         (list "ГОСТ 19903-74"                   
               "ГОСТ 8568-77"                    
               '("ГОСТ 19903-74" "ГОСТ 103-76")  
               "ГОСТ 103-76"                     
               '("ГОСТ 8509-93" "ГОСТ 8510-86") 
               "ГОСТ 30245-03"  
               "ГОСТ 10704-91"  
               "ГОСТ 8239-89"  
               "ГОСТ 8240-97"  
               "ГОСТ 5781-82"  
) ;_ end of list
 ;_ end of list
       ) ;_ end of mapcar
) ;_ end of apply
) ;_ end of setq LST-AS



(defun test ()
   (mapcar 
     '(lambda (EL-LST) 
          (car
           (vl-remove-if-not
            '(lambda (STR)
                (wcmatch (cadr EL-LST) (strcat (car STR) "*"))
              ) ;_ end of lambda
             LST-AS
           ) ;_ end of vl-remove-if-not
         ) ;_ end of car
       ) ;_ end of lambda
         'lst
   ) ;_ end of mapcar 
) ;_ end of defun

[CB]

>Red Nova

setq LST-AS ( (apply 'append ....................

(defun test () ................. 'lst ;;; апострофа не должно быть ) ;_ end of mapcar ) ;_ end of defun

А так правильно... Значит на этом зтапе мы имеем:

Код:

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

(setq lst '(("1" "-10х100x100" "-")
            ("3" "Уголок 75х5" "-")
            ("5" "Лист ромб -10х100x300" "-")
            ("9" "Полоса -4х50" "U+03A3L=10000")
           )
) ;_ end of setq lst
(setq LST-AS
       (apply
         'append
         (mapcar
           '(lambda (X Y)
              (mapcar
                '(lambda (Z)
                   (cons Z Y)
                 ) ;_ end of lambda
                X
              ) ;_ end of mapcar
            ) ;_ end of lambda
           (list (list "Лист -" "Лист-" "Фл")
                 (list "Лист чечевица" "Лист ромб")
                 (list "-")
                 (list "Полоса")
                 (list "Уголок" "\\U+E720")
                 (list "\\U+E72E")
                 (list "Тр")
                 (list "Двутавр" "\\U+E729")
                 (list "Швеллер" "\\U+E725")
                 (list "%%c" "\\U+E712")
           ) ;_ end of list
           (list "ГОСТ 19903-74"
                 "ГОСТ 8568-77"
                 (list "ГОСТ 19903-74" "ГОСТ 103-76")
                 "ГОСТ 103-76"
                 (list "ГОСТ 8509-93" "ГОСТ 8510-86")
                 "ГОСТ 30245-03"
                 "ГОСТ 10704-91"
                 "ГОСТ 8239-89"
                 "ГОСТ 8240-97"
                 "ГОСТ 5781-82"
           ) ;_ end of list
         ) ;_ end of mapcar
       ) ;_ end of apply
) ;_ end of setq LST-AS
(defun test ()
  (mapcar
    '(lambda (EL-LST / EL-AS)
       (setq EL-AS
              (car
                (vl-remove-if-not
                  '(lambda (STR)
                     (wcmatch (cadr EL-LST) (strcat (car STR) "*"))
                   ) ;_ end of lambda
                  LST-AS
                ) ;_ end of vl-remove-if-not
              ) ;_ end of car
       ) ;_ end of setq
 
;;;Здесь будет продолжение
     ) ;_ end of lambda
    lst
  ) ;_ end of mapcar
) ;_ end of defun

Т.е. - ф-ция mapcar последовательно передает своей (lambda (EL-LST / EL-AS)...)элементы из lst, которые внутри ее идентифицируются как переменная EL-LST.
В зависимости от EL-LST вычисляется локальная переменная EL-AS, которая на данном зтапе и есть результат выполнения ф-ции lambda. Однако переменная EL-AS не является целью - она лишь средство для дальнейшей обработки. Нам нужнен второй или третий элемент EL-AS. Если бы не было специальных условий для "-","Уголок" и "\\U+E720", то все было бы совсем просто:

Код:

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

(setq EL-LST '("5" "Лист ромб -10х100x300" "-"))
(setq EL-AS '("Лист ромб" . "ГОСТ 8568-77"))
(cons (cdr EL-AS) EL-LST)
;;;-> ("ГОСТ 8568-77" "5" "Лист ромб -10х100x300" "-")

Т.к. условия есть, а нам нужно получить только одно конкретное слово из EL-AS (а оно может таким: ("-" "ГОСТ 19903-74" "ГОСТ 103-76")) ), используем ф-ию cond.

Код:

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

(defun test ()
  (mapcar
    '(lambda (EL-LST / EL-AS)
       (setq EL-AS
              (car
                (vl-remove-if-not
                  '(lambda (STR)
                     (wcmatch (cadr EL-LST) (strcat (car STR) "*"))
                   ) ;_ end of lambda
                  LST-AS
                ) ;_ end of vl-remove-if-not
              ) ;_ end of car
       ) ;_ end of setq
       (cons
         (cond
           ((equal (car EL-AS) "-")
            1_ф-ция_выбора_конкретрого_ГОСТА
           )
           ((member (car EL-AS) '("Уголок" "\\U+E720"))
            2_ф-ция_выбора_конкретрого_ГОСТА
           )
           (t (cdr EL-AS))
         ) ;_ end of cond
         EL-LST
       ) ;_ end of cons
     ) ;_ end of lambda
    lst
  ) ;_ end of mapcar
) ;_ end of defun
;;;(test)
;;;((nil "1" "-10х100x100" "-") (nil "3" "Уголок 75х5" "-") ("ГОСТ 8568-77" "5" "Лист ромб -10х100x300" "-") ("ГОСТ 103-76" "9" "Полоса -4х50" "U+03A3L=10000"))

Осталась совсем мелочь - сделать ф-ции_выбора_конкретрого_ГОСТА
1. Ф-ция для "-" :

Код:

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

(if (equal (caddr EL-LST) "-")
  (cadr EL-AS)
  (caddr EL-AS)
) ;_ end of if

2. Ф-ция для "Уголок" и "\\U+E720" :

Код:

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

(if
  ((lambda (STR)
     (equal
       (vl-string-position (ascii "x") STR)
       (vl-string-position (ascii "x") STR nil t)
     ) ;_ end of equal
   ) ;_ end of lambda
    (vl-string-translate "х" "x" (cadr EL-LST))
  )
   (cadr EL-AS)
   (caddr EL-AS)
) ;_ end of if

Вставляй их в test и проверяй ее работу...

[Red Nova]

Спасибо, все работает
Соединив все коды, на данный момент имеем

Код:

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

(defun C:ntt ( / CB-filtr lst) ;note to text
  (defun CB-filtr (lst)
    (setq lst
           (vl-remove-if
             '(lambda (x)
                (or
                  (not (equal (length x) 2))
                  (member "" x)
                  (not
                    (wcmatch
                      (vl-string-translate "Tp" "Тр" (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
(setq lst 
 (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 setq




(setq LST-AS
       (apply
         'append
         (mapcar
           '(lambda (X Y)
              (mapcar
                '(lambda (Z)
                   (cons Z Y)
                 ) ;_ end of lambda
                X
              ) ;_ end of mapcar
            ) ;_ end of lambda
           (list (list "Лист -" "Лист-" "Фл")
                 (list "Лист чечевица" "Лист ромб")
                 (list "-")
                 (list "Полоса")
                 (list "Уголок" "\\U+E720")
                 (list "\\U+E72E")
                 (list "Тр")
                 (list "Двутавр" "\\U+E729")
                 (list "Швеллер" "\\U+E725")
                 (list "%%c" "\\U+E712")
           ) ;_ end of list
           (list "ГОСТ 19903-74"
                 "ГОСТ 8568-77"
                 (list "ГОСТ 19903-74" "ГОСТ 103-76")
                 "ГОСТ 103-76"
                 (list "ГОСТ 8509-93" "ГОСТ 8510-86")
                 "ГОСТ 30245-03"
                 "ГОСТ 10704-91"
                 "ГОСТ 8239-89"
                 "ГОСТ 8240-97"
                 "ГОСТ 5781-82"
           ) ;_ end of list
         ) ;_ end of mapcar
       ) ;_ end of apply
) ;_ end of setq LST-AS



  (mapcar
    '(lambda (EL-LST / EL-AS)
       (setq EL-AS
              (car
                (vl-remove-if-not
                  '(lambda (STR)
                     (wcmatch (cadr EL-LST) (strcat (car STR) "*"))
                   ) ;_ end of lambda
                  LST-AS
                ) ;_ end of vl-remove-if-not
              ) ;_ end of car
       ) ;_ end of setq
    (cons
     (car EL-LST)
       (cons
         (cond
           ((equal (car EL-AS) "-")
           (if (equal (caddr EL-LST) "-")
            (cadr EL-AS)
            (caddr EL-AS)
           ) ;_ end of if
           )
           ((member (car EL-AS) '("Уголок" "\\U+E720"))
             (if
               ((lambda (STR)
                  (equal
                    (vl-string-position (ascii "x") STR)
                    (vl-string-position (ascii "x") STR nil t)
                  ) ;_ end of equal
                ) ;_ end of lambda
                 (vl-string-translate "х" "x" (cadr EL-LST))
               )
                (cadr EL-AS)
                (caddr EL-AS)
             ) ;_ end of if
           )
           (t (cdr EL-AS))
         ) ;_ end of cond
         (cdr EL-LST)
       ) ;_ end of cons
      ) ;_ end of cons
     ) ;_ end of lambda
    lst
  ) ;_ end of mapcar
) ;_ end of defun ntt

Теперь требуется переписать содержание этого списка в существующий шаблон спецификации. То есть, когда закончили выбирать все выноски, нажимаем enter, отмечаем рамкой шаблон спецификации из мтекстов или текстов, который содержит обязательно четыре столбца и n-ное количество строк. После чего данные вписываются в спецификацию. Принцип вписывания довольно прост (по крайней мере его логика). Элементы первого подсписка должны по очереди вписаться в мтексты первой строки, и так далее.
В качестве ориентира служат координаты мтекстов. Тут (кстати именно этим кодом я потом буду рассчитывать полученную спецификацию)VVA в коде применяет нечто подобное, там учтена возможность неидеального совпадения координат мтекстов.
Если отмечая шаблон мы захватим более или менее четырех столбцов, выходит сообщение об ошибке, то же происходит, если выбрать меньше строк чем есть элементов в списке. Но если выбрать больше строк чем требуется, то лисп должен заполнить все верхние строки нормально, а в лишние записать ####.


P.S. Я кстати добавил Тр.*,Tp.*,Тp.*,Tр.* в первый фильтр, (так и не понял куда твоу функцию вклеить, так вышло даже проще).

[CB]

>Red Nova
1. "Вклеить" функцию нужно здесь:

Код:

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

.........................
                    (wcmatch
                      (vl-string-translate "Tp" "Тр" (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
..................................................

Кстати, сюда же можно воткнуть и замену х, соответственно убрав эту замену отсюда:
Имеется:

Код:

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

             (if
               ((lambda (STR)
                  (equal
                    (vl-string-position (ascii "x") STR)
                    (vl-string-position (ascii "x") STR nil t)
                  ) ;_ end of equal
                ) ;_ end of lambda
                 (vl-string-translate "х" "x" (cadr EL-LST))
               )
                (cadr EL-AS)
                (caddr EL-AS)
             ) ;_ end of if

Должно быть:

Код:

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

              (if
                   (equal
                    (vl-string-position (ascii "x") (cadr EL-LST))
                    (vl-string-position (ascii "x") (cadr EL-LST) nil t)
                  ) ;_ end of equal
                (cadr EL-AS)
                (caddr EL-AS)
             ) ;_ end of if

Потренируйся...
2. Так, как ты соединил, не будет работать окончательная сортировка
Имеется:

Код:

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

............................
  ) ;_ end of setq
  (mapcar
    '(lambda (x) (nth x lst))
    (vl-sort-i
............................
      '<
    ) ;_ end of vl-sort-i
  ) ;_ end of mapcar
.............................

Должно быть:

Код:

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

............................
  ) ;_ end of setq
(setq lst
  (mapcar
    '(lambda (x) (nth x lst))
    (vl-sort-i
............................
      '<
    ) ;_ end of vl-sort-i
  ) ;_ end of mapcar
 ) ;_ end of setq
.............................

[Red Nova]

Поправил #37. Назвал команду ntt (note to text).
Странное дело. Обнаружил что на домашнем компе лисп по сих пор работает неправильно, хотя на работе все нормально. Это касается позиций с именами типа a2 a3 a4...b2 b3 b4... . Они вообще не попадают в список. Я и раньше встречал такого типа мистические несоответствия. Тогда так и не удалось с этим справиться. Может есть возможность как-то модифицировать код так, чтобы он делал то же но чуть по другому. Может тогда все наладится?

[Red Nova]

Вот пример в котором показано как заполнить шаблон спецификации из полученного списка.
(Оказывается я перепутал первые два столбца метсами. Вместо ГОСТ, Позиция должно быть Позиция потом ГОСТ).