[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

[wetr]

Заменил в №110.
Этот кусочек создает стиль таблицы "МИП". Осталось соединить все в одно целое и заставить таблицу вставляться в этом новом стиле.

[dextron3]

wetr, так когда ждать окончание лиспа то?

[Red Nova]

wetr Я тут почитал твом посты, но пока не совсем понял что в итоге ты намерен получить. Хочешь чтобы таблица создавалась на определенном слою? Offtop: или может "на определенном слое"? Запутался.

[wetr]

Red Nova, она уже создается на слое "_Таблицы", но с текущим стилем таблиц. Я хочу, чтобы получился конечный ПРОДУКТ - чтобы не менять ничего впоследствии.

[wetr]

Сообщение от dextron3 wetr, так когда ждать окончание лиспа то?

Как только лисп изучу

[Red Nova]

Offtop: Продуктом называют результат различных процессов:
всякое произведение человеческого труда;
созданные для обмена продукты являются товаром;
продукт радиоактивного распада является нуклидом;
продуктом химической реакции является образовавшееся вещество;
аналогично, образовавшаяся субстанция является продуктом жизнедеятельности организма;

и тому подобное.

[VVA]

Сообщение от wetr Как только лисп изучу

На основе #110. Создание стиля таблицы вынес в отдельную ф-цию
table-style-make. В ней изменить поля

Код:

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

 '(7 . "МИП_ГОСТ") ;;;; _ТЕКСТОВЫЙ СТИЛЬ

на свой СУЩЕСТВУЮЩИЙ в момент создания стиля таблицы ТЕСКТОВЫЙ СТИЛЬ.
Изменения в команде VRC выделил красным
Не проверял, но должна работать

Код:

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

(vl-load-com)
;;;================== Сервисные ф-ции BEGIN
(defun table-style-make ( table-style-name / tb xr tb-dic ret)
;;;Создаем стиль таблицы
;;  table-style-name - имя стиля [String]
;; Возвращает t - стиль создан
;;            nil - нет
  ;;Добавляем стиль таблицы такого нет. Не пересоздается, если существует
(if (and (setq tb-dic(DICTSEARCH (NAMEDOBJDICT) "ACAD_TABLESTYLE"))
  (not (setq ret(member (cons 3 table-style-name)(DICTSEARCH (NAMEDOBJDICT) "ACAD_TABLESTYLE")))))
  (progn
(setq tb (list
'(0 . "TABLESTYLE")
(cons 330 (CDR (ASSOC -1 tb-dic)))
'(100 . "AcDbTableStyle")
'(3 . "Standard")
'(70 . 0)
'(71 . 0)
'(40 . 1);Отступ
'(41 . 1);Отступ
'(280 . 0)
'(281 . 0)
'(7 . "МИП_ГОСТ") ;;;; _ТЕКСТОВЫЙ СТИЛЬ
'(140 . 2.5)
'(170 . 5)
'(62 . 256)
'(63 . 7)
'(283 . 0)
'(274 . -1)
'(284 . 1)
'(64 . 256)
'(275 . -1)
'(285 . 1)
'(65 . 256)
'(276 . -1)
'(286 . 1)
'(66 . 256)
'(277 . -1)
'(287 . 1)
'(67 . 256)
'(278 . -1)
'(288 . 1)
'(68 . 256)
'(279 . -1)
'(289 . 1)
'(69 . 256)
'(7 . "МИП_ГОСТ") ;;;; _ТЕКСТОВЫЙ СТИЛЬ
'(140 . 3.5)
'(170 . 5)
'(62 . 256)
'(63 . 256)
'(283 . 0)
'(274 . -2)
'(284 . 1)
'(64 . 0)
'(275 . -2)
'(285 . 1)
'(65 . 0)
'(276 . -2)
'(286 . 1)
'(66 . 0)
'(277 . -2)
'(287 . 1)
'(67 . 0)
'(278 . -2)
'(288 . 1)
'(68 . 0)
'(279 . -2)
'(289 . 1)
'(69 . 0)
'(7 . "МИП_ГОСТ") ;;;; _ТЕКСТОВЫЙ СТИЛЬ
'(140 . 3.0)
'(170 . 5)
'(62 . 256)
'(63 . 256)
'(283 . 0)
'(274 . -1)
'(284 . 1)
'(64 . 256)
'(275 . -1)
'(285 . 1)
'(65 . 256)
'(276 . -1)
'(286 . 1)
'(66 . 256)
'(277 . -1)
'(287 . 1)
'(67 . 256)
'(278 . -1)
'(288 . 1)
'(68 . 256)
'(279 . -1)
'(289 . 1)
'(69 . 256)
)
      )
(if (setq ret(setq xr (entmakex tb)))
(entmod (append tb-dic(list (cons 3 table-style-name)(cons 350 xr)))))
))
  ret
  )
;|
* Ф-ция str-str-lst
* Сервисная ф-ция извлечения из строки данных, разделенных
* каким либо символом или строкой символов
* Возвращает список строк
* Аргументы [Type]:
  str - строка для разбора [STRING]
  pat - разделитель [STRING]
*  Пример запуска
  (setq str "мы;изучаем;рекурсии" pat ";")
  (setq str "мы — изучаем — рекурсии" pat " — ")
  (str-str-lst str pat)
* Читать подробнее http://www.autocad.ru/cgi-bin/f1/board.cgi?t=25113OT
|;
(defun str-str-lst (str pat / i)
  (cond ((= str "") nil)
        ((setq i (vl-string-search pat str))
         (cons (substr str 1 i)
               (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)
         ) ;_  cons
        )
        (t (list str))
  ) ;_  cond
) ;_  defun
;|=============================================================================
*   На основе ф-ции _kpblc-layer-create
* 
*   пост № 47
*   Добавлен новый  параметр  suff - суффикс слоя, если он есть, то имя слоя получаестся путем
*   добавления к имени существующего слоя суффикса suff
*   Создание слоя с указанными параметрами.
*   Параметры вызова:
*   layer-list   список параметров слоя вида:
   '(("name" . "TestLayer")   ; имя слоя. может быть пропущено, если указан suff
     ("color" . 3)         ; номер цвета. nil -> 7
     ("lw" . 50)         ; вес линии слоя. nil -> 25
*                          Оно выражается в сотых долях миллиметра и может быть любым
*                          из следующего ряда: 0, 5, 9, 13, 15, 18, 20, 25, 30, 35, 40, 50, 53, 60, 70,
*                          80, 90, 100, 106, 120, 140, 158, 200 и 211.
     ("lt" . "hidden")      ; тип линии слоя. nil -> Continuous
               ; Если описания типа линии в acadiso.lin
               ; нет, обязательно указывать следующий
               ; параметр
   ("ltfile" . "c:\\cad\\ltypes\\lt.lin")   ; полный путь к файлу с описанием
               ; типа линии. Если файл находится в путях
               ; поддержки, путь можно не указывать
   ("plot" . "y")         ; Печатать ("y") или нет ("n") слой.
               ; nil -> "y"
   ("suff" . "_Размеры")  ;_Добавляемый суффикс с текущему слою. Если задан, поле "name" игнорируется            
   )
