Копирование данных для спецификаций из выносок СПДС в таблицу из мтекстов

Red Nova · 23.09.2008, 22:49

Если кто еще не знает, то тут 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

dextron3 · 23.10.2008, 21:46

CB, не могу понять что я делаю не так?

Command:
NTT
Select objects: Specify opposite corner: 1 found

Select objects:
; error: no function definition: _DWGRU-CONV-PICKSET-TO-LIST

Red Nova · 23.10.2008, 22:33

В библиотеке есть.

Кулик Алексей aka kpblc · 23.10.2008, 22:40

Исходник (_dwgru-conv-pickset-to-list)

dextron3 · 24.10.2008, 06:16

Кулик Алексей aka kpblc, спасибо, почему нельзя в один лисп все загнать?

Red Nova, буду тестировать, но я работаю с отдельными текстами, а не м текстами,

СВ, хотел спросить я обычно вместо диаметра иногда букву Ф (Федя) пишу, это в лиспе предусмотрено?

буду усиленно тестировать...

Кулик Алексей aka kpblc · 24.10.2008, 08:51

Цитата:

почему нельзя в один лисп все загнать?

А смысл? Функция преобразования набора примитивов в список используется не только в этой задаче.

dextron3 · 24.10.2008, 17:57

Red Nova, а выноски для болтов гаек, и остальных профилей как выглядят?

Red Nova · 25.10.2008, 11:11

dextron3, Таких нема. Я обычно их отдельной спецификацией делаю, и без нумерации.

dextron3 · 25.10.2008, 19:31

Мои замечания по работе программы:

1. Не узнает двутавры Б1, Б2 по госту ГОСТ 26020-83 и СТО АСЧМ 20-93
2. Подскажи где можно редактировавть распозновательные функции, чтобы я мог сам забить недостающие элементы. (согласно пункту 1), хотелось бы видеть эту часть кода. (есть ли возможность не только по префиксу но и по суффиксу выполнять детектирование)
3. Можно ли установить параметр КОЛ-ВО, после длины, в нижней части выноски, это бы вообще полностью автоматизировало процесс проектирования.

Идея мне понравилась буду тестировать по полной, я ведь заядлый пользователь СПДС

dextron3 · 25.10.2008, 19:43

4. Госты гнуты профилей квадратных и прямоугольных почемуто не различает...

Red Nova · 25.10.2008, 23:49

dextron3,
Добавить двутавры Б1, Б2 по госту ГОСТ 26020-83 или по СТО АСЧМ 20-93 (а оставить в любом случае нужно только один из них) можно, и по логике не очень сложно, но одно дело логика, а другое программирование, и нам с тобой этого не одолеть. Без помощи СВ не обойтись.
А логика такая.
Вот в этом месте

Код:

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

           (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

Производится назначение ГОСТ-ов разным профилям. Проблема в том, что сейчас, если профиль начинается на "Двутавр" или "\\U+E729" то он автоматически причисляется к "ГОСТ 8239-89". Чтобы распознавался ГОСТ 26020-83, нужно усложнить условие для этого профиля.
Профиль для этого ГОСТа имеет свое специфическое обозначение. Пишется к примеру "Двутавр 20Б1"
Причем
1. Вместо буквы "Б" могут быть и буквы "К" и "Ш"
2. Вместо "Двутавр" может быть знак двутавра шрифта СПДС "\\U+E729"
3. Номера двутавров бывают не только двузначными, но и трехзначными (к примеру 100Ш1).
Следовательно чтобы различить ГОСТ 26020-83 и ГОСТ 8239-89 нужно проверить что написано после "Двутавр". Если после этого идут две или цифры, и после этого сразу (без пробела) буквы "Б", "К" или "Ш", то это ГОСТ 26020-83 иначе это ГОСТ 8239-89.

P.S. Если по каким то причинам нужен именно СТО АСЧМ 20-93, то поскольку там принцип написания тот же, то нужно будет просто вместо ГОСТ 26020-83 написать СТО АСЧМ 20-93.

P.P.S.

Цитата:

хотел спросить я обычно вместо диаметра иногда букву Ф (Федя) пишу, это в лиспе предусмотрено?

От плохих привычек надо отвыкать...

dextron3 · 26.10.2008, 18:26

Red Nova, будем ждать VVA и СВ, а почему не сформировал ТЗ сразу с часто используемыми профилями?

можно было конечно делать \\U+E729Б1 а потом размер указывать, что ты на это скажешь, или ГОСТЫ так не разрешают?

Объясни принцип действия кода, какми образом определяются равнополочные и разнополочные уголки, хотябы

VVA · 26.10.2008, 20:43

Red Nova, В общем мыслишь в правильном направлении.

Цитата:

Проблема в том, что сейчас, если профиль начинается на "Двутавр" или "\\U+E729" то он автоматически причисляется к "ГОСТ 8239-89"

Шаблон для двутавров СТО АЧСМ нужно разместить в списке выше шаблона для двутавра
Примерно так (выделил красным)

Код:

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

(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))
;;;                  "*E72E*,Труба*,Тр.*,Лист*,Полоса*,*E720*,Уголок*,*E725*,Швеллер*,*E729*,Двутавр*,Фланец*,Фл.*,-*,%%c*,*E712*,#%%c*,# %%c*,##%%c*,## %%c*,#*E712*,# *E712*,##*E712*,## *E712*"
                  "\\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 "Двутавр ##Б" "Двутавр ##К" "Двутавр ##Ш") ;_ Двузначный номер Двутавра
		   (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"
		   "СТО АСЧМ 20-93" ;_ГОСТ _Для двузначного номера
		   "СТО АСЧМ 20-93" ;_ГОСТ _Для трехзначного номера
                   "ГОСТ 8239-89" ;;Двутавр
                   "ГОСТ 8240-97"
                   "ГОСТ 5781-82"
             ) ;_ 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 · 26.10.2008, 21:33

