| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Копирование данных для спецификаций из выносок СПДС в таблицу из мтекстов

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

Ответ
Поиск в этой теме
Непрочитано 23.09.2008, 22:49
Копирование данных для спецификаций из выносок СПДС в таблицу из мтекстов
Red Nova
 
ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Торонто
Регистрация: 23.10.2007
Сообщений: 1,980

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

Вложения
Тип файла: dwg
DWG 2004
Выноски СПДС.dwg (76.0 Кб, 10253 просмотров)

__________________
Блог
Просмотров: 49855
 
Автор темы   Непрочитано 11.10.2008, 19:47
#41
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,980
Отправить сообщение для Red Nova с помощью Skype™


Пробовал написать функцию для того чтобы поменять первые два элемента подсписков местами. Что я делаю не правильно.
Код:
[Выделить все]
(defune test1 (/ lst lst1 lst2 lst3)

(setq lst '(("ГОСТ 19903-74" "1" "-10х100x100" "-") ("ГОСТ 19903-74" "2" "Лист 
-10х100x100" "-") ("ГОСТ 19903-74" "3" "Фл. ?300х8" "-"))
) ;_ end of setq

(setq lst1
(mapcar
‘car
lst
) ;_ end of mapcar
) ;_ end of setq

(setq lst2
(mapcar
‘cadr
lst
) ;_ end of mapcar
) ;_ end of setq

(setq lst3
(mapcar
‘(cdr(cdr))
lst
) ;_ end of mapcar
) ;_ end of setq


(setq lst
(mapcar
'(lambda ( x y z)
(append ('x 'y 'z))
) ;_ end of lambda
lst2 lst1 lst3
) ;_ end of mapcar
) ;_ end of defun
__________________
Блог

Последний раз редактировалось Red Nova, 11.10.2008 в 20:42.
Red Nova вне форума  
 
Непрочитано 11.10.2008, 23:27
#42
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


> Red Nova
Код:
[Выделить все]
(mapcar
  '(lambda (x)
     (cons (cadr x) (cons (car x) (cddr x)))
   )
  lst
)
Только менять нужно не здесь - сколько же можно издеваться и насиловать этот несчастный список ...
Код:
[Выделить все]
       ) ;_ 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
CB вне форума  
 
Автор темы   Непрочитано 12.10.2008, 10:57
#43
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,980
Отправить сообщение для Red Nova с помощью Skype™


Спасибо
Цитата:
Только менять нужно не здесь - сколько же можно издеваться и насиловать этот несчастный список ...
Знаю конечно же. Просто разбираться в твоем коде для меня было нереально, а попробовать написать функцию было еще возможно. А почему мой вариант не работал?
__________________
Блог
Red Nova вне форума  
 
Автор темы   Непрочитано 12.10.2008, 22:01
#44
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,980
Отправить сообщение для Red Nova с помощью Skype™


