[serg01]

Народ, подскажите пожалуйста, может кто сталкивался. Есть много файлов и их надо все разбить до примитивов, отпуржить, сделать аудит, совершить еще какие-нибудь действия над ними и сохранить. Как такое вытворить ? Возможно ли вообще такое ?
ЗЫ. На форуме как-то проскакивало, но найти не смог

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

Несколько вариантов, фактически различающиеся только методом открытия.
1. Открывать файлы через vla-open в фоновом режиме (достаточно медленно).
2. Открывать файлы через ObjectDBX (Олег jr. на autocad.ru несколько раз показывал подобный подход) - работает очень быстро; самое главное, чтобы обрабатываемые файлы не были никем уже открыты: для такого варианта надо прописывать свою обработку.
После открытия пройтись по всем вставкам блоков всех пространств и выполнить им vla-explode с последующим vla-erase. Как ты будешь поступать с арибутами и динамическими блоками, к примеру, я боюсь даже представить (а есть еще таблицы, proxy-Объекты). После этого сохранить файл.
Учти, что обращение к другому файлу возможно только через vla-функции. Применение (command), (vl-cmdf), а также интерактивных функций типа (entsel), (ssget) и т.п. недопустимо.

[serg01]

А может быть есть готовый лисп, а то не умею я программировать и все выше написанное как-то трудно доходит :shock: ?

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

Готовый лисп, гришь... Тут одним лиспом можно и не обойтись... Давай-ка не так - я тебе покажу на что меня хватит, а ты уж там сам попробуй разобаться
Погнали ?

Код:

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

