[ASLYS]

В строительную часть добавили несколько новых слоев. Мне надо на всех планах с разводками выключить эти новые слои в XRef, изменить цвет некоторых слоев. Сделал такой лисп, закинул его в автозагрузку - немного облегчает работу, но все равно нужно открывать каждый чертеж.

Код:

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

(if(tblsearch "layer" (setq l "Servicios_UPM|EQUIPAMIENTO")) (command "_layer" "_off" l ""))
(if(tblsearch "layer" (setq l "LEF+LMA_planta primera|SOMB_ferrater")) (command "_layer" "_off" l ""))

(if(tblsearch "layer" (setq l "Datos_FORMATO_A1")) (command "-layer" "_c" "7" l ""))
(if(tblsearch "layer" (setq l "formato_A1|00-caratula")) (command "-layer" "_c" "7" l ""))
(if(tblsearch "layer" (setq l "formato_A1|00-recuadro")) (command "-layer" "_c" "7" l ""))
(if(tblsearch "layer" (setq l "formato_A1|00-logo IDOM")) (command "-layer" "_c" "170" l ""))
(if(tblsearch "layer" (setq l "Datos_FORMATO_A0")) (command "-layer" "_c" "7" l ""))
(if(tblsearch "layer" (setq l "formato_A0|00-caratula")) (command "-layer" "_c" "7" l ""))
(if(tblsearch "layer" (setq l "formato_A0|00-recuadro")) (command "-layer" "_c" "7" l ""))
(if(tblsearch "layer" (setq l "formato_A0|00-logo IDOM")) (command "-layer" "_c" "170" l ""))

;(command "_clayer" "0" "_zoom" "_e" "_qsave" "_close")

Хочется открыть один чертеж и поменять все в остальных. Знаю, что на VBA такое сделать можно, но не знаю как...

[Кулик Алексей aka kpblc]

Попробуй, код я не тестировал.

Код:

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