Подскажите какими функциями надо орудовать для записи полученного списка в мтексты (как в показанно #40).
__________________
Блог
Red Nova вне форума  
 
Непрочитано 13.10.2008, 15:20
#45
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


Без проверки на то, что при выбора шаблона могут быть выделены не четыре колонки, а 3 или 5... Цифрой, выделенной красным цветом (в данном случае это 1мм) можно регулировать условие, при котором считается, что тексты находятся на одной строке...
Код:
[Выделить все]
(defun fill-sp (lst)
  (mapcar
    '(lambda (A B)
       ((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
    (apply 'append lst)
    ((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 mapcar
  (princ)
) ;_ end of defun
CB вне форума  
 
Автор темы   Непрочитано 13.10.2008, 15:43
#46
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,980
Отправить сообщение для Red Nova с помощью Skype™


Спасибо. Не очень уверен что я соеденил функции как надо.
Код:
[Выделить все]
(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




(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


  (mapcar
    '(lambda (A B)
       ((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
    (apply 'append lst)
    ((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 mapcar
  (princ)

 
) ;_ end of defun ntt
Вложения
Тип файла: dwg
DWG 2004
Спецификация2.dwg (68.5 Кб, 1007 просмотров)
__________________
Блог

Последний раз редактировалось Red Nova, 13.10.2008 в 17:38.
Red Nova вне форума  
 
Непрочитано 13.10.2008, 16:41
#47
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


Код:
[Выделить все]
...............................................
                 "ГОСТ 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
..............................................
      ) ;_ end of cons
     ) ;_ end of lambda
    lst
  ) ;_ end of mapcar
) ;_ end of setq
 
 
  (mapcar
    '(lambda (A B)
.............................
CB вне форума  
 
Автор темы   Непрочитано 13.10.2008, 17:35
#48
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,980
Отправить сообщение для Red Nova с помощью Skype™


Спасибо. Исправил #46
А можно сделать так, чтобы во все мтексты, которые лишние (то есть если выбранных строк больше чем позиций) вписывалось ##, ато теперь они не трогаются
__________________
Блог
Red Nova вне форума  
 
Автор темы   Непрочитано 13.10.2008, 22:23
#49
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,980
Отправить сообщение для Red Nova с помощью Skype™


Еще есть одна просьба по поводу выбора мтекстов. Хотя это не так принципиально, и лисп в общем точно решает поставленную цель. Но хотелось бы чтобы при выборе мтекстов чертилась рамка (разумеется она потом должна удалиться) и был включен оснап. Если это сложно реализовать, то и так как сейчас пойдет разумеется.
__________________
Блог
Red Nova вне форума  
 
Непрочитано 14.10.2008, 10:36
#50
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


>Red Nova #48
Замени последнюю ф-цию на эту
Код:
[Выделить все]
((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
)
>Red Nova #49
Абсолютно не понял на кой ...
Как я догадываюсь, что следующим шагом должна по идее последовать просьба типа такой - а можно сделать так, что если выбранных позиций больше чем выбранных мтекстов, то дорисовать спецификацию и добавить недостающие в ней строки...
CB вне форума  
 
Непрочитано 14.10.2008, 10:42
#51
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


И, если количество строк больше Х (или высота таблицы больше N мм), нарисовать "рядом" еще одну таблицу, продолжающую спецификацию
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 14.10.2008, 14:26
#52
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,980
Отправить сообщение для Red Nova с помощью Skype™


Я же написал.
Цитата:
Если это сложно реализовать, то и так как сейчас пойдет разумеется.
Просто лисп для расчета спеки от VVA так работает, хотелось однообразия. Но это не важно.
За #48 спасибо.
Вот видеоролик с примером работы лиспов от CB и VVA.
Вложения
Тип файла: rar Пример ntt+spec5d.rar (131.5 Кб, 592 просмотров)
__________________
Блог

Последний раз редактировалось Red Nova, 14.10.2008 в 14:36.
Red Nova вне форума  
 
Автор темы   Непрочитано 14.10.2008, 14:46
#53
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,980
Отправить сообщение для Red Nova с помощью Skype™


Последний вариант
Код:
[Выделить все]
(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




(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 вне форума  
 
Непрочитано 14.10.2008, 15:43
#54
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


Все равно не понял - зачем чертить рамку с включенным osnap'ом, а потом тут же ее убивать? Естественно это сделать совсем не сложно, но зачем?
Теперь объясни, что будет если ты отфильтруешь например 15 выносок, а строк в спецификации будет 10? Куда девать оставшиеся 5? Ведь нет даже простой инфы о количестве элементов в отфильтрованном списке...
CB вне форума  
 
Автор темы   Непрочитано 14.10.2008, 15:53
#55
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,980
Отправить сообщение для Red Nova с помощью Skype™


Цитата:
Все равно не понял - зачем чертить рамку с включенным osnap'ом, а потом тут же ее убивать
Просто VVA как-то сделал такое, и мне понравилось, но это конечно же мелочи и рассчитаны на любителя. А главное это то что все работает
Цитата:
Теперь объясни, что будет если ты отфильтруешь например 15 выносок, а строк в спецификации будет 10? Куда девать оставшиеся 5?
Хорошо бы было если бы в таком случае выходило сообщение о соответствующем несоответствии. Такого рода сообщение можно предусмотреть и на случаи несоответствия количества столбцов (когда не 4)
__________________
Блог
Red Nova вне форума  
 
Непрочитано 14.10.2008, 22:07
#56
dextron3

проектировшик
 
Регистрация: 01.01.2007
СССР
Сообщений: 5,143


Command: (LOAD "C:/Documents and Settings/Admin/Рабочий стол/Копия summa.lsp")
C:NTT

Command: NTT
; error: no function definition: _DWGRU-GET-SPDS-TEXT-AND-RANGE
__________________
инженер проектировшик с опттом программа авто гад образование высшие
dextron3 вне форума  
 
Автор темы   Непрочитано 14.10.2008, 23:22
#57
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,980
Отправить сообщение для Red Nova с помощью Skype™


http://forum.dwg.ru/showpost.php?p=290874&postcount=472
__________________
Блог
Red Nova вне форума  
 
Автор темы   Непрочитано 15.10.2008, 15:09
#58
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,980
Отправить сообщение для Red Nova с помощью Skype™


CB
Вот и применил заветный лисп в первый раз. Работу облегчает заметно.
Вот что обнаружил.
Имею две выноски с одинаковой позицией
Код:
[Выделить все]
“1” “Ø10 А500с, L=1550”
“1” “ Ø10 А500с, шаг 150”
По задумке из этих двух в спецификацию должна пройти первая, и должно было записаться
Код:
[Выделить все]
“1” “ГОСТ 5781-82” “Ø10 А500с” “L=1550”
Но проходит вторая выноска, и в конце получаем
Код:
[Выделить все]
“1” “ГОСТ 5781-82” “Ø10 А500с” “L=”
В остальном все работает как надо.
__________________
Блог

Последний раз редактировалось Red Nova, 15.10.2008 в 20:50.
Red Nova вне форума  
 
Непрочитано 15.10.2008, 17:43
#59
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


Не понял почему у тебя хоть что-то проходит? Они должны отфильтроваться.
Цитата:
строка должна начинаться на определенные символы, вот их список
- Знак “-”, слова “Лист” и “Полоса”
- Слово “Труба”, “Тр.” и знак трубы из шрифтов СПДС
- Слово “Уголок” и аналогичные символы из шрифтов СПДС
- Слово “Двутавр” и аналогичные символы из шрифтов СПДС
- Слово “Швеллер” и аналогичные символы из шрифтов СПДС
- Слово “Фланец”, то же “Фл.”
- Стандартный знак диаметра и знак диаметра из шрифтов СПДС
- Символ квадратной трубы из шрифтов СПДС
CB вне форума  
 
Автор темы   Непрочитано 15.10.2008, 19:03
#60
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,980
Отправить сообщение для Red Nova с помощью Skype™


Блин, на форуме знак диаметра отобразился как буква Ш, а я не заметил.
__________________
Блог
Red Nova вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Копирование данных для спецификаций из выносок СПДС в таблицу из мтекстов

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Сейсмозащита и сейсмоизоляция существующих, построенных зд. 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