*    Возвращает vla-указатель на созданный слой. Если слой существует, его
* настройки приводятся в соответствие с переданным списком.
*    Слой размораживается, разблокируется и включается. Не активируется.
* Примеры:
  (_dwgru-layer-create '(("name" . "Test")("color" . 1)("lw" . 50)))
* создать если нет и слой Test цветом 1 (красный) весом линии 0.5
=========================================================================|;
(defun _dwgru-layer-create (layer-list / vla_layer buf)
       (setq *MIP-CLAYER-PROP-SETTING*
     (list (cons "layer"
   (vla-get-activelayer (vla-get-activedocument (vlax-get-acad-object)))
   ) ;_ end of cons
    (cons "color" (getvar "cecolor"))
    (cons "lw" (getvar "celweight"))
    (cons "lt" (getvar "celtype"))
    ) ;_ end of list
    ) ;_ end of setq
  ;;;Если есть suff добавляем в начало списка,
  ;;;чтобы assoc нашел раньше
  (if (cdr(assoc "suff" layer-list))
    (progn
     (setq layer-list (vl-remove (assoc "name" layer-list) layer-list))
     (setq layer-list (append (list(cons "name" (strcat (getvar "clayer") (cdr(assoc "suff" layer-list))))) layer-list))
    )
  )
  (setq vla_layer
  (vla-add
    (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
    (if (snvalid (cdr (assoc "name" layer-list)))
        (cdr (assoc "name" layer-list))
        "0"
      )
    ) ;_ end of vla-add
 ) ;_ end of setq
  (vla-put-color
    vla_layer
    (if (setq buf (cdr (assoc "color" layer-list)))
      buf
      7
      ) ;_ end of if
    ) ;_ end of vla-put-color
  (vla-put-lineweight
    vla_layer
    (if (setq buf (cdr (assoc "lw" layer-list)))
      (if (member buf (list acLnWt000  acLnWt030  acLnWt090
    acLnWt005  acLnWt035  acLnWt100
    acLnWt009  acLnWt040  acLnWt106
    acLnWt013  acLnWt050  acLnWt120
    acLnWt015  acLnWt053  acLnWt140
    acLnWt018  acLnWt060  acLnWt158
    acLnWt020  acLnWt070  acLnWt200
    acLnWt025  acLnWt080  acLnWt211
    )
    )
    buf
    acLnWtByLwDefault
 )
      acLnWtByLwDefault
      ) ;_ end of if
    ) ;_ end of vla-put-lineweight
  (if (and (setq buf (cdr (assoc "lt" layer-list)))
    (_kpblc-linetype-load
      buf
      (cdr (assoc "ltfile" layer-list))
      ) ;_ end of _kpblc-linetype-load
    ) ;_ end of and
    (vla-put-linetype vla_layer (cdr (assoc "lt" layer-list)))
    (vla-put-linetype vla_layer "Continuous")
    ) ;_ end of if
  (vla-put-plottable
    vla_layer
    (if (= (cdr (assoc "plot" layer-list)) "n")
      :vlax-false
      :vlax-true
      ) ;_ end of if
    ) ;_ end of vla-put-Plottable
  (vla-put-lock vla_layer :vlax-false)
  (vla-put-layeron vla_layer :vlax-true)
  (if (not (equal (vla-get-activelayer (vla-get-activedocument (vlax-get-acad-object)))
    vla_layer
    ) ;_ end of equal
    ) ;_ end of not
    (vla-put-freeze vla_layer :vlax-false)
    ) ;_ end of if
  vla_layer
  ) ;_ end of defun
;;;================== Сервисные ф-ции END
;;; Реактор
(or *kpblc-activedoc*
  (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object))))