VVA,
Да, то что можно новый код просто строкой раньше написать я не догодался

. Вот мой вариант, на основе твоего, я еще добавил cимвол двутавра СПДС и учел вероятность отсутствия пробела. Получилось на все случаи.

Код:

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

(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))
;;;                  "*E72E*,Труба*,Тр.*,Лист*,Полоса*,*E720*,Уголок*,*E725*,Швеллер*,*E729*,Двутавр*,Фланец*,Фл.*,-*,%%c*,*E712*,#%%c*,# %%c*,##%%c*,## %%c*,#*E712*,# *E712*,##*E712*,## *E712*"
                  "\\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 ##Б" "\\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")
                   (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"
		   "СТО АСЧМ 20-93" ;_ГОСТ _Для двузначного номера
		   "СТО АСЧМ 20-93" ;_ГОСТ _Для трехзначного номера
                   "ГОСТ 8239-89" ;;Двутавр
                   "ГОСТ 8240-97"
                   "ГОСТ 5781-82"
             ) ;_ 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 · 26.10.2008, 21:37

dextron3,

Цитата:

а почему не сформировал ТЗ сразу с часто используемыми профилями?

А у тебя какие есть соображения на этот счет?

Цитата:

можно было конечно делать \\U+E729Б1 а потом размер указывать, что ты на это скажешь, или ГОСТЫ так не разрешают?

Эту часть сообщения я вообще не понял

Цитата:

Объясни принцип действия кода, какми образом определяются равнополочные и равнополочные уголки, хотябы

Условно принято что равнополочные уголки записываются коротко, к примеру
Уголок 75х5, а не Уголок 75х75х5
Таким образом получается зацепка для отличия от неравнополочных. В одном случае только один х а во втором – два

dextron3 · 26.10.2008, 21:41

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

Red Nova · 27.10.2008, 11:37

А у меня нормально...

dextron3 · 27.10.2008, 12:36

Вот видеоролик совсем все не так....

CB · 27.10.2008, 13:16

У тебя одинаковые позиции...

Red Nova · 27.10.2008, 13:45

CB, Выложи dwg

CB · 27.10.2008, 14:06

Какое еще dwg? Я посмотрел ролик и увидел...

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Сейсмозащита и сейсмоизоляция существующих, построенных зд.	IANationalInformAgentstvo	Прочее. Архитектура и строительство	216	20.01.2015 16:51
Предложения по расчетным моделям сооружений	aldt	Расчетные программы	8	06.07.2009 17:53
Программа для разработки спецификаций в MS Excel	Бриг	Прочее. Программное обеспечение	5	27.09.2007 08:38
Создание форматки для СПДС	Владимир М	Программирование	2	22.09.2006 23:17
Программы для разработки спецификаций	assenizator	AutoCAD	6	04.02.2005 13:34