[wetr]

Те кто видел КОМПАС меня поймут: хочу чтобы ведомость рабочих четрежей заполнялась автоматически. Пользую поля - ссылки на объекты. В моем случае ссылаюсь на блок(рамка) с аттрибутами "№листа" и "наименование листа". Вроде бы все отлично. Убивает трудоемкость создания данной таблицы. Т.е. как я делаю(может не правильно?):
создаем мтекст-вставить поле-объект-выбрать- а дальше проблемка - рамка то находится в лайоутах. А перелистывать лайоуты в режиме выбора нельзя... Приходится сначала открывать лайоут, затем копировать текст вида
"%<\AcObjProp Object(%<\_ObjId 2130566400>%).TextString>%"
в отдельный файл, затем вставлять в нужное мне поле. Есть другие варианты узнать ObjID? Или другие варианты создать эту таблицу?
И еще: в каких случаях меняется этот ID? А то я боюсь теперь эти блоки редактировать - все собьется нафиг
*******************************************************************************************************************
...Прошел год
VVA сделал отличную программу по созданию Ведомости рабочих чертежей (Компас отдыхает)

ВОЗМОЖНОСТИ:
- Ведомость создается в виде таблицы с полями.
- Обязательно использование блока с атрибутами "ЛИСТ" и "НАИМЕНОВАНИЕ.ЧЕРТЕЖА".
- Таблицы вставляется в слое _Таблица. Если слоя нет - он создается. Настройки слоя можно поменять в ЛИСПе
- Таблицы вставляются в Стиле таблиц "Ведомость чертежей" оформленной по ГОСТу. Настройки стиля см. в ЛИСПе
- Запускать командой VRC в командной строке или сделать себе кнопку


ОСОБЕННОСТИ:
- В таблице и блоке используется шрифт "MIPGOST.SHX". Скачать можно здесь. Не нравится? Открывай код и меняй под себя.
- В блок-рамке используется многострочный атрибут, который работает только в AutoCAD 2008 и старше.
Если у вас более ранняя версия - программа будет работать, но атрибут будет однострочный.
- При заполнении многострочного атрибута "НАИМЕНОВАНИЕ.ЛИСТА" не используйте ENTER. Текст перескочит на новую строку сам.(Это актуально если лисп вставляет поля. Варианты лиспа VRCTS и VRCTN отрабатывают без проблем)

ПРО БЛОК:
- Рамка пестрит полями - название проекта заполнять на титульном листе, в рамке обновится
- ШИФР проекта заполнять на титульном листе
- Формат листа - ссылка на lookup внутри блока, обновляется.
- Для того, чтобы количество листов прописывалось автоматом, я сделал себе макрос на кнопку, запускающую VRC

^C^C(setvar "USERI1" (length(layoutlist)));_updatefield;all;;vrc

Внимание! Если у вас используется переменная USERI1, могут возьникнуть проблемы!
**********************

Для тех, кому не нравиться что программа создает стили и слои, вариант от VVA и Red Nova

************************************
***Обновление от 04.02.2008. **********
************************************
Добавлена возможность заполнять таблицу полями, текстом, выбирать или нет листы. Подробности в начале лиспа.
Команды:
VRC - таблица с полями, все листы
VRCTS - таблица с Tекстом, выбор (S) листов
VRCTN - таблица с Tекстом, нет (N) выбора листов
VRCFS - таблица с полями (F), выбор (S) листов

************************************
***Обновление от 06.09.2010. ***********
***********************************
Добавлена возможность выбора стиля таблиц
Версия для x64 : http://forum.dwg.ru/showpost.php?p=349807&postcount=159

[Red Nova]

Начал использовать лисп с поста #5. Появились вопросы.


1. Лисп создает ведомость для всех без исключения чертежей. Как быть если некоторые чертежи не надо туда добавить? К примеру у меня в КМ проекте всегда бывает и лист который мы отправляем на завод изготовителя, а в проект он не входит.
2. Возможно ли добавить еще один столбец (примечание)? Я вставляю в такой столбец поле связанное со свойствами файла (custom properties), там у меня есть строка по имени “Том”, желательно вписать во все строки примечания ее значения (хотя это может не для всех быть универсально, но по госту такой столбец есть). Текст в этой колонке желательно чтобы имел направленность middle center.
3. В Лиспе я нашел некоторые параметры настройки размеров ведомости. Но все настроить мне не удалось. Как я понял высота ячейки для всех общая. Но по госту она разная для разных строк. Хотелось бы настроить по отдельности.
4. Можно ли подчеркнуть название? (как вариант).
5. В столбцах “лист” и “обозначение” перед полями появляется пробел. Для столбца “обозначение” это удобно, так как он имеет левую направленность, и этот пробел отодвигает текст от перегородки. Но столбец “лист” имеет центральную направленность, и в нем желательно этот пробел удалить, так как возникает смещение.
6. Тут думаю что ты помочь не сможешь, так как это свойство поля, пишу на всякий случай. Если в многострочном атрибуте использовать перенос строки (enter), то в поле появляются побочные эффекты в виде “\P” на местах (enter). Сразу же оговорюсь и скажу, что это можно преодолеть задав нужную ширину атрибуту. Тогда enter не нужен.
7. Прости, что вопросов так много.