(setq VLR-react (VLR-SysVar-Reactor nil (list '(:VLR-sysVarChanged . chrzmstyle)))) 
(defun chrzmstyle (name event / nstyle)
  (if (= (car event) "DIMSTYLE")
    (progn
      (setq nstyle (getvar "DIMSTYLE")
     nstyle (str-str-lst nstyle "_")
     nstyle (VL-STRING-RIGHT-TRIM "_" (apply 'strcat (mapcar '(lambda (x) (strcat x "_"))(cdr nstyle)))))
      (if (snvalid nstyle)
 (progn
   (setq nstyle (strcat "Размерные_" nstyle))
   (vla-put-activelayer *kpblc-activedoc*
          (_dwgru-layer-create (list (cons "name" nstyle))))
   )
 )
      )
    )
  (princ) 
  )

;АВТО Заполнение ведомости рабочих чертежей
(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 (table-style-make "VRC")(setvar "CTABLESTYLE" "VRC"))
  (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    ;_Кол-во столбцов
                      15  ;_высота строки
                      185 ;_ширина столбца
                    )
       )
(or (vla-put-layer tbl (vla-get-name(_dwgru-layer-create '(("name" . "Таблицы"))))) t)
)
(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
                                      3.5  ;_Высота текста
            )
          (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
                               3  ;_Высота текста лИСТ
            )
          (vla-setcelltextheight tbl 1 1
                                    3  ;_Высота текста Наименование
            )
          (vla-setcelltextheight tbl 1 2
                                    3  ;_Высота текста Примечание
            )
          (vla-setcolumnwidth tbl 0
                                  15 ;_Ширина колонки Лист
            )
          (vla-setcolumnwidth tbl 1
                                  140 ;_Ширина колонки Наименование
            )
          (vla-setcolumnwidth tbl 2
                                  30 ;_Ширина колонки Примечание
            )
          (vla-put-horzcellmargin tbl 1) ;_Отступ текста по горизонтали
          (vla-SetRowHeight tbl 0 13) ;_Высота строки Ведомость чертежей
          (vla-SetRowHeight tbl 1 15) ;_Высота строки Лист Обозначение Наименование
          (setq row 1)
          (foreach i attlst
     (setq row (1+ row))
     (vla-SetRowHeight tbl row 8) ;_Высота строки
            (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
                             2.5  ;_Высота текста
              )
            (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
                             2.5  ;_Высота текста
              )
          )
          (vla-put-regeneratetablesuppressed tbl :vlax-false)
          (vla-update tbl)
          (if lock (vla-put-lock alay :vlax-true))
        )
      )
  )

[wetr]

Да, все работает. Но есть одно «но». Стиль таблицы создаваемый программно, имеет размеры по госту и текстовый стиль какой хочешь. Но толщины линий д.б. разные. Такие как сделал RedNova в стиле «Ведомость чертежей». Как мне показалось, программно этого нельзя сделать. Может тогда не создавать стиль в программе, а просто назначать. А в шаблоне он и так всегда лежит (у меня). Уже неловко как-то просить тебя по мелочам всяким. Экспериментирую тут с твоим кодом. Пытаюсь разобраться хотя бы с этой строчкой

Код:

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

(if (table-style-make "VRC")(setvar "CTABLESTYLE" "VRC"))

Функция if имеет 2 параметра/аргумента. Судя по описанию:
« if(E1 E2 [E3])
Вычисляется выражение E1. Если оно истинно (не NIL), то выполняется выражение E2, иначе - E3», if имеет 3 аргумента.
Т.е. если NIL -> то, ничего не происходит?

Я добавил

Код:

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

(setvar "CTABLESTYLE" "Ведомость чертежей")

в код из 110, вроде работает

Думаю правильней было бы конструкцию
(if (table-style-make "VRC")(setvar "CTABLESTYLE" "VRC"))
записать как
(if (имеется_в_чертеже_стиль "Ведомость чертежей")(setvar "CTABLESTYLE" " Ведомость чертежей ") ("CTABLESTYLE" "Standard"))???

Итого получившийся код имеет вид

Код:

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

(vl-load-com)
;;;================== Сервисные ф-ции BEGIN

;|
* Ф-ция str-str-lst
* Сервисная ф-ция извлечения из строки данных, разделенных
* каким либо символом или строкой символов
* Возвращает список строк
* Аргументы [Type]:
  str - строка для разбора [STRING]
  pat - разделитель [STRING]
*  Пример запуска
  (setq str "мы;изучаем;рекурсии" pat ";")
  (setq str "мы — изучаем — рекурсии" pat " — ")
  (str-str-lst str pat)
* Читать подробнее http://www.autocad.ru/cgi-bin/f1/board.cgi?t=25113OT
|;
(defun str-str-lst (str pat / i)
  (cond ((= str "") nil)
        ((setq i (vl-string-search pat str))
         (cons (substr str 1 i)
               (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)
         ) ;_  cons
        )
        (t (list str))
  ) ;_  cond
) ;_  defun
;|=============================================================================
*   На основе ф-ции _kpblc-layer-create
*   http://dwg.ru/forum/viewtopic.php?t=3116&start=45&sid=fab803bd4dbda125ffdc6c07563f682a
*   пост № 47
*   Добавлен новый  параметр  suff - суффикс слоя, если он есть, то имя слоя получаестся путем
*   добавления к имени существующего слоя суффикса suff
*   Создание слоя с указанными параметрами.
*   Параметры вызова:
*   layer-list   список параметров слоя вида:
   '(("name" . "TestLayer")   ; имя слоя. может быть пропущено, если указан suff
     ("color" . 3)         ; номер цвета. nil -> 7
     ("lw" . 50)         ; вес линии слоя. nil -> 25
*                          Оно выражается в сотых долях миллиметра и может быть любым
*                          из следующего ряда: 0, 5, 9, 13, 15, 18, 20, 25, 30, 35, 40, 50, 53, 60, 70,
*                          80, 90, 100, 106, 120, 140, 158, 200 и 211.
     ("lt" . "hidden")      ; тип линии слоя. nil -> Continuous
               ; Если описания типа линии в acadiso.lin
               ; нет, обязательно указывать следующий
               ; параметр
   ("ltfile" . "c:\\cad\\ltypes\\lt.lin")   ; полный путь к файлу с описанием
               ; типа линии. Если файл находится в путях
               ; поддержки, путь можно не указывать
   ("plot" . "y")         ; Печатать ("y") или нет ("n") слой.
               ; nil -> "y"
   ("suff" . "_Размеры")  ;_Добавляемый суффикс с текущему слою. Если задан, поле "name" игнорируется            
   )
