[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

[Red Nova]

Дык то что у него позиции совподают не должно ведь влиять на очередность

[CB]

А это что?

А. Необходимо удалить дублирующие элементы. Видно, что некоторые элементы дублируются абсолютно идентично. ("1" "-10х100x200") ("1" "-10х100x200) А у некоторых одинаков только номер позиции ("2" "Швеллер 12, L=1000, шаг 1000") ("2" "Швеллер 12, L=1000") ("2" "Швеллер 12") ("5" "8 20 А500c, L=1000") ("5" "8 20 А500c") Для правильной фильтрации дублирующих элементов Необходимо произвести сравнение первых и вторых элементов подсписка. Если оба элемента идентичны, то оставляем только один подсписок. Если идентичны только номера позиций, а содержание разное, то надо оставить на первом этапе более длинный подсписок.

И еще...
Сильно не проверял, но по моему вместо:

Код:

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

........................................
(list "Двутавр ##Б" "Двутавр ##К" "Двутавр ##Ш" "\\U+E729 ##Б" "\\U+E729 ##К" "\\U+E729 ##Ш" "Двутавр##Б" "Двутавр##К" "Двутавр##Ш" "\\U+E729##Б" "\\U+E729##К" "\\U+E729##Ш") ;_ Двузначный номер Двутавра
(list "Двутавр ###Б" "Двутавр ###К" "Двутавр ###Ш" "\\U+E729 ###Б" "\\U+E729 ###К" "\\U+E729 ###Ш" "Двутавр###Б" "Двутавр###К" "Двутавр###Ш" "\\U+E729###Б" "\\U+E729###К" "\\U+E729###Ш") ;_ Трехзначный номер Двутавра
(list "Двутавр" \\U+E729)
.............................................................................
"СТО АСЧМ 20-93" ;_ГОСТ _Для двузначного номера
"СТО АСЧМ 20-93" ;_ГОСТ _Для трехзначного номера
"ГОСТ 8239-89" ;;Двутавр
.....................................

Можно попроще...

Код:

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

.................................
(list "Двутавр*#*#[БКШ]" "\\U+E729*#*#[БКШ]")
(list "Двутавр" \\U+E729)
..........................................
"СТО АСЧМ 20-93" 
"ГОСТ 8239-89" ;;Двутавр

[Red Nova]

CB,

А это что? Цитата:А. Необходимо удалить дублирующие элементы. Видно, что некоторые элементы дублируются абсолютно идентично. ("1" "-10х100x200") ("1" "-10х100x200) А у некоторых одинаков только номер позиции ("2" "Швеллер 12, L=1000, шаг 1000") ("2" "Швеллер 12, L=1000") ("2" "Швеллер 12") ("5" "8 20 А500c, L=1000") ("5" "8 20 А500c") Для правильной фильтрации дублирующих элементов Необходимо произвести сравнение первых и вторых элементов подсписка. Если оба элемента идентичны, то оставляем только один подсписок. Если идентичны только номера позиций, а содержание разное, то надо оставить на первом этапе более длинный подсписок.

Все верно. Есть такое. Но причем тут поочередность окончательного списка?

Можно попроще... Код: ................................. (list "Двутавр*#*#[БКШ]" "\\U+E729*#*#[БКШ]") (list "Двутавр" \\U+E729) .......................................... "СТО АСЧМ 20-93" "ГОСТ 8239-89" ;;Двутавр

Мда. Опять я делаю лоботомию через задний проход

[dextron3]

Вот вам файл ДВЖ, не работает даже для одной позиции не говоря уже о списке...

[Red Nova]

Все ясно. У тебя тексты по координате У не сошлись.

[dextron3]

Red Nova, ты невидел еще как тетки чертят, там понятие координаты даже неудобно применять, как можно исправить этот баг?

Код:

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

(list "\\U+E729##Б1" "\\U+E729##Б2" "\\U+E729##К1" "\\U+E729##К2" "\\U+E729##К3" "\\U+E729##К4" "\\U+E729##К5" "\\U+E729##Ш1" "\\U+E729##Ш2" "\\U+E729##Ш3") ;_ Двузначный номер Двутавра
		   (list "\\U+E729###Б1" "\\U+E729###Б2" "\\U+E729###К1" "\\U+E729###К2" "\\U+E729###К3" "\\U+E729###К4" "\\U+E729###К5" "\\U+E729###Ш1" "\\U+E729###Ш2" "\\U+E729###Ш3") ;_ Трехзначный номер Двутавра

[Red Nova]

dextron3, Это не баг. Прочти #45, все можно настроить.

[dextron3]

Red Nova, я еще не изучил язык, поясни где можно настроить, чтобы перепад считываемых текстов был не больше высоты самих текстов, как +Y так и -Y буду ждать совета...

[Red Nova]

dextron3, Не ленись. Пойди на #45, там СВ как раз объяснил то что ты от меня хочешь. А язых тут не причем.

[dextron3]

Red Nova, спасибо я сообразил, мучают вопросы:

1. Будет ли лисп развиваться дальше или уже работать над ним самомстоятельно?
2. Будем ли его унифицировать?

[Red Nova]

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

[dextron3]

Red Nova,
для арматуры неплох параметр количество:

1. Ф25, L=800, 25шт.
и запись в ячейку количество, можно для этого проработать отдельный лисп, так как тут прийдется на 1 текст больше выделять,

вспомни когда ты ДЖ или плиту рисуешь, а заказчик говорит что ему детальное армирование надобно, а у тебя времени нет блох ловить, вот тут бы и пригодилась данная автоматизация....


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

2. PS Если дейстивтельно нужно то скажи я впринцепе могу и без этого обходится....

3. Я люблю профили значками изображать, да вот спдсный шрифт не на всех компах изображается корректно, что тут можно было бы сдеать?


4. Где можно в лиспе заменить диаметр на букву Ф (Федя)

[Red Nova]

1. У меня честно говоря такого не бывало, количество никогда в выноске не писал. По части разработки отдельного лиспа - это не ко мне. Я в программировании такой же чурбан как и ты.
2. Не понял что мне "действительно нужно".
3. Не знаю в чем проблемма с шрифтом СПДС, но лучше решить ее, чем извращятся с лиспом.
4. Это возможно, но у меня не получилось.

СВ После работы лиспа в ком строку выбрасывается куча ненужной информации. Как от этого избавиться?

Код:

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

Select objects:
el") (8 . "0") (100 . "AcDbMText") (10 43768.6 -18792.4 0.0) (40 . 62.5) (41 . 
547.212) (46 . 175.0) (71 . 4) (72 . 1) (1 . "XX") (7 . "GOST 2.304") (210 0.0 
0.0 1.0) (11 1.0 0.0 0.0) (42 . 100.0) (43 . 62.5) (50 . 0.0) (73 . 1) (44 . 
1.0)) ((-1 . <Entity name: 7ef15df8>) (0 . "MTEXT") (330 . <Entity name: 
7ef11cc0>) (5 . "29017") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . 
"0") (100 . "AcDbMText") (10 41690.8 -18968.2 0.0) (40 . 62.5) (41 . 250.0) (46 
. 173.307) (71 . 5) (72 . 1) (1 . "XX") (7 . "GOST 2.304") (210 0.0 0.0 1.0) 
(11 1.0 0.0 0.0) (42 . 100.0) (43 . 62.5) (50 . 0.0) (73 . 1) (44 . 1.0)) ((-1 
. <Entity name: 7ef15808>) (0 . "MTEXT") (330 . <Entity name: 7ef11cc0>) (5 . 
"28F09") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (100 . 
"AcDbMText") (10 42315.8 -18967.4 0.0) (40 . 62.5) (41 . 1000.0) (46 . 175.0) 
(71 . 5) (72 . 1) (1 . "XX") (7 . "GOST 2.304") (210 0.0 0.0 1.0) (11 1.0 0.0 
0.0) (42 . 100.0) (43 . 62.5) (50 . 0.0) (73 . 1) (44 . 1.0)) ((-1 . <Entity 
name: 7ef15820>) (0 . "MTEXT") (330 . <Entity name: 7ef11cc0>) (5 . "28F0C") 
(100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (100 . "AcDbMText") (10 
42917.7 -18967.4 0.0) (40 . 62.5) (41 . 850.0) (46 . 175.0) (71 . 4) (72 . 1) 
(1 . "XX") (7 . "GOST 2.304") (210 0.0 0.0 1.0) (11 1.0 0.0 0.0) (42 . 100.0) 
(43 . 62.5) (50 . 0.0) (73 . 1) (44 . 1.0)) ((-1 . <Entity name: 7ef15818>) (0 
. "MTEXT") (330 . <Entity name: 7ef11cc0>) (5 . "28F0B") (100 . "AcDbEntity") 
(67 . 0) (410 . "Model") (8 . "0") (100 . "AcDbMText") (10 43768.6 -18967.4 
0.0) (40 . 62.5) (41 . 547.212) (46 . 175.0) (71 . 4) (72 . 1) (1 . "XX") (7 . 
"GOST 2.304") (210 0.0 0.0 1.0) (11 1.0 0.0 0.0) (42 . 100.0) (43 . 62.5) (50 . 
0.0) (73 . 1) (44 . 1.0)))tity name: 7ef158b8>) (0 . "MTEXT") (330 . <Entity 
name: 7ef11cc0>) (5 . "28F1F") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 
. "0") (100 . "AcDbMText") (10 42315.8 -18617.4 0.0) (40 . 62.5) (41 . 1000.0) 
(46 . 175.0) (71 . 5) (72 . 1) (1 . "XX") (7 . "GOST 2.304") (210 0.0 0.0 1.0) 
(11 1.0 0.0 0.0) (42 . 100.0) (43 . 62.5) (50 . 0.0) (73 . 1) (44 . 1.0)) ((-1 
. <Entity name: 7ef158d0>) (0 . "MTEXT") (330 . <Entity name: 7ef11cc0>) (5 . 
"28F22") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (100 . 
"AcDbMText") (10 42917.7 -18617.4 0.0) (40 . 62.5) (41 . 850.0) (46 . 175.0) 
(71 . 4) (72 . 1) (1 . "XX") (7 . "GOST 2.304") (210 0.0 0.0 1.0) (11 1.0 0.0 
0.0) (42 . 100.0) (43 . 62.5) (50 . 0.0) (73 . 1) (44 . 1.0)) ((-1 . <Entity 
name: 7ef158c8>) (0 . "MTEXT") (330 . <Entity name: 7ef11cc0>) (5 . "28F21") 
(100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (100 . "AcDbMText") (10 
43768.6 -18617.4 0.0) (40 . 62.5) (41 . 547.212) (46 . 175.0) (71 . 4) (72 . 1) 
(1 . "XX") (7 . "GOST 2.304") (210 0.0 0.0 1.0) (11 1.0 0.0 0.0) (42 . 100.0) 
(43 . 62.5) (50 . 0.0) (73 . 1) (44 . 1.0)) ((-1 . <Entity name: 7ef15de8>) (0 
. "MTEXT") (330 . <Entity name: 7ef11cc0>) (5 . "29015") (100 . "AcDbEntity") 
(67 . 0) (410 . "Model") (8 . "0") (100 . "AcDbMText") (10 41690.8 -18793.2 
0.0) (40 . 62.5) (41 . 250.0) (46 . 173.307) (71 . 5) (72 . 1) (1 . "XX") (7 . 
"GOST 2.304") (210 0.0 0.0 1.0) (11 1.0 0.0 0.0) (42 . 100.0) (43 . 62.5) (50 . 
0.0) (73 . 1) (44 . 1.0)) ((-1 . <Entity name: 7ef15860>) (0 . "MTEXT") (330 . 
<Entity name: 7ef11cc0>) (5 . "28F14") (100 . "AcDbEntity") (67 . 0) (410 . 
"Model") (8 . "0") (100 . "AcDbMText") (10 42315.8 -18792.4 0.0) (40 . 62.5) 
(41 . 1000.0) (46 . 175.0) (71 . 5) (72 . 1) (1 . "XX") (7 . "GOST 2.304") (210 
0.0 0.0 1.0) (11 1.0 0.0 0.0) (42 . 100.0) (43 . 62.5) (50 . 0.0) (73 . 1) (44 
. 1.0)) ((-1 . <Entity name: 7ef15850>) (0 . "MTEXT") (330 . <Entity name: 
7ef11cc0>) (5 . "28F12") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . 
"0") (100 . "AcDbMText") (10 42917.7 -18792.4 0.0) (40 . 62.5) (41 . 850.0) (46 
. 175.0) (71 . 4) (72 . 1) (1 . "XX") (7 . "GOST 2.304") (210 0.0 0.0 1.0) (11 
1.0 0.0 0.0) (42 . 100.0) (43 . 62.5) (50 . 0.0) (73 . 1) (44 . 1.0)) ((-1 . 
<Entity name: 7ef15878>) (0 . "MTEXT") (330 . <Entity name: 7ef11cc0>) (5 . 
"28F17") (100 . "AcDbEntity") (67 . 0) (410 . "Mod

[dextron3]

Хотел добавить свое, а у меня чтото не работает, куда еще код прописать или я что то делаю не так?

[Red Nova]

dextron3, Нужно добавить в двух местах. Смотри красным.

Код:

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

(defun c:ntt (/ CB-filtr lst LST-AS)    ;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) ","))
                                   (if (wcmatch (cadr str1) "*L=*")
                                     1
                                     0
                                   ) ;_ end of if
                                ) ;_ end of +
                                (+ (length (poz (cadr str2) ","))
                                   (if (wcmatch (cadr str2) "*L=*")
                                     1
                                     0
                                   ) ;_ end of if
                                ) ;_ end of +
                              ) ;_ 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 '(("22" "Двутавр 20Б1" "-")("1" "-10х100x100" "-") ("2" "Швеллер 12" "L=1000") ("8" "Полоса -4х50" 