(defun test (file-list                /
             _kpblc-acad-version      _kpblc-odbx
             _kpblc-odbx-close        _kpblc-conv-value-to-string
             _kpblc-conv-value-to-int _kpblc-dir-path-and-splash
             _kpblc-string-ext        doc
             lay
             )
            ;|
*    Обработка списка файлов.
*    Параметры вызова:
*	file-list	список полных имен файлов, которые надо обработать
|;

  (defun _kpblc-string-ext (string ext / str)
                           ;|
*    Функция меняет "расширение" переданной строки на устанавливаемое. В строке
* должно быть не более 1 символа ".", все, что после него, считается
* расширением
*    Параметры вызова:
*	string	модифицируемая строка
*	ext	устанавливаемое расширение (можно без ".")
*    Примеры вызова:
(_kpblc-string-ext "abcd" "cfg")	; -> "abcd.cfg"
(_kpblc-string-ext "AbCd" ".ext")	; -> "abcd.ext"
|;
    (setq ext (strcat "." (vl-string-left-trim "." ext))
          str (strcase (vl-filename-base string))
          str (strcase (strcat (vl-string-trim " " str) ext) t)
          ) ;_ end of setq
    (if (/= (vl-filename-directory string) "")
      (setq
        str
         (strcat (_kpblc-dir-path-and-splash (vl-filename-directory string))
                 str
                 ) ;_ end of strcat
        ) ;_ end of setq
      ) ;_ end of if
    str
    ) ;_ end of defun

  (defun _kpblc-dir-path-and-splash (path)
                                    ;|
*    Возвращает путь со слешем в конце
*    Параметры вызова:
*	path	- обрабатываемый путь
*    Примеры вызова:
(_kpblc-dir-path-and-splash "c:\\kpblc-cad")	; "c:\\kpblc-cad\\"
|;
    (strcat (vl-string-right-trim "\\" path) "\\")
    ) ;_ end of defun

  (defun _kpblc-conv-value-to-int (value /)
                                  ;|
*    конвертация значения в целое. Для VLA-объектов возвращается nil.
*    Точечные списки не обрабатываются.
|;
    (atoi (_kpblc-conv-value-to-string value))
    ) ;_ end of defun

  (defun _kpblc-conv-value-to-string (value /)
                                     ;|
*    конвертация значения в строку. Для VLA-объектов возвращается nil.
*    Точечные списки не обрабатываются.
|;
    (if value
      (vl-princ-to-string value)
      ""
      ) ;_ end of if
    ) ;_ end of defun

  (defun _kpblc-acad-version ()
                             ;|
*    Возвращает номер сборки AutoCAD'a. Для 2005 вернет 16.1, для 2006 - 16.2
|;
    (atof (getvar "acadver"))
    ) ;_ end of defun

  (defun _kpblc-odbx (/)
                     ;|
*    функция возвращает интерфейс IAxDbDocument (для работы с файлами DWG без
* их открытия). Если интерфейс не поддерживается, возвращает nil. Проверено
* на ACAD 2002, 2004, 2005, 2006, 2007
*    Автор - Fatty aka Олег jr. Моего только адаптация под общую систему и
* переименование
*    Параметры вызова:
*	нет
*    Примеры вызова:
(_kpblc-odbx)
|;
    (cond
      ((< (_kpblc-acad-version) 15.06)
       (alert "ObjectDBX method not applicable\nin this AutoCAD version")
       nil
       )
      ((= (fix (_kpblc-acad-version)) 15)
       (if (not (vl-registry-read
                  "HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument\\CLSID"
                  ) ;_ end of vl-registry-read
                ) ;_ end of not
         (startapp "regsvr32.exe"
                   (strcat "/s \"" (findfile "axdb15.dll") "\"")
                   ) ;_ end of startapp
         ) ;_ end of if
       (vla-getinterfaceobject
         (vlax-get-acad-object)
         "ObjectDBX.AxDbDocument"
         ) ;_ end of vla-getinterfaceobject
       )
      (t
       (vla-getinterfaceobject
         (vlax-get-acad-object)
         (strcat "ObjectDBX.AxDbDocument."
                 (_kpblc-conv-value-to-string
                   (_kpblc-conv-value-to-int (_kpblc-acad-version))
                   ) ;_ end of _kpblc-conv-value-to-string
                 ) ;_ end of strcat
         ) ;_ end of vla-getinterfaceobject
       )
      ) ;_ end of cond
    ) ;_ end of defun

  (defun _kpblc-odbx-close (conn)
                           ;|
*    Закрытие файла, открытого ранее через _kpblc-odbx-*. С попыткой сохранения
*    Параметры вызова:
*	conn	соединение с ObjectDBX, созданное ранее через (_kpblc-odbx)
*		либо список:
      '(("conn" . <ObjectDBXConnection>)	; то же самое
	("save" . t)			; сохранять или нет изменения
	("file" . "c:\\temp\\tmp.dwg")	; имя, под которым сохранять. nil ->
		; использовать текущее
|;
    (if (and (= (type conn) 'list)
             (cdr (assoc "save" conn))
             ) ;_ end of and
      (progn
        (vlax-invoke
          (cdr (assoc "conn" conn))
          'saveas
          (cond
            ((cdr (assoc "file" conn))
             (strcat (_kpblc-dir-path-and-splash (vl-filename-directory file))
                     (_kpblc-string-ext (vl-filename-base file) "dwg")
                     ) ;_ end of strcat
             )
            (t (vla-get-name (cdr (assoc "conn" conn))))
            ) ;_ end of cond
          ) ;_ end of vlax-invoke
        ) ;_ end of progn
      ) ;_ end of if
    (vl-catch-all-apply
      '(lambda ()
         (vlax-release-object
           (if (= (type conn) 'list)
             (cdr (assoc "conn" conn))
             conn
             ) ;_ end of if
           ) ;_ end of vlax-release-object
         ) ;_ end of lambda
      ) ;_ end of vl-catch-all-apply
    (setq conn nil)
    ) ;_ end of defun

  (foreach file file-list
    (setq doc (_kpblc-odbx))
    (vla-open doc file)
    (foreach item '(("Servicios_UPM|EQUIPAMIENTO" ("off" . t))
                    ("LEF+LMA_planta primera|SOMB_ferrater" ("off" . t))
                    ("Datos_FORMATO_A1" ("color" . 7))
                    ("formato_A1|00-caratula" ("color" . 7))
                    ("formato_A1|00-recuadro" ("color" . 7))
                    ("formato_A1|00-logo IDOM" ("color" . 170))
                    ("Datos_FORMATO_A0" ("color" . 7))
                    ("formato_A0|00-caratula" ("color" . 7))
                    ("formato_A0|00-recuadro" ("color" . 7))
                    ("formato_A0|00-logo IDOM" ("color" . 170))
                    )
      (if
        (not
          (vl-catch-all-error-p
            (vl-catch-all-apply
              '(lambda () (setq lay (vla-item (vla-get-layers doc) (car item))))
              ) ;_ end of vl-catch-all-apply
            ) ;_ end of vl-catch-all-error-p
          ) ;_ end of not
         (progn
           (if (cdr (assoc "off" (cdr item)))
             (vla-put-layeron lay :vlax-false)
             ) ;_ end of if
           (if (cdr (assoc "color" (cdr item)))
             (vla-put-color lay (cdr (assoc "color" (cdr item))))
             ) ;_ end of if
           ) ;_ end of progn
         ) ;_ end of if
      ) ;_ end of foreach
    (_kpblc-odbx-close (list (cons "conn" doc) (cons "save" t)))
    ) ;_ end of foreach
  ) ;_ end of defun