(defun c:batch-purge (/                   acad
                      adoc                file_folder
                      file_list           _kpblc-get-browsefolder
                      z-files-in-directory
                      )
  (defun _kpblc-get-browsefolder (title / shlobj folder fldobj outval)
    (vl-load-com)
    (setq
      shlobj (vla-getinterfaceobject
               (vlax-get-acad-object)
               "Shell.Application"
               ) ;_ end of vla-getInterfaceObject
      folder (vlax-invoke-method shlobj 'browseforfolder 0 title 0)
      ) ;_ end of setq
    (vlax-release-object shlobj)
    (if folder
      (progn
        (setq
          fldobj (vlax-get-property folder 'self)
          outval (vlax-get-property fldobj 'path)
          ) ;_ end of setq
        (vlax-release-object folder)
        (vlax-release-object fldobj)
        outval
        ) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of defun

  (defun z-files-in-directory (directory pattern nested /)
    (if (not (listp pattern))
      (setq pattern (list pattern))
      ) ;_ if
    ;;(setq directory (strcat (vl-string-right-trim "\\" directory) "\\"))
    (if nested
      (apply
        'append
        (append
          (mapcar '(lambda (_pattern)
                     (mapcar '(lambda (f) (strcat directory "\\" f))
                             (vl-directory-files directory _pattern 1)
                             ) ;_ list
                     ) ;_ lambda
                  pattern
                  ) ;_ mapcar
          (mapcar
            '(lambda (d)
               (z-files-in-directory
                 (strcat directory "\\" d)
                 pattern
                 nested
                 ) ;_ z-files-in-directory
               ) ;_ lambda
            (vl-remove
              "."
              (vl-remove ".."
                         (vl-directory-files directory nil -1)
                         ) ;_ end of vl-remove
              ) ;_ vl-remove
            ) ;_ mapcar
          ) ;_ append
        ) ;_ append
      (apply
        'append
        (mapcar '(lambda (_pattern)
                   (mapcar '(lambda (f) (strcat directory "\\" f))
                           (vl-directory-files directory _pattern 1)
                           ) ;_ list
                   ) ;_ lambda
                pattern
                ) ;_ mapcar
        ) ;_ apply
      ) ;_ if
    ) ;_ defun

  (setq acad        (vlax-get-acad-object)
        adoc        (vla-get-activedocument acad)
        docs        (vla-get-documents acad)
        file_folder (_kpblc-get-browsefolder "Укажите обрабатываемую папку")
        ) ;_ end of setq
  (if file_folder
    (progn
      (setq file_list (z-files-in-directory file_folder "*.dwg" t))
      (foreach item file_list
        (setq doc (vla-open docs item))
        (repeat 2 (vla-purgeall doc))
        (vla-save doc)
        (vla-close doc)
        ) ;_ end of foreach
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun

Этот код на выполнение _.purge в фоновом режиме. Сделан достаточно давно (где-то в феврале, если не ошибаюсь), поэтому работает по первому варинту. Выполнять _.explode я б так не рискнул.
Да, вот еще. Здесь не учитывается, кажись, вариант открытого файла из списка.
При пакетной обработке вообще вопрос открытия уже открытого файла - по-моему, самый болезненный. Файл может быть открыт текущей сессией AutoCAD (еще хоть как-то отловить можно), другой сессией AutoCAD либо вообще другим пользователем. Как бы то ни было, файл заблокирован от изменений, поэтому открытие этого файла, может, еще и сработает. Но вот сохранить с изменениями - это уж вряд ли Так что тут не все так легко
===
Добавлено:
Да, кстати. Определи, надо работать над уже открытыми файлами или вообще над всеми, которые болтаются в определенном каталоге?

[Zouss]

в Migration assistance есть такая замечательная прога Script Manager - в ней задаешь список файлов, потом задаешь *.scr файл и над каждым файлом из этого списка выполняются команды из скрипта

конечно несколько старомодно пользовать scr но по мне так самый быстрый вариант обработать сотню-другую файлов - scr быстрее создать-отладить нежели нормальную прогу

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

Насчет скорости я б поспорил, если честно - все-таки файл надо открыть; обновить вид; изменить; опять обновить вид; сохранить... Если визуальное обновление снести, уже быстрее будет раза в полтора-два (ИМХО).

[Zouss]

я только про скорость отладки скрипта - мне часто приходится обрабатывать файлы примитивно, но по разному... написание скрипта занимает минут 5-10, программы (у меня %) ) обычно намного больше
проигрыш в скорости в данном случае не беспокоит особо - покурить/кофепопить тоже надо

[Лентяй]

Я тут как-то уже выкладвал программу Al-Quaida, взрывающую все на хрен, но для хорошего человека могу еще раз.

Код:

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

(defun C:AlQaida (/ acobj kw cmd dir file_list adoc);Explodes Everything
  (vl-load-com)
  (setq cmd (getvar "CMDECHO")
	acobj (vlax-get-acad-object))
  (initget "Opened List")
  (setq kw (getkword "\nPurge Opened File or <List>: [Opened/List]?"))
  (if (null kw) (setq kw "List"))
  (cond ((= kw "List")
	 (if (and (setq ShellApp (vla-getInterfaceObject acobj "Shell.Application"))
                  (setq dir (vlax-invoke-method ShellApp 'BrowseForFolder 0
                       "Select Directory to Look for Files in" 0)));and
           (progn (setq dir_lst (list Dir))
             (vlax-release-object ShellApp) (setq ShellApp nil)
             (while dir_lst (setq itms (vlax-invoke-method (car dir_lst) 'Items)
                                  cnt (1- (vla-get-count itms)));setq
               (while (< 0 cnt) (setq itm (vla-item itms cnt))
                 (if (= :vlax-true (vlax-get-property itm 'IsFileSystem))
                   (cond ((= "AutoCAD Drawing" (vla-get-Type itm))
                          (setq file_lst (cons (vla-get-Path itm) file_lst)))
                         ((= :vlax-true (vlax-get-property itm 'IsFolder))
                          (if (setq folItm (vl-catch-all-apply 'vlax-get-property (list itm 'GetFolder)))
                            (setq dir_lst (cons folItm dir_lst))))));if
                 (setq cnt (1- cnt)));while
               (setq dir_lst (cdr dir_lst))));progn
           file_lst);if
	 (foreach dwg file_lst (vla-open adoc (findfile (strcat dir "\\" dwg)))
	   (bprg adoc)));List
	((= kw "Open") (setq adoc (vla-get-activedocument acobj)) (bprg adoc)));cond
  (setvar "CMDECHO" cmd)
);end
;
(defun bprg (adoc / bks sps)
  (setq bks (vla-get-blocks adoc)
	sps (mapcar '(lambda (sp) (vlax-get-property adoc sp)) '(PaperSpace ModelSpace)))
  (apply '(lambda (x)
      (vlax-for obj x 
         (if (and (= (vla-get-objectname obj) "AcDbBlockReference") 
             (= (vla-get-IsXref (vla-item bks (vla-get-name obj))) :vlax-false)) 
      (vla-explode obj)))) sps)
    (repeat 3 (vla-purgeAll adoc))
    (vla-save adoc)
);bprg

[serg01]

to kpblc
Спасибо за лисп. Пуржит шуба заворачивается

Определи, надо работать над уже открытыми файлами или вообще над всеми, которые болтаются в определенном каталоге?

Работать конечно лучше над файлами в определенном каталоге. По поводу взрывания надо крайне, а то не хотелось бы чтоб "врагам" досталось, а вручную взрывать долго и нудно.

Самое главное чуть не забыл, вручную останавливает и то, что много чертежей начерчено в пространстве листа, а модель совершенно пуста

to Zouss
где сие добро взять ?

to Лентяй
попробовал, почему-то говорит, что взорван один блок, хотя их там толпа целая и мультитекста много.
Пробовал как на открытых, так и из каталога.

[serg01]

to kpblc

Вот в процессе обнаружил просто прямо старую болячку. При отпурживании чертежей если в них есть proxy акад клинит намертво. Есть такая хорошая штука, которую сделал Alexander Rivilis и называется она ExplodeProxy2007. Дак вот нельзя ли сделать так, чтоб при команде batch-purge вначале на каждом файле запускался бы этот arx, а затем все остальное ?

[Лентяй]

Сообщение от serg01 to Лентяй попробовал, почему-то говорит, что взорван один блок, хотя их там толпа целая и мультитекста много. Пробовал как на открытых, так и из каталога.

Так у вас, наверно, блоки не юниформные, то бищь одинаково промасштабированные. Держите издание исправленное и дополненное мультитекстом и полилиниями, раз вы такой террорист

Код:

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

;;Программа Аль-Кайеда. Взрывает все на хрен!
;;Следов тоже не оставляет.
;;
(defun C:AlQuaida (/ acobj kw cmd dir file_list adoc)
  (vl-load-com)
  (setq cmd (getvar "CMDECHO")
	acobj (vlax-get-acad-object)
        adoc (vla-get-ActiveDocument acobj)
        util (vla-get-utility adoc))
  (vla-InitializeUserInput util 128 "Opened List")
  (setq kw (vla-getKeyWord util "\nPurge Opened File or <List> [Opened/List]?"))
  (if (= "" kw) (setq kw "List"))
  (cond ((= kw "List")
	 (if (and (setq ShellApp (vla-getInterfaceObject acobj "Shell.Application"))
                  (setq dir (vlax-invoke-method ShellApp 'BrowseForFolder 0
                       "Select Directory to Look for Files in" 0)));and
           (progn (setq dir_lst (list Dir))
             (vlax-release-object ShellApp) (setq ShellApp nil)
             (while dir_lst (setq itms (vlax-invoke-method (car dir_lst) 'Items)
                                  cnt (1- (vla-get-count itms)));setq
               (while (< 0 cnt) (setq itm (vla-item itms cnt))
                 (if (= :vlax-true (vlax-get-property itm 'IsFileSystem))
                   (cond ((= "AutoCAD Drawing" (vla-get-Type itm))
                          (setq file_lst (cons (vla-get-Path itm) file_lst)))
                         ((= :vlax-true (vlax-get-property itm 'IsFolder))
                          (if (setq folItm (vl-catch-all-apply 'vlax-get-property (list itm 'GetFolder)))
                            (setq dir_lst (cons folItm dir_lst))))));if
                 (setq cnt (1- cnt)));while
               (setq dir_lst (cdr dir_lst))));progn
           file_lst);if
	 (foreach dwg file_lst (vla-open adoc (findfile (strcat dir "\\" dwg)))
	   (bprg adoc)));List
	((= kw "Open") (bprg adoc)));cond
  (setvar "CMDECHO" cmd)
);end
;
(defun bprg (adoc / bks sps)
  (setq bks (vla-get-blocks adoc)
	sps (mapcar '(lambda (sp) (vlax-get-property adoc sp)) '(PaperSpace ModelSpace)))
  (mapcar '(lambda (x)
      (vlax-for obj x 
         (if (or (and (= (vla-get-objectname obj) "AcDbBlockReference")
                      (= (vla-get-IsXref (vla-item bks (vla-get-name obj))) :vlax-false))
                 (= (vla-get-objectname obj) "AcDbMText")
                 (= (vla-get-objectname obj) "AcDbPolyline"));or
             (vl-cmdf "_explode" (vlax-vla-object->ename obj))))) sps)
    (repeat 3 (vla-purgeAll adoc))
    (vla-save adoc)
);bprg

[serg01]

to Лентяй
чего-то я туплю тут
Если пробовать на открытом файле, то вот чего говорит :

Purge Opened File or <List> [Opened/List]?o

Command: 1

а если пробовать из каталога, то вот чего :
Purge Opened File or <List> [Opened/List]?l

Command: ; error: bad argument type: stringp #<VLA-OBJECT Folder3 0ed57d88>

Ничего не понимаю :shock:

[Лентяй]

Пардоньте, плз, ачепятка вкрамшись [sm2100], после ликвидации каковой все работает как часы. Я так думаю (С)

Код:

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

;;Программа Аль-Кайеда. Взрывает все на хрен! 
;;Следов тоже не оставляет. 
;;
(defun C:AlQuaida (/ acobj adoc util kw ShellApp cmd dir dir_lst itms cnt itm file_lst folItm)
  (vl-load-com)
  (setq cmd (getvar "CMDECHO")
        acobj (vlax-get-acad-object)
        adoc (vla-getinterfaceobject acobj "ObjectDBX.AxDbDocument.16")
        util (vla-get-utility adoc))
  (setvar "CMDECHO" 0)
  (vla-InitializeUserInput util 128 "Opened List")
  (setq kw (vla-getKeyWord util "\nPurge Opened File or <List> [Opened/List]?"))
  (if (= "" kw) (setq kw "List"))
  (cond ((= kw "List")
	 (if (and (setq ShellApp (vla-getInterfaceObject acobj "Shell.Application"))
                  (setq dir (vlax-invoke-method ShellApp 'BrowseForFolder 0
                       "Select Directory to Look for Files in" 0)));and
           (progn (setq dir_lst (list Dir))
             (vlax-release-object ShellApp) (setq ShellApp nil)
             (while dir_lst (setq itms (vlax-invoke-method (car dir_lst) 'Items)
                                  cnt (1- (vla-get-count itms)));setq
               (while (< 0 cnt) (setq itm (vla-item itms cnt))
                 (if (= :vlax-true (vlax-get-property itm 'IsFileSystem))
                   (cond ((= "AutoCAD Drawing" (vla-get-Type itm))
                          (setq file_lst (cons (vla-get-Path itm) file_lst)))
                         ((= :vlax-true (vlax-get-property itm 'IsFolder))
                          (if (setq folItm (vl-catch-all-apply 'vlax-get-property (list itm 'GetFolder)))
                            (progn (print folItm)
                              (setq dir_lst (cons folItm dir_lst)))))));if
                 (setq cnt (1- cnt)));while
               (setq dir_lst (cdr dir_lst))));progn
           file_lst);if
	 (foreach dwg file_lst (vla-open adoc (findfile dwg))
	   (bprg adoc)));List
	((= kw "Opened") (bprg (vla-get-ActiveDocument acobj))));cond
  (setvar "CMDECHO" cmd)
);end
;
(defun bprg (adoc / bks sps)
  (setq bks (vla-get-blocks adoc)
	sps (mapcar '(lambda (sp) (vlax-get-property adoc sp)) '(PaperSpace ModelSpace)))
  (mapcar '(lambda (x)
      (vlax-for obj x 
         (if (or (and (= (vla-get-objectname obj) "AcDbBlockReference")
                      (= (vla-get-IsXref (vla-item bks (vla-get-name obj))) :vlax-false))
                 (= (vla-get-objectname obj) "AcDbMText")
                 (= (vla-get-objectname obj) "AcDbPolyline"));or
             (vl-cmdf "_explode" (vlax-vla-object->ename obj))))) sps)
    (if (vlax-method-applicable-p adoc 'PurgeAll)
      (progn (repeat 3 (vla-purgeAll adoc)) (vla-close n_doc :vlax-true)))
);bprg

[serg01]

Лентяй
Теперь вообще ничего не хочет
В 2007 говорит вот это:
AlQuaida
; error: Automation Error. Problem in loading application

а в 2006 каде вот это:
AlQuaida
; error: ActiveX Server returned the error: unknown name: Utility

Да ладно, буду в ручную эксплодить.

[Vova]

Сообщение от serg01 Народ, подскажите пожалуйста, может кто сталкивался. Есть много файлов и их надо все разбить до примитивов,

Зачем? Сохранить секретность? Полилинии станут тонкие, атрибуты у блоков превратятся в ерунду, правильно сделанные блоки поменяют цвет, подрезанные (xclip) блоки распустятся и так далее. Чертеж-чья-то большая работа-можно выкинуть в помойку. Чертежи, говоришь, сделаны все в пространстве листа. Это значит, неграмотный автокадчик делал. Какие такие секреты могут быть у неграмотного?

[Лентяй]

Сообщение от serg01 Лентяй Теперь вообще ничего не хочет В 2007 говорит вот это: AlQuaida ; error: Automation Error. Problem in loading application а в 2006 каде вот это: AlQuaida ; error: ActiveX Server returned the error: unknown name: Utility Да ладно, буду в ручную эксплодить.

Погодь, не спеши [sm2001]. Попробуй вот это:

Код:

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

;;Программа Аль-Кайеда. Взрывает все на хрен! 
;;Следов тоже не оставляет. 
;; 
(defun C:AlQuaida (/ acobj adoc util kw ShellApp cmd dir dir_lst itms cnt itm file_lst folItm) 
  (vl-load-com) 
  (setq cmd (getvar "CMDECHO") 
        acobj (vlax-get-acad-object) 
        adoc (vla-getinterfaceobject acobj "ObjectDBX.AxDbDocument.16") 
        util (vla-get-utility (vla-get-ActiveDocument acobj))) 
  (setvar "CMDECHO" 0) 
  (vla-InitializeUserInput util 128 "Opened List") 
  (setq kw (vla-getKeyWord util "\nPurge Opened File or <List> [Opened/List]?")) 
  (if (= "" kw) (setq kw "List")) 
  (cond ((= kw "List") 
    (if (and (setq ShellApp (vla-getInterfaceObject acobj "Shell.Application")) 
                  (setq dir (vlax-invoke-method ShellApp 'BrowseForFolder 0 
                       "Select Directory to Look for Files in" 0)));and 
           (progn (setq dir_lst (list Dir)) 
             (vlax-release-object ShellApp) (setq ShellApp nil) 
             (while dir_lst (setq itms (vlax-invoke-method (car dir_lst) 'Items) 
                                  cnt (1- (vla-get-count itms)));setq 
               (while (< 0 cnt) (setq itm (vla-item itms cnt)) 
                 (if (= :vlax-true (vlax-get-property itm 'IsFileSystem)) 
                   (cond ((= "AutoCAD Drawing" (vla-get-Type itm)) 
                          (setq file_lst (cons (vla-get-Path itm) file_lst))) 
                         ((= :vlax-true (vlax-get-property itm 'IsFolder)) 
                          (if (setq folItm (vl-catch-all-apply 'vlax-get-property (list itm 'GetFolder))) 
                            (progn (print folItm) 
                              (setq dir_lst (cons folItm dir_lst)))))));if 
                 (setq cnt (1- cnt)));while 
               (setq dir_lst (cdr dir_lst))));progn 
           file_lst);if 
    (foreach dwg file_lst (vla-open adoc (findfile dwg)) 
      (bprg adoc)));List 
   ((= kw "Opened") (bprg (vla-get-ActiveDocument acobj))));cond 
  (setvar "CMDECHO" cmd) 
);end 
; 
(defun bprg (adoc / bks sps) 
  (setq bks (vla-get-blocks adoc) 
   sps (mapcar '(lambda (sp) (vlax-get-property adoc sp)) '(PaperSpace ModelSpace))) 
  (mapcar '(lambda (x) 
      (vlax-for obj x 
         (if (or (and (= (vla-get-objectname obj) "AcDbBlockReference") 
                      (= (vla-get-IsXref (vla-item bks (vla-get-name obj))) :vlax-false)) 
                 (= (vla-get-objectname obj) "AcDbMText") 
                 (= (vla-get-objectname obj) "AcDbPolyline"));or 
             (vl-cmdf "_explode" (vlax-vla-object->ename obj))))) sps) 
    (if (vlax-method-applicable-p adoc 'PurgeAll) 
      (progn (repeat 3 (vla-purgeAll adoc)) (vla-close n_doc :vlax-true))) 
);bprg

Успехов в на ниве терроризма :twisted:

[serg01]

Vova
Надо это за тем, чтоб всякие хитрые "рыбы" не пользовали наработанные болванки. Бывают случаи когда чертежи просят, аж не могут и начальство давит на то, чтоб их вот так взять и отдать. Жаба то давит. Работаешь, работаешь и тут на тебе! По поводу черчения в layout согласен, не дело это.

Лентяй

на 2007 так же не запускается, а на 2006 ситуация такая:
- при команде l (из каталога) говорит, что ничего не нашел;
- если на загруженном файле, то за один раз не разбивает, т.е. надо ее 10 раз нажимать.

ЗЫ. А они вообще проверяются перед выкладыванием ?

[serg01]

Куда все делись то ??? Может я чего не так делаю ? :shock:

[Лентяй]

Админ! Куда делись мои постинги после 23.08.2006? [sm1211] [sm1212]

[Admin]

Сообщение от Лентяй Админ! Куда делись мои постинги после 23.08.2006? [sm1211] [sm1212]

я не трогал. а что там было?

[Vova]

Сообщение от serg01 Надо это за тем, чтоб всякие хитрые "рыбы" не пользовали наработанные болванки.

Меня всегда занимал вопрос-зачем секретить файл. Допустим, есть конкурирющая фирма с такой-же специализацией. Она может отобрать у вас заказчиков. От нее и можно скрывать свои секреты. Но неужели конкуренты просят друг у друга чертежи? Могут просить только заказчики, а от них зачем скрывать? Ведь они вас кормят. Кстати, фирма конкурент переманит себе вашего сотрудника, и с ним придут туда все ваши секреты. Serg01, пойдешь к ним с прибавкой жалования в 20%?
Взрывать все - плохое решение. Если у них нет грамотных (по автокаду) спецов, то сделайте так как показано здесь http://www.autocad.ru/cgi-bin/f1/board.cgi?t=29287el

[Лентяй]

Сообщение от Admin Сообщение от Лентяй Админ! Куда делись мои постинги после 23.08.2006? [sm1211] [sm1212] я не трогал. а что там было?

НЯП, там была откорректированная прога для serg01. Кстати, в вашем списке отсутсвует мой последний постинг 24.08.06