*    Возвращает vla-указатель на созданный слой. Если слой существует, его
* настройки приводятся в соответствие с переданным списком.
*    Слой размораживается, разблокируется и включается. Не активируется.
* Примеры:
  (_dwgru-layer-create '(("name" . "Test")("color" . 1)("lw" . 50)))
* создать если нет и слой Test цветом 1 (красный) весом линии 0.5

=========================================================================|;

(defun _dwgru-layer-create (layer-list / vla_layer buf)
       (setq *MIP-CLAYER-PROP-SETTING*
     (list (cons "layer"
   (vla-get-activelayer (vla-get-activedocument (vlax-get-acad-object)))
   ) ;_ end of cons
    (cons "color" (getvar "cecolor"))
    (cons "lw" (getvar "celweight"))
    (cons "lt" (getvar "celtype"))
    ) ;_ end of list
    ) ;_ end of setq

  ;;;Если есть suff добавляем в начало списка,
  ;;;чтобы assoc нашел раньше
  (if (cdr(assoc "suff" layer-list))
    (progn
     (setq layer-list (vl-remove (assoc "name" layer-list) layer-list))
     (setq layer-list (append (list(cons "name" (strcat (getvar "clayer") (cdr(assoc "suff" layer-list))))) layer-list))
    )
  )
  (setq vla_layer
  (vla-add
    (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
    (if (snvalid (cdr (assoc "name" layer-list)))
        (cdr (assoc "name" layer-list))
        "0"
      )
    ) ;_ end of vla-add
 ) ;_ end of setq
  (vla-put-color
    vla_layer
    (if (setq buf (cdr (assoc "color" layer-list)))
      buf
      7
      ) ;_ end of if
    ) ;_ end of vla-put-color
  (vla-put-lineweight
    vla_layer
    (if (setq buf (cdr (assoc "lw" layer-list)))
      (if (member buf (list acLnWt000  acLnWt030  acLnWt090
    acLnWt005  acLnWt035  acLnWt100
    acLnWt009  acLnWt040  acLnWt106
    acLnWt013  acLnWt050  acLnWt120
    acLnWt015  acLnWt053  acLnWt140
    acLnWt018  acLnWt060  acLnWt158
    acLnWt020  acLnWt070  acLnWt200
    acLnWt025  acLnWt080  acLnWt211
    )
    )
    buf
    acLnWtByLwDefault
 )
      acLnWtByLwDefault
      ) ;_ end of if
    ) ;_ end of vla-put-lineweight
  (if (and (setq buf (cdr (assoc "lt" layer-list)))
    (_kpblc-linetype-load
      buf
      (cdr (assoc "ltfile" layer-list))
      ) ;_ end of _kpblc-linetype-load
    ) ;_ end of and
    (vla-put-linetype vla_layer (cdr (assoc "lt" layer-list)))
    (vla-put-linetype vla_layer "Continuous")
    ) ;_ end of if
  (vla-put-plottable
    vla_layer
    (if (= (cdr (assoc "plot" layer-list)) "n")
      :vlax-false
      :vlax-true
      ) ;_ end of if
    ) ;_ end of vla-put-Plottable
  (vla-put-lock vla_layer :vlax-false)
  (vla-put-layeron vla_layer :vlax-true)
  (if (not (equal (vla-get-activelayer (vla-get-activedocument (vlax-get-acad-object)))
    vla_layer
    ) ;_ end of equal
    ) ;_ end of not
    (vla-put-freeze vla_layer :vlax-false)
    ) ;_ end of if
  vla_layer
  ) ;_ end of defun

;;;================== Сервисные ф-ции END

;;; Реактор

(or *kpblc-activedoc*
  (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object))))