;;;"L=1000") ("14" "Уголок 75х5" "L=")))  
  (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
  ) ;_ end of setq
  (setq lst (CB-filtr lst))
  (setq 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+E729")
                   (list "Швеллер" "\\U+E725")
                   (list "%%c" "\\U+E712")
                   (list "Болт")
             ) ;_ end of list
             (list "ГОСТ 19903-74"
                   "ГОСТ 8568-77"
                   (list "ГОСТ 19903-74" "ГОСТ 103-76")
                   "ГОСТ 103-76"
                   (list "ГОСТ 8509-93" "ГОСТ 8510-86")
                   "ГОСТ 30245-03"
                   "ГОСТ 10704-91"
		   "СТО АСЧМ 20-93" 
                   "ГОСТ 8239-89"
                   "ГОСТ 8240-97"
                   "ГОСТ 5781-82"
                   "ГОСТ 7798-703"
             ) ;_ end of list
           ) ;_ end of mapcar
         ) ;_ end of apply
  ) ;_ end of setq LST-AS
  (setq lst
         (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 setq
  ((lambda (/ b1 a1 a2 a3)
     (mapcar
       '(lambda (B A / b1 a1 a2 a3)
          ((lambda (dxf)
             (entmod
               (subst (cons 1 A)
                      (assoc 1 dxf)
                      dxf
               ) ;_ end of subst
             ) ;_ end of entmod
           ) ;_ end of lambda
            (entget B)
          )
        ) ;_ end of lambda
       (setq b1
              ((lambda (/ sset)
                 (princ "\nВыберите шаблон спецификации: ")
                 (if (setq sset (ssget '((0 . "*TEXT"))))
                   (vl-sort
                     (vl-sort
                       (vl-remove-if
                         (function listp)
                         (mapcar (function cadr)
                                 (ssnamex sset)
                         ) ;_ end of mapcar
                       ) ;_ end of vl-remove-if
                       '(lambda (a b)
                          (> (caddr (assoc '10 (entget a)))
                             (caddr (assoc '10 (entget b)))
                          ) ;_ on Y
                        ) ;_ end of lambda
                     ) ;_ end of vl-sort
                     '(lambda (a b)
                        (and
                          (equal (caddr (assoc '10 (entget a)))
                                 (caddr (assoc '10 (entget b)))
                                 1.
                          ) ;_ end of equal
                          (< (cadr (assoc '10 (entget a)))
                             (cadr (assoc '10 (entget b)))
                          ) ;_ end of <
                        ) ;_ end of and
                      ) ;_ end of lambda
                   ) ;_ end of vl-sort
                 ) ;_ end of if
               ) ;_ end of lambda
              )
       ) ;_ end of setq
       (progn
         (setq a1 (apply 'append lst)
               a1
                  (append
                    a1
                    (if (not (minusp (setq a2 (- (length b1) (length a1)))))
                      (append (repeat a2 (setq a3 (cons "XX" a3))))
                    ) ;_ end of if
                  ) ;_ end of append
         ) ;_ end of setq
       ) ;_ end of progn
     ) ;_ end of mapcar
   ) ;_ end of lambda
  )
) ;_ end of defun ntt

[Red Nova]

dextron3, Если будешь добавлять ГОСТы, то не забудь и тут выложить.

[dextron3]

Red Nova, а куда подевались мои решеточки?

[DEM]

Если честно все как то через одно место делается.
Может все таки лучше сделать текстовый файл или *.dat и в нем сдеать соответствующую фильтрацию.

[CB]

>DEM

Если честно все как то через одно место делается

Я это уже давно заметил - не программа, а сплошное латание дыр. Но все же пусть ребята потренируются, может когда-нибудь и сформируется нормальное ТЗ, вот тогда можно будет переписать прогу заново...
>Red Nova

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

Вставь в конце программы (princ)

Код:

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

 
   ) ;_ end of lambda
  )
(princ)
) ;_ end of defun ntt

[ShaggyDoc]

Я это уже давно заметил - не программа, а сплошное латание дыр

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