[ASLYS]

Спасибо, завтра на работе попробую

[ASLYS]

работает !!! спасибо
дописал в начале это (для DOSLIB):

Код:

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

(defun c:test( / i j k l L-files file-list Path-files)
 (setq i(dos_getfilem "Select a file" "H:\\Encargos\\11430 LABORATORIOS POLITECNICA\\15-DIRECCIÓN DE OBRA\\00-DOCUMENTACIÓN GRÁFICA\\03-Instalaciones\\5.Climatización\\" "Drawing files (*.dwg)|*.dwg|") Path-files(car i)L-names(cdr i))
 (foreach k L-names(setq l(cons Path-files l )))
 (setq file-list(mapcar'(lambda (x y)(strcat x y)) l L-names ))
 (test file-list)
  
)

[Кулик Алексей aka kpblc]

Вот здесь VVA выкладывал лисп dofile - посмотри, может, тож сгодится. Для формирования списка файлов лично я использую функцию z-files-in-directory, показанную ZZZ в http://www.autocad.ru/cgi-bin/f1/board.cgi?t=19612AN

[ASLYS]

Lisp получился наиполезнейший!
вчера побыстрому закинул около 1000 чертежей, и повыключал ненужные слои. до сих пор не нарадуюсь.
не омрачает даже тот факт, что сегодня с утра начали поступать жалобы от смежников (и до сих пор идут нескончаемым потоком). уже стоят в очереди, чтобы спросить что случилось с проектом-теперь его никто не может открыть! (кроме меня)
У меня АКАД2008, а в конторе официально установлен 2006. Kод сохраняет в текущей версии АКАДа, т.е. в 2007, где можно задать версию сохранения?

[Кулик Алексей aka kpblc]

Через ObjectDBX (что здесь и применяется) выполнить сохранение "не в своем" формате невозможно (по крайней мере мне не удалось - ни в 2005, ни в 2007). Поэтому придется либо тебе запускать впредь этот лисп в 2006 версии, либо попробовать такое (намного более медленное):<Код удалил, там была одна ошибка>. См.ниже.

[VVA]

Попробуй _options-> Открытие и сохранение(Open and Save)->Save as->Выбрать требуемую версию

[Кулик Алексей aka kpblc]

Я пробовал (правда, на ADT). Лично у меня почему-то номер не прокатил

[Кулик Алексей aka kpblc]

Во втором варианте кода (который я снес) я забыл одну строчку достаточно важную.

Код:

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

(defun test2 (file-list / _kpblc-error-catch doc)

  (defun _kpblc-error-catch (protected-function
                             on-error-function
                             /
                             catch_error_result
                             )
                            ;|
*** Функция взята из книжной версии ruCAD'a без каких бы то ни было переделок,
*** кроме переименования.
*    Оболочка отлова ошибок.
*    Параметры вызова:
*   protected-function   - "защищаемая" функция
*   on-error-function   - функция, выполняемая в случае ошибки
|;
    (setq catch_error_result (vl-catch-all-apply protected-function))
    (if (and (vl-catch-all-error-p catch_error_result)
             on-error-function
             ) ;_ end of and
      (apply on-error-function
             (list (vl-catch-all-error-message catch_error_result))
             ) ;_ end of apply
      catch_error_result
      ) ;_ end of if
    ) ;_ end of defun

  (vl-load-com)
  (foreach file file-list
    (_kpblc-error-catch
      (function
        (lambda ()
          (if (findfile file)
            (progn
              (setq
                doc (vla-open (vla-get-documents (vlax-get-acad-object)) file)
                ) ;_ end of setq
              (foreach item
                       '(("Servicios_UPM|EQUIPAMIENTO" ("off" . t))
                         ("LEF+LMA_planta primera|SOMB_ferrater" ("off" . t))
                         ("Datos_FORMATO_A1" ("color" . 7))
                         ("formato_A1|00-caratula" ("color" . 7))
                         ("formato_A1|00-recuadro" ("color" . 7))
                         ("formato_A1|00-logo IDOM" ("color" . 170))
                         ("Datos_FORMATO_A0" ("color" . 7))
                         ("formato_A0|00-caratula" ("color" . 7))
                         ("formato_A0|00-recuadro" ("color" . 7))
                         ("formato_A0|00-logo IDOM" ("color" . 170))
                         )
                (if
                  (not
                    (vl-catch-all-error-p
                      (vl-catch-all-apply
                        '(lambda ()
                           (setq lay (vla-item (vla-get-layers doc) (car item)))
                           ) ;_ end of lambda
                        ) ;_ end of vl-catch-all-apply
                      ) ;_ end of vl-catch-all-error-p
                    ) ;_ end of not
                   (progn
                     (if (cdr (assoc "off" (cdr item)))
                       (vla-put-layeron lay :vlax-false)
                       ) ;_ end of if
                     (if (cdr (assoc "color" (cdr item)))
                       (vla-put-color lay (cdr (assoc "color" (cdr item))))
                       ) ;_ end of if
                     ) ;_ end of progn
                   ) ;_ end of if
                ) ;_ end of foreach
              (vla-saveas doc file ac2004_dwg)
              (vla-close doc) ;; Вот этой строки там не было.
              ) ;_ end of progn
            ) ;_ end of if
          ) ;_ end of lambda
        ) ;_ end of function
      '(lambda (x) (princ (strcat "ERRRNO: " (itoa (getvar "errno")))))
      ) ;_ end of _kpblc-error-catch
    ) ;_ end of foreach
  ) ;_ end of defun

[ASLYS]

добавил

Код:

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

(progn (vla-saveas doc file ac2004_dwg) (VLA-close doc :vlax-true file))

Медленно, но работает, главное-результат!
А если при открытии не подгружать XRefы? что-то вроде partialopen возможно ли такое?
Open and Save на работе у всех стоит 2004. это обязательно
проблема в том, что файл сохраняется не АКАДом. пробовал дописать ac2004_dwg, выдает ошибку

[VVA]

Есть еще вариант, правда потребует некоторого кол-ва трафика.
1. Оставить как было
2. Полученные файла обработать
Autodesk DWG TrueView 2008 (122 Мб)
или
Autodesk DWG TrueConvert 2007 (33 Мб)
ссылки здесь
http://www.xanadu.cz/en/download.asp

[ASLYS]

>VVA спасибо, начинаю качать

на работе пытаются разобраться с
vlax-create-object
vla-getinterfaceobject

[VVA]

функция vla-getInterfaceObject и что оно такое

[ASLYS]

проблему решил как советовал VVA
лисп из поста N2 + Autodesk DWG TrueView 2008
большое спасибо