(setq VLR-react (VLR-SysVar-Reactor nil (list '(:VLR-sysVarChanged . chrzmstyle)))) 
(defun chrzmstyle (name event / nstyle)
  (if (= (car event) "DIMSTYLE")
    (progn
      (setq nstyle (getvar "DIMSTYLE")
	    nstyle (str-str-lst nstyle "_")
	    nstyle (VL-STRING-RIGHT-TRIM "_" (apply 'strcat (mapcar '(lambda (x) (strcat x "_"))(cdr nstyle)))))
      (if (snvalid nstyle)
	(progn
	  (setq nstyle (strcat "Размерные_" nstyle))
	  (vla-put-activelayer *kpblc-activedoc*
          (_dwgru-layer-create (list (cons "name" nstyle))))
	  )
	)
      )
    )
  (princ) 
  )
;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)
  )
  (setvar "CTABLESTYLE" "Ведомость чертежей")
  (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    ;_Кол-во столбцов
                      15  ;_высота строки
                      185 ;_ширина столбца
                    )
       )
(or (vla-put-layer tbl (vla-get-name(_dwgru-layer-create '(("name" . "_Таблицы")("lw" . 15))))) t)
)
(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
                                      3.5  ;_Высота текста
            )
          (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
	                              3  ;_Высота текста лИСТ
            )
          (vla-setcelltextheight tbl 1 1
                                    3  ;_Высота текста Наименование
            )
          (vla-setcelltextheight tbl 1 2
                                    3  ;_Высота текста Примечание
            )
          (vla-setcolumnwidth tbl 0
                                  15 ;_Ширина колонки Лист
            )
          (vla-setcolumnwidth tbl 1
                                  140 ;_Ширина колонки Наименование
            )
          (vla-setcolumnwidth tbl 2
                                  30 ;_Ширина колонки Примечание
            )
          (vla-put-horzcellmargin tbl 1) ;_Отступ текста по горизонтали
          (vla-SetRowHeight tbl 0 13) ;_Высота строки Ведомость чертежей
          (vla-SetRowHeight tbl 1 15) ;_Высота строки Лист Обозначение Наименование
          (setq row 1)
          (foreach i attlst
	    (setq row (1+ row))
	    (vla-SetRowHeight tbl row 8) ;_Высота строки
            (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
                             2.5  ;_Высота текста
              )
            (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
                             2.5  ;_Высота текста
              )
	    
            
            
            
            

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

В файле должен быть стиль таблицы "Ведомость чертежей". Для примера выкладываю файл, где все работает

[VVA]

wetr, Ты уже где-то писал, что понял для чего пишутся коментарии в лисп программах

Код:

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

(defun table-style-make ( table-style-name / tb xr tb-dic ret)
;;;Создаем стиль таблицы
;;; читать http://forum.dwg.ru/showpost.php?p=295877&postcount=120
;;  table-style-name - имя стиля [String]
;; Возвращает t - стиль создан
;;            nil - нет
  ;;Добавляем стиль таблицы такого нет. Не пересоздается, если существует

Теперь разбираем

Код:

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

(if                               ;_Начало оператора
(table-style-make "VRC") ;_Ф-ция table-style-make вернет t (истина) если 
                         ;_создан стиль VRC
(setvar "CTABLESTYLE" "VRC") ;_Если стиль создан делаем текущим
)  ;_Заканчивем if

Я еще выделил синим, что стиль не меняется, если существует
Поэтому можно смело менять
(if (table-style-make "VRC")(setvar "CTABLESTYLE" "VRC"))
на
(if (table-style-make "Ведомость чертежей")(setvar "CTABLESTYLE" "Ведомость чертежей"))

Вариант
(if (имеется_в_чертеже_стиль "Ведомость чертежей")(setvar "CTABLESTYLE" " Ведомость чертежей ") ("CTABLESTYLE" "Standard"))???
(для замены (if (table-style-make "VRC")(setvar "CTABLESTYLE" "VRC"))

Код:

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

(if (member (cons 3 "Ведомость чертежей")(DICTSEARCH (NAMEDOBJDICT) "ACAD_TABLESTYLE"))(setvar "CTABLESTYLE" "Ведомость чертежей"))

[ShaggyDoc]

Но толщины линий д.б. разные. Как мне показалось, программно этого нельзя сделать.

А как же ишшо их, толщины, программисту делать? Ну не руками же.
vla-setgridlineweight, vla-setcellgridlineweight
Только надо с умом, чтобы одни линии были "толстенькие", а другие тоненькие. Шоб по стандарту.

[wetr]

Резюмируя:

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

[b00]

А можно подробную инструкцию к примерам? Как например добавить новые позиции в таблицу (добавлял лист с блоком-рамкой, regen all, vrc -- новой позиции нет)?
В 2008 автокаде многострочный атрибут или отображается с \P или (после открытия-закрытия блока в редакторе блоков) преобразуется в однострочный.

[wetr]

b00,

Как например добавить новые позиции в таблицу (добавлял лист с блоком-рамкой, regen all, vrc -- новой позиции нет)?

Новой позиции не будет - вставляй новую таблицу, старую удаляй.

В 2008 автокаде многострочный атрибут или отображается с \P

Когда заполняешь многострочный атрибут, не жамкай ентер. Это он вылазит в виде \P. Просто набирай текст - он сам перенесется на новую строку. Или потаскай за грипсы многострочного атрибута в редакторе блоков.

[b00]

Сообщение от wetr b00, Новой позиции не будет - вставляй новую таблицу, старую удаляй.

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

Код:

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

Command: VRC
; error: too few arguments

В общем хорошо бы man по команде в первый пост добавить

Сообщение от wetr b00, Когда заполняешь многострочный атрибут, не жамкай ентер. Это он вылазит в виде \P. Просто набирай текст - он сам перенесется на новую строку. Или потаскай за грипсы многострочного атрибута в редакторе блоков.

Спасибо!

[VVA]

b00,

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

Посмотри этот файл примера wetr

[b00]

Вот тут в теме пример проскакивал
Последняя версия vrc.lsp позволяет подобное или нет? И если позволяет, то какие аргументы передавать для vrc?

[wetr]

b00, с какого поста брал код?
VVA, я тут подумал... (не пугайся )
В общем мой блок-рамка имеет пункт "Листов". Т.е. сколько всего штук.
благодаря твоей подсказке
http://forum.dwg.ru/showpost.php?p=110593&postcount=3
я сделал макрос на кнопку запускающую VRC

Код:

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

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

Сильно ногами не пинать - это мой первый макрос.
Прочитал, что переменные USERI* нужно стараться обходить стороной. Типа их все могут переопределять и тогда - "Ой". Но здесь вроде по другому не сделаешь.
Ну так вот, в блоке сделал поле в

Код:

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

%<\AcDiesel $(-,$(getvar,USERI1), 1)>%

т.к. у меня первый лист титульный.
И, вуаля, кол-во листов прописывается само. А теперь вопрос:
Почему у меня не получилось проделать тот же фокус с лиспом?
Т.е. я тупо вбил строчку

Код:

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

(setvar "USERI1" (length(layoutlist)))

после всего кода VRC, а он не срабатывал. Точнее срабатывал только 1 раз при перезапуске автокада, а при изменениях в текущей сессии результато в не давал. Что я сделал не так?

[b00]

Сообщение от wetr b00, с какого поста брал код?

Отсюда (как и пример чертежа):
131

[VVA]

wetr, b00, В примере #131 в лиспе ищется имя тага атрибута наименование чертежа "НАИМЕНОВАНИЕ.ЧЕРТЕЖА", а в блоке штампа "НАИМЕНОВАНИЕ.ЧЕРТЕЖА_001". Лисп не работает. Через пару минут выложу вариант vrc с настройками.
*** Добавлено
Вариант с настройками и файлом примера. Как работает написано вначале

[wetr]

VVA, СУПЕР! Все создается программно. Вынес все настройки в 1 место - спасибо, намного удобнее.
Только я не нашел ни в 1 файле тэг атрибута "НАИМЕНОВАНИЕ.ЧЕРТЕЖА_001". Может он сам приписывается? Я пробовал на 2х компах - не нашел, в лиспе исправил на "НАИМЕНОВАНИЕ.ЧЕРТЕЖА", заработало.
Выложу наверное в первом посте пояснения и ссылку на файлы - вроде уже идеал!