[VVA]

1. Могу предложить использовать другой штамп (отличаются таги атрибутов)
2. См красным
3. См синим
4. Стандартно для МТЕКСТА. Замени "Ведомость чертежей" на "{\\LВедомость чертежей}"
5. Это не пробел, а отступ. Ищи в коде (vla-put-horzcellmargin tbl 100) ;_Отступ текста по горизонтали
6. Помочь не смогу, так как это поле. Если писать текст, то почистить можно
7. Прощен

Код:

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

;http://dwg.ru/f/showthread.php?t=14548
;АВТО Заполнение ведомости рабочих чертежей
(defun c:vrc (/ adoc alay ss pnt tbl attlst lst fld lock)
  (defun SortStringWithNumberAsNumber (ListOfString IgnoreCase / NorStrs count)
;;;Function Normalize (add 0 befor number) number in string
;;; Count normalize symbols set in variable count
;;; CAB added count as an argument
  (defun NormalizeNumberInString (str count / ch i pat ret buf)
    (setq i   0
          pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
          ret ""
    ) ;_ end of setq
    (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
      (if (vl-position ch pat)
        (progn
          (setq buf ch) ;_ end of setq
          (while
            (vl-position (setq ch (substr str (setq i (1+ i)) 1)) pat)
             (setq buf (strcat buf ch))
          ) ;_ end of while
          (while (< (strlen buf) count) (setq buf (strcat "0" buf)))
          (setq ret (strcat ret buf))
        ) ;_ end of progn
      ) ;_ end of if
      (setq ret (strcat ret ch))
    ) ;_ end of while
    ret
  ) ;_ end of defun
  ;;-------------------------------------------------
  ;;  function to Count the longest number in string 
  ;;  CAB added to get the correct COUNT
  (defun getcount (lst / count pat)
    (setq count 0)
    (setq pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
    (mapcar
      '(lambda (str / i maxlen ch)
         (setq i 0 maxlen 0)
         (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
           (if (vl-position ch pat) ; number
             (setq maxlen (1+ maxlen))
             (setq count  (max count maxlen) maxlen 0)
           )
         )
  (setq count  (max count maxlen)) ;_<<< ADD 21.06.2007 by 
       )
      Lst
    )
    count
  )
  ;;===============================================
  (setq count   (GetCount ListOfString)
        NorStrs (mapcar '(lambda (x) (NormalizeNumberInString x count))
                        ListOfString)
  )
  (and IgnoreCase (setq NorStrs (mapcar 'strcase NorStrs)))
  (mapcar '(lambda (x) (nth x ListOfString)) (vl-sort-i NorStrs '<))
)
   (defun get-all-atts (obj)
  (if (and obj
    (eq :vlax-true (vla-get-HasAttributes obj))
    (vlax-property-available-p obj 'Hasattributes)
    
      )
    (vl-catch-all-apply
      (function
 (lambda ()
   (mapcar (function (lambda (x)
         (list (vla-get-TagString x)
        (vla-get-TextString x)
                                    x
         )
       )
    )
    (append (vlax-invoke obj 'Getattributes)
     (vlax-invoke obj 'Getconstantattributes)
    )
   )
 )
      )
    )
  )
)
  (defun lib:get-active-space ()
  (if (and (zerop (vla-get-activespace (vla-get-activedocument (vlax-get-acad-object)))) 
      (= :vlax-false (vla-get-mspace (vla-get-activedocument (vlax-get-acad-object)))) 
      ) ;_ end of and 
    (vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object))) 
    (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
  ) ;_ end
  (vl-load-com)
   (setq adoc (vla-get-activedocument (vlax-get-acad-object))
        alay (vla-get-activelayer adoc)
  )
  (if
(and
(setq ss (ssget "_X" '((0 . "INSERT")(66 . 1))))
(setq lst (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp(mapcar 'cadr(ssnamex ss)))))
(setq attlst (mapcar '(lambda(x)(get-all-atts x)) lst))
(setq attlst (vl-remove-if-not '(lambda(x)(and (assoc "ЛИСТ" x)
                                               (assoc "НАИМЕНОВАНИЕ.ЧЕРТЕЖА" x)
                                               )
                                  )
               attlst)
      )
(setq lst (SortStringWithNumberAsNumber (mapcar '(lambda (x)(cadr(assoc "ЛИСТ" x))) attlst) t))
(vl-catch-all-apply '(lambda()
(setq attlst (vl-sort attlst '(lambda(x y)(< (vl-position(cadr(assoc "ЛИСТ" x)) lst)(vl-position(cadr(assoc "ЛИСТ" y)) lst)))))
                       )
  )
 (setq pnt (vl-catch-all-apply
                       (function getpoint)
                       '("Точка вставки таблицы <Отказаться>: ")
                   )
     )
 (not (vl-catch-all-error-p pnt))
 (setq tbl (vla-addtable (lib:get-active-space)
                      (vlax-3d-point (trans pnt 1 0))
                      (+ (length attlst) 2)
                      3    ;_Кол-во столбцов
                      800  ;_высота строки
                      6000 ;_ширина столбца
                    )
       )
)
(progn
  (if (= (vla-get-lock alay) :vlax-true)
        (progn (vla-put-lock alay :vlax-false) (setq lock t))
      )
          (vla-put-regeneratetablesuppressed tbl :vlax-true)
          (vla-settext tbl 0 0 "Ведомость чертежей")
          (vla-setcellalignment tbl 0 0 acmiddlecenter)
          (vla-setcelltextheight tbl 0 0
                                      500  ;_Высота текста
            )
          (vla-settext tbl 1 0 "Лист")
          (vla-settext tbl 1 1 "Обозначение")
          (vla-settext tbl 1 2 "Примечание")
          (vla-setcellalignment tbl 1 0 acMiddleCenter)
          (vla-setcellalignment tbl 1 1 acMiddleCenter)
          (vla-setcellalignment tbl 1 2 acMiddleCenter)
          (vla-setcelltextheight tbl 1 0
	                              400  ;_Высота текста лИСТ
            )
          (vla-setcelltextheight tbl 1 1
                                    400  ;_Высота текста Обозначение
            )
          (vla-setcelltextheight tbl 1 2
                                    400  ;_Высота текста Примечание
            )
          (vla-setcolumnwidth tbl 0
                                  3000 ;_Ширина колонки Лист
            )
          (vla-setcolumnwidth tbl 1
                                  12000 ;_Ширина колонки Обозначение
            )
          (vla-setcolumnwidth tbl 2
                                  6000 ;_Ширина колонки Примечание
            )
          (vla-put-horzcellmargin tbl 100) ;_Отступ текста по горизонтали
          (vla-SetRowHeight tbl 0 2000) ;_Высота строки Ведомость чертежей
          (vla-SetRowHeight tbl 1 3000) ;_Высота строки Лист Обозначение Наименование
          (setq row 1)
          (foreach i attlst
	    (setq row (1+ row))
	    (vla-SetRowHeight tbl row 1200) ;_Высота строки
            (setq fld (strcat " %<\\AcObjProp Object(%<\\_ObjId "
             (vl-princ-to-string(vla-get-objectid (caddr (assoc "ЛИСТ" i))))
                ">%).TextString \\f \"%tc3\">%"
                ) ;_ strcat
          )
            (vla-settext tbl row 0 fld)
            (vla-setcellalignment tbl row 0 acMiddleCenter)
            (vla-setcelltextheight tbl row 0
                             350  ;_Высота текста
              )
            (setq fld (strcat " %<\\AcObjProp Object(%<\\_ObjId "
             (vl-princ-to-string(vla-get-objectid (caddr (assoc "НАИМЕНОВАНИЕ.ЧЕРТЕЖА" i))))
                ">%).TextString \\f \"%tc3\">%"
                ) ;_ strcat
          )
            (vla-settext tbl row 1 fld)
            (vla-setcellalignment tbl row 1 acMiddleLeft)
            (vla-setcelltextheight tbl row 1
                             350  ;_Высота текста
              )
	    ;;;Ссылка на свойство рисунка Tom
            (setq fld "%<\\AcVar CustomDP.Tom>%")
            (vla-settext tbl row 2 fld)
            (vla-setcellalignment tbl row 2 acMiddleCenter)
            (vla-setcelltextheight tbl row 2
                             350  ;_Высота текста
              )

          )
          (vla-put-regeneratetablesuppressed tbl :vlax-false)
          (vla-update tbl)
          (if lock (vla-put-lock alay :vlax-true))
        )
      )
  )

[Red Nova]

Спасибо. Со многими вопросами понятно. Но еще не на 100%.
1. Как задать в лиспе, чтобы во все строки колонки "Примечание" вставлялось поле из custom properties (строка по имени “Том”)
2. Я сумел задать Два вида высоты строк, первая - для первых двух строк, вторая - для последующих строк. Можно ли раздельно задать высоты для первых двух строк?
3. Можно ли задать разный отступ для разных столбцов?

[Red Nova]

Совсем забыл. Как на счет вопроса на #60?

[VVA]

Внес исправления в #62
1. См. фиолетовым
2. См. фиолетовым жирным
3. Нет (по крайней мере я не знаю как)
Насчет #60
Исправил #57. Там была описка
Вместо
(defun update-shtamp-block ( cps / ss i n Target-Tag-Name attValue ch )
Нужно
(defun update-shtamp-block ( csp / ss i n Target-Tag-Name attValue ch )

[Red Nova]

Большое спасибо. Теперь ведомость чертежей можно настроить по полной программе. В сочетании с лиспами с LISP. Копирование, сортировка, переименование листов (layout) и лиспом с #57 получается полный функционал для организации листов проекта.

[Red Nova]

Обнаружил что в столбце Примечание отступа перед полем нет вовсе, можно и в графе лист так сделать?

[VVA]

"Не виноватая я. Он сам пришел" (C) "Бриллиантовая рука"
Честное слово, нигде никаких пробелов не задавал, кроме как
(vla-put-horzcellmargin tbl 100) ;_Отступ текста по горизонтали

[Red Nova]

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

[VVA]

Ругается на отсутсвие GOST 2.303-68.shx

[Red Nova]

Странно, я его вроде как не использовал.
Но, раз уж ругается, то вот, выкладываю.

[wetr]

Сообщение от Red Nova Выкладываю пример создания ведомости по ГОСТ. (Настройки изменены под ГОСТ). В архиве файл со штампом, ReadMe, использованный шрифт и два лиспа (в первом в графу примечание вписывается поле тома чертежа, во втором графа примечания пуста)

Red Nova, отлично получилось! Спасибо. Так то лучше. Все по госту, настраивать не надо и обновляется
В общем VVA - респект!!! Впрочем, как всегда

[Red Nova]

VVA,
Для того чтобы была возможность составит ведомость не из всех листов, а из некоторых я сделал дополнительный штамп, у которого отличаются таги. Часто нужно бывает быстро поменять основной штамп на вспомогательный (или на оборот). Приходится удалять старый штамп, вставлять новый, корректировать параметры лукап и заново заполнять атрибуты. Можно разработать лисп для замены штампов местами?
Алгоритм такой:
Команда может быть одна или сразу две. Нужно чтобы работало в обоих направлениях.
К примеру имею на листе блок "штамп", находясь на листе запускаю лисп, запоминаются лукапы, точка вставки и содержания атрибутов, затем блок удаляется, на запомненное место вставляется блок по имени "штамп вспомогательный", корректируются лукапы и содержания артибутов.
Если считаешь что это не слишком сложным, то создание этого лиспа можно еще и сделать очередным уроком в нашей обучающей теме.
Как ты думаешь?

[VVA]

А чем Blockreplace из Express Tools не устраивает

[Red Nova]

А ты пробовал на моем файле? У меня не работает.

[VVA]

Red Nova, Так у тебя там динамический блок.
Добавил диалог выбора листов

Код:

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

;http://dwg.ru/f/showthread.php?t=14548
;АВТО Заполнение ведомости рабочих чертежей
(defun c:vrc (/ adoc alay ss pnt tbl attlst lst fld lock)
  (defun SortStringWithNumberAsNumber (ListOfString IgnoreCase / NorStrs count)
;;;Function Normalize (add 0 befor number) number in string
;;; Count normalize symbols set in variable count
;;; CAB added count as an argument
  (defun NormalizeNumberInString (str count / ch i pat ret buf)
    (setq i   0
          pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
          ret ""
    ) ;_ end of setq
    (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
      (if (vl-position ch pat)
        (progn
          (setq buf ch) ;_ end of setq
          (while
            (vl-position (setq ch (substr str (setq i (1+ i)) 1)) pat)
             (setq buf (strcat buf ch))
          ) ;_ end of while
          (while (< (strlen buf) count) (setq buf (strcat "0" buf)))
          (setq ret (strcat ret buf))
        ) ;_ end of progn
      ) ;_ end of if
      (setq ret (strcat ret ch))
    ) ;_ end of while
    ret
  ) ;_ end of defun
  ;;-------------------------------------------------
  ;;  function to Count the longest number in string 
  ;;  CAB added to get the correct COUNT
  (defun getcount (lst / count pat)
    (setq count 0)
    (setq pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
    (mapcar
      '(lambda (str / i maxlen ch)
         (setq i 0 maxlen 0)
         (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
           (if (vl-position ch pat) ; number
             (setq maxlen (1+ maxlen))
             (setq count  (max count maxlen) maxlen 0)
           )
         )
  (setq count  (max count maxlen)) ;_<<< ADD 21.06.2007 by 
       )
      Lst
    )
    count
  )
  ;;===============================================
  (setq count   (GetCount ListOfString)
        NorStrs (mapcar '(lambda (x) (NormalizeNumberInString x count))
                        ListOfString)
  )
  (and IgnoreCase (setq NorStrs (mapcar 'strcase NorStrs)))
  (mapcar '(lambda (x) (nth x ListOfString)) (vl-sort-i NorStrs '<))
)
(defun get-all-atts (obj)
  (if (and obj
    (eq :vlax-true (vla-get-HasAttributes obj))
    (vlax-property-available-p obj 'Hasattributes)
    
      )
    (vl-catch-all-apply
      (function
 (lambda ()
   (mapcar (function (lambda (x)
         (list (vla-get-TagString x)
        (vla-get-TextString x)
                                    x
         )
       )
    )
    (append (vlax-invoke obj 'Getattributes)
     (vlax-invoke obj 'Getconstantattributes)
    )
   )
 )
      )
    )
  )
)
  (defun lib:get-active-space ()
  (if (and (zerop (vla-get-activespace (vla-get-activedocument (vlax-get-acad-object)))) 
      (= :vlax-false (vla-get-mspace (vla-get-activedocument (vlax-get-acad-object)))) 
      ) ;_ end of and 
    (vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object))) 
    (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
  ) ;_ end
  (vl-load-com)
   (setq adoc (vla-get-activedocument (vlax-get-acad-object))
        alay (vla-get-activelayer adoc)
  )
  (if
(and
(setq ss (ssget "_X" '((0 . "INSERT")(66 . 1))))
(setq lst (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp(mapcar 'cadr(ssnamex ss)))))
(setq tbl (_DWGRU-GET-USER-DCL "Выберите листы" (layoutlist) t))
(setq lst (vl-remove-if-not '(lambda(x)(member(cdr(assoc 410(entget(vlax-vla-object->ename x)))) tbl)) lst))
(setq attlst (mapcar '(lambda(x)(get-all-atts x)) lst))
(setq attlst (vl-remove-if-not '(lambda(x)(and (assoc "ЛИСТ" x)
                                               (assoc "НАИМЕНОВАНИЕ.ЧЕРТЕЖА" x)
                                               )
                                  )
               attlst)
      )
(setq lst (SortStringWithNumberAsNumber (mapcar '(lambda (x)(cadr(assoc "ЛИСТ" x))) attlst) t))
(vl-catch-all-apply '(lambda()
(setq attlst (vl-sort attlst '(lambda(x y)(< (vl-position(cadr(assoc "ЛИСТ" x)) lst)(vl-position(cadr(assoc "ЛИСТ" y)) lst)))))
                       )
  )
 (setq pnt (vl-catch-all-apply
                       (function getpoint)
                       '("Точка вставки таблицы <Отказаться>: ")
                   )
     )
 (not (vl-catch-all-error-p pnt))
 (setq tbl (vla-addtable (lib:get-active-space)
                      (vlax-3d-point (trans pnt 1 0))
                      (+ (length attlst) 2)
                      3    ;_Кол-во столбцов
                      800  ;_высота строки
                      6000 ;_ширина столбца
                    )
       )
)
(progn
  (if (= (vla-get-lock alay) :vlax-true)
        (progn (vla-put-lock alay :vlax-false) (setq lock t))
      )
          (vla-put-regeneratetablesuppressed tbl :vlax-true)
          (vla-settext tbl 0 0 "Ведомость чертежей")
          (vla-setcellalignment tbl 0 0 acmiddlecenter)
          (vla-setcelltextheight tbl 0 0
                                      500  ;_Высота текста
            )
          (vla-settext tbl 1 0 "Лист")
          (vla-settext tbl 1 1 "Обозначение")
          (vla-settext tbl 1 2 "Примечание")
          (vla-setcellalignment tbl 1 0 acMiddleCenter)
          (vla-setcellalignment tbl 1 1 acMiddleCenter)
          (vla-setcellalignment tbl 1 2 acMiddleCenter)
          (vla-setcelltextheight tbl 1 0
	                              400  ;_Высота текста лИСТ
            )
          (vla-setcelltextheight tbl 1 1
                                    400  ;_Высота текста Обозначение
            )
          (vla-setcelltextheight tbl 1 2
                                    400  ;_Высота текста Примечание
            )
          (vla-setcolumnwidth tbl 0
                                  3000 ;_Ширина колонки Лист
            )
          (vla-setcolumnwidth tbl 1
                                  12000 ;_Ширина колонки Обозначение
            )
          (vla-setcolumnwidth tbl 2
                                  6000 ;_Ширина колонки Примечание
            )
          (vla-put-horzcellmargin tbl 100) ;_Отступ текста по горизонтали
          (vla-SetRowHeight tbl 0 2000) ;_Высота строки Ведомость чертежей
          (vla-SetRowHeight tbl 1 3000) ;_Высота строки Лист Обозначение Наименование
          (setq row 1)
          (foreach i attlst
	    (setq row (1+ row))
	    (vla-SetRowHeight tbl row 1200) ;_Высота строки
            (setq fld (strcat " %<\\AcObjProp Object(%<\\_ObjId "
             (vl-princ-to-string(vla-get-objectid (caddr (assoc "ЛИСТ" i))))
                ">%).TextString \\f \"%tc3\">%"
                ) ;_ strcat
          )
            (vla-settext tbl row 0 fld)
            (vla-setcellalignment tbl row 0 acMiddleCenter)
            (vla-setcelltextheight tbl row 0
                             350  ;_Высота текста
              )
            (setq fld (strcat " %<\\AcObjProp Object(%<\\_ObjId "
             (vl-princ-to-string(vla-get-objectid (caddr (assoc "НАИМЕНОВАНИЕ.ЧЕРТЕЖА" i))))
                ">%).TextString \\f \"%tc3\">%"
                ) ;_ strcat
          )
            (vla-settext tbl row 1 fld)
            (vla-setcellalignment tbl row 1 acMiddleLeft)
            (vla-setcelltextheight tbl row 1
                             350  ;_Высота текста
              )
	    ;;;Ссылка на свойство рисунка Tom
            (setq fld "%<\\AcVar CustomDP.Tom>%")
            (vla-settext tbl row 2 fld)
            (vla-setcellalignment tbl row 2 acMiddleCenter)
            (vla-setcelltextheight tbl row 2
                             350  ;_Высота текста
              )

          )
          (vla-put-regeneratetablesuppressed tbl :vlax-false)
          (vla-update tbl)
          (if lock (vla-put-lock alay :vlax-true))
        )
      )
  )


;;; ************************************************************************
;;; * Библиотека DWGruLispLib Copyright ©2008  DWGru Programmers Group
;;; *
;;; * _dwgru-get-user-dcl (Кандидат)
;;; *
;;; * Запрос значения у пользователя через диалоговое окно
;;; *
;;; *
;;; * 26/01/2008 Версия 0002. Редакция Владимир Азарко (VVA)
;;;              - Выход по двойному клику, если запрещен множественный выбор (multi-nil)
;;;              - Обработка нескольких колонок
;;; * 21/01/2008 Версия 0001. Редакция Владимир Азарко (VVA)
;;; ************************************************************************


;;; ************************************************************************
;;; * Library DWGruLispLib Copyright © 2008 DWGru Programmers Group
;;; *
;;; * _dwgru-get-user-dcl (Candidate)
;;; *
;;; * Inquiry of value at the user through a dialogue window
;;; *
;;; *
;;; * 26/01/2008 Version 0002. Edition Vladimir Azarko (VVA)
;;; - the Output on double a clique if the plural choice (multi-nil) is forbidden
;;; - Processing of several columns
;;; * 21/01/2008 Version 0001. Edition Vladimir Azarko (VVA)


(defun _DWGRU-GET-USER-DCL (ZAGL        INFO-LIST   MULTI
                            /           FL          RET
                            DCL_ID      MAXROW      MAX_COUNT_COL
                            COUNT_COL   I           LISTBOX_HEIGHT
                            LST         _LOC_FINISH _LOC_CLEAR
                            NCOL
                           )
;| 
* ENGLISH
* Inquiry of value at the user through a dialogue window
* Dialogue is formed to "strike"
* the Quantity of lines on page without scrolling is set by variable MAXROW.
* It is necessary to remember, that number MAXROW increases on 3.
* the Maximum quantity of columns is set by variable MAX_COUNT_COL
* It is published
     http://dwg.ru/f/showthread.php?p=203746#post203746
* Parameters of a call:
    zagl - heading of a window [String]
    info-list - the list of line values[List of String]
    multi - t - the plural choice is resolved, nil-is not present
      
* Returns:
 The list of the chosen lines or nil - a cancelling
* the Example
 (_dwgru-get-user-dcl " Specify a variant " ' ("First" "Second" "Third") nil); _-> ("First") 
 (_dwgru-get-user-dcl " Specify a variant " ' ("First" "Second" "Third") t); _-> ("First"  "Second ")
 (_dwgru-get-user-dcl " Specify a variant "
   (progn (setq i 0 lst nil) (repeat 205 (setq lst (cons (strcat "Значение-" (itoa (setq i (1 + i)))) lst))) (reverse lst)) nil)
 (_dwgru-get-user-dcl " Specify a variant, using CTRL and SHIFT for a choice "
   (progn (setq i 0 lst nil) (repeat 205 (setq lst (cons (strcat "Значение-" (itoa (setq i (1 + i)))) lst))) (reverse lst)) t)
|;
;|
* RUS						   
* Запрос значения у пользователя через диалоговое окно
* Диалог формируется "налету"
* Количество строк на страницу без скроллинга задается переменной MAXROW.
* Необходимо помнить, что число MAXROW увеличивается на 3.
* Максимальное количество колонок задается переменной MAX_COUNT_COL
* Опубликована
     http://dwg.ru/f/showthread.php?p=203746#post203746
* Параметры вызова:
    zagl - заголовок окна [String]
    info-list - список строковых значений[List of String]
    multi - t - разрешен множественный выбор, nil- нет
    
* Возвращает:
 Список выбранных строк или nil - отмена
* Пример
 (_dwgru-get-user-dcl "Укажите вариант" '("Первый" "Второй" "Третий") nil) ;_->("Первый") 
 (_dwgru-get-user-dcl "Укажите вариант" '("Первый" "Второй" "Третий") t) ;_->("Первый" "Второй")
 (_dwgru-get-user-dcl "Укажите вариант"
   (progn (setq i 0 lst nil)(repeat 205 (setq lst (cons (strcat "Значение-" (itoa (setq i (1+ i)))) lst)))(reverse lst)) nil)
 (_dwgru-get-user-dcl "Укажите вариант, используя CTRL и SHIFT для выбора"
   (progn (setq i 0 lst nil)(repeat 205 (setq lst (cons (strcat "Значение-" (itoa (setq i (1+ i)))) lst)))(reverse lst)) t)
|;
 ;_ ===== КОНСТАНТЫ ============

  (setq MAXROW 40) ;_макc. кол-во строк без скроллинга (К нему дальше добавится еще 3 строчки)
                   ;_  max lines without scrolling (To it 3 more lines further will be added)
  (setq MAX_COUNT_COL 5) ;_максимальное количество колонок
                         ;_ ; _ a maximum quantity of columns
;;============== Локальные фунцкции START==================
;;============== Local functions START========================

  (defun _LOC_FINISH ()
    (setq I   0
          RET NIL
    ) ;_ end ofsetq
    (repeat COUNT_COL
      (setq I (1+ I))
      (setq RET (cons (cons I (get_tile (strcat "info" (itoa I)))) RET))
    ) ;_ end ofrepeat
    (setq RET (reverse RET))
    (done_dialog 1)
  ) ;_ end ofdefun
  (defun _LOC_CLEAR (NOMER)
    (setq I 0)
    (repeat COUNT_COL
      (setq I (1+ I))
      (if (/= I NOMER)
        (progn
          (start_list (strcat "info" (itoa I)))
          (mapcar 'add_list (nth (1- I) LST))
          (end_list)
        ) ;_ end ofprogn
      ) ;_ end ofif
    ) ;_ end ofrepeat
  ) ;_ end ofdefun

;;;==================== Локальные фунцкции END ==================================
;;;==================== Local functions END ==================================

;;;==================== MAIN PART ===============================================

  (if (null ZAGL)
    (if (= (getvar "DWGCODEPAGE") "ANSI_1251")
      (setq ZAGL "Выбор")
      (setq ZAGL "Select")
    ) ;_ end ofif
  ) ;_ end if
  (if (zerop (rem (length INFO-LIST) MAXROW)) ;_Целое количество столбцов
    (setq COUNT_COL (/ (length INFO-LIST) MAXROW)) ;_Его и оставляем
    (setq COUNT_COL (1+ (fix (/ (length INFO-LIST) MAXROW 1.0)))) ;_Берем ближайшее целое
  ) ;_ end ofif
  (if (> COUNT_COL MAX_COUNT_COL)
    (setq COUNT_COL MAX_COUNT_COL)
  ) ;_Ограничиваем max количеством
  (setq LISTBOX_HEIGHT (+ 3 MAXROW)) ;_  добавляем 3 строчки для красоты и для исключения пограничного скроллинга
                                     ;_ We add 3 lines for appearance and for exception boundary scroll
  (if (and (= COUNT_COL 1) (<= (length INFO-LIST) MAXROW))
    (setq LISTBOX_HEIGHT (+ 3 (length INFO-LIST)))
  ) ;_ end ofif
  (setq I 0)
  (setq FL (vl-filename-mktemp "dwgru" NIL ".dcl"))
  (setq RET (open FL "w")
        LST NIL
  ) ;_ end ofsetq
  (mapcar '(lambda (X) (write-line X RET))
          (append (list "dwgru_get_user : dialog { "
                        (strcat "label=\"" ZAGL "\";")
                        ": boxed_row {"
                        (if (= (getvar "DWGCODEPAGE") "ANSI_1251")
                          "label = \"Значение\";"
                          "label = \"Value\";"
                        ) ;_ end ofif
                  ) ;_ end oflist
                  (repeat COUNT_COL
                    (setq LST
                           (append
                             LST
                             (list
                               " :list_box {"
                               "alignment=top ;"
                               (if MULTI
                                 "multiple_select = true ;"
                                 "multiple_select = false ;"
                               ) ;_ end ofif
                               "width=31 ;"
                               (strcat "height= " (itoa LISTBOX_HEIGHT) " ;")
                               "is_tab_stop = false ;"
                               (strcat "key = \"info" (itoa (setq I (1+ I))) "\";}")
                             ) ;_ end oflist
                           ) ;_ end ofappend
                    ) ;_ end ofsetq
                  ) ;_ end ofrepeat
                  (list
                    "}"
                    ":row{"
                    "ok_cancel_err;}}"
                  ) ;_ end oflist
          ) ;_ end of list
  ) ;_ end of mapcar
  (setq RET (close RET))
  (if (and (null (minusp (setq DCL_ID (load_dialog FL))))
           (new_dialog "dwgru_get_user" DCL_ID)
      ) ;_ end and
    (progn
      (setq LST INFO-LIST)
      ((lambda (/ RET1 BUF ITM)

         (repeat (1- COUNT_COL)
           (setq I '-1)
           (while (and (setq ITM (car LST))
                       (< (setq I (1+ I)) MAXROW)
                  ) ;_ end ofand
             (setq BUF (cons ITM BUF)
                   LST (cdr LST)
             ) ;_ end ofsetq
           ) ;_ end ofwhile
           (setq RET1 (cons (reverse BUF) RET1)
                 BUF  NIL
           ) ;_ end ofsetq
         ) ;_ end ofrepeat
         (setq RET RET1)
       ) ;_ end oflambda
      )
      (if LST
        (setq RET (cons LST RET))
      ) ;_ end ofif
      (setq LST (reverse RET))
      (setq I 0)
      (mapcar '(lambda (THIS_LIST)
                 (if (<= (setq I (1+ I)) COUNT_COL)
                   (progn
                     (start_list (strcat "info" (itoa I)))
                     (mapcar 'add_list THIS_LIST)
                     (end_list)
                   ) ;_ end ofprogn
                 ) ;_ end ofif
               ) ;_ end oflambda
              LST
      ) ;_ end ofmapcar

      (set_tile "info1" "0")
      (setq I 0
            NCOL 1
      ) ;_ end ofsetq
      (repeat COUNT_COL
        (action_tile
          (strcat "info" (itoa (setq I (1+ I))))
          (strcat "(progn (setq Ncol "
                  (itoa I)
                  ")(if (not multi)(_loc_clear Ncol))"
                  "(if (and (not multi)(= $reason 4))(_loc_finish)))"
          ) ;_ end ofstrcat
        ) ;_ end ofaction_tile
      ) ;_ end ofrepeat
      (action_tile "cancel" "(done_dialog 0)")
      (action_tile "accept" "(_loc_finish)")
      (if MULTI
        (set_tile "error"
                  (if (= (getvar "DWGCODEPAGE") "ANSI_1251")
                    "Используйте CTRL и SHIFT для выбора"
                    "Use CTRL and SHIFT for a choicet"
                  ) ;_ end ofif
        ) ;_ end ofset_tile
        (set_tile "error"
                  (if (= (getvar "DWGCODEPAGE") "ANSI_1251")
                    "Можно выбирать двойным щелчком"
                    "It is possible to choose double click"
                  ) ;_ end ofif
        ) ;_ end ofset_tile
      ) ;_ end ofif
      (if (zerop (start_dialog))
        (setq RET NIL)
        (progn
          (setq
            RET (apply
                  'append
                  (mapcar
                    '(lambda (ITM)
                       (setq THIS_LIST (nth (1- (car ITM)) LST))
                       (mapcar
                         (function (lambda (NUM) (nth NUM THIS_LIST)))
                         (read (strcat "(" (cdr ITM) ")"))
                       ) ;_ end ofmapcar
                     ) ;_ end oflambda
                    RET
                  ) ;_ end ofmapcar
                ) ;_ end ofapply
          ) ;_ end ofsetq

        ) ;_ end ofprogn
      ) ;_ end if
      (unload_dialog DCL_ID)
    ) ;_ end of progn
  ) ;_ end of if
  (vl-file-delete FL)
  RET
) ;_ end ofdefun

[Red Nova]

VVA,
Спасибо, но, честно говоря, было бы более удобно, если бы ты добавил в лисп возможность выбора листов для ведомости (как в LTREN)

[Red Nova]

VVA, Может все же добавишь диалог выбора листов?

[ShaggyDoc]

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

1. Форматы с любыми размерами и основными надписями создаются программно. Могут размещаться хоть в модели, хоть на вкладках компоновок. Последний вариант, конечно, предпочтительней. Правильный вариант - один формат на компоновке.

2. Тексты в основных надписях хранятся в атрибутах с определенными именами.

3. Имя компоновки не включает никаких формальных признаков - номеров и прочего. В идеале оно должно быть точно таким, какое наименование у чертежа. Для переименования компоновок - специальная программа. Первичным является наименование чертежа в штампе - именно оно должно попасть в ведомость чертежей.

4. Имеется программа, позволяющая пакетно изменить атрибуты во всех основных надписях. Например, в последний момент может потребоваться изменение наименования объекта или обозначения.

5. Правильные имена компоновок позволяют автоматически заполнить ведомость чертежей. Это можно сделать и с помощью Sheet Set (подшивки) и специальной программой. Учитываем, что пользователь мог вручную переместить закладки компоновок куда угодно. Программа выводит диалоговое окно с двойным списком (см. рис). В этом списке можно отобрать компоновки, включаемые в ведомость (не обязательно все входят), а также изменить их порядок следования.

Нумерация листов в ведомости может выполняться по порядку, но можно из корректировать номера - например, вместо номера "4" сделать "4и".

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

[VVA]

Red Nova, Обновил лисп в #76 с диалогом запроса листов. Поправишь у себя - обнови пост #69

ShaggyDoc, Это правильно. Я бы тоже с полями не делал, но такое было ТЗ.