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

Вернуться   Форум DWG.RU > Отраслевые разделы > Инженерные сети > Электронный архив, проблемы

Электронный архив, проблемы

Ответ
Поиск в этой теме
Непрочитано 26.05.2006, 13:42 #1
Электронный архив, проблемы
Гусев Георгий
 
Инженер
 
Подольский р-н, п.Поливаново
Регистрация: 24.01.2006
Сообщений: 28

5 Мая сего года на форуме обсуждалась тема, как чистить файлы в архивах. Я скачал код:
;|
Основной код взят с
CADALYST 03/05 Tip2023: PurgeFiles.lsp Directory Clean Up (c)
Andrzej Gumula
[c]2004 Andrzej Gumula, Katowice, Poland
e-mail: [email protected]
This routine purge dwg files from selected folder
|;
(vl-load-com)
(defun c:CLAY (/ FilesList SubDir Files File)
(defun dolay ()

;;; Закоментарить, если не надо пуржить
(vla-purgeall File)
;;; Очистка всех фильтров слоев
(layer-filters-delete nil)
)
;|
=======================================================================================
* Ф-ция layer-filters-delete
* Очистка фильтров слоев
* имена фильтров, которые требуется оставить передаются списком
* Функция переписана с учетом особенностей версии 2005, где
появился новый словарь
* Автор — VK, программа неоднократно упоминалась на autocad.ru и
dwg.ru
* http://www.autocad.ru/cgi-bin/f1/boa...=1094BX&page=2
* Arguments [Type]:
lstnames = Object[list] — список фильтров '("Фильтр1"
"Фильтр2") или nil
* Возвращает [Type]:
nil
=======================================================================================|;
(defun layer-filters-delete
(lstnames / vla:lrs vla:xdic vla:dic vla:xrec name
datatype datavalue num)
(vl-load-com)
(setq vla:lrs (vla-get-layers File))
(if (= (vla-get-hasextensiondictionary vla:lrs) :vlax-true)
;; при наличии словаря требуется детальная проверка
(progn
(setq lstnames (mapcar 'strcase lstnames))
(setq vla:xdic (vla-getextensiondictionary vla:lrs))
(setq num 0)
;; поиск и удаление фильтров версий пре-2005
(if (progn (vlax-for item vla:xdic
(if (= (vla-get-name item) "ACAD_LAYERFILTERS")
(setq vla:dic item)
) ;_ if
) ;_ vlax-for
vla:dic
) ;_ progn
(progn
(vlax-for vla:xrec vla:dic
(if (not (member (strcase (setq name (vla-get-name
vla:xrec))) lstnames))
(progn (vla-remove vla:dic name)
(vlax-release-object vla:xrec)
(setq num (1+ num))
) ;_ progn
) ;_ if
) ;_ vlax-for
(vlax-release-object vla:dic)
(if (zerop num)
(princ "\nЛишних фильтров 2002 в рисунке не обнаружено.")
(princ "\nЛишние фильтры 2002 из рисунка удалены.")
) ;_ if
) ;_ progn
) ;_ if
(setq vla:dic nil)
(setq num 0)
;; поиск и удаление фильтров версии 2005
(if (progn (vlax-for item vla:xdic
(if (= (vla-get-name item) "ACLYDICTIONARY")
(setq vla:dic item)
) ;_ if
) ;_ vlax-for
vla:dic
) ;_ progn
(progn
(vlax-for vla:xrec vla:dic
(if
(progn
(setq name (vla-get-name vla:xrec))
(vla-getxrecorddata vla:xrec 'datatype 'datavalue)
(not (member (strcase (vlax-variant-value
(vlax-safearray-get-element
datavalue
(vl-position 300 (vlax-safearray->list
datatype))
) ;_ vlax-safearray-get-element
) ;_ vlax-variant-value
) ;_ strcase
lstnames
) ;_ member
) ;_ not
) ;_ progn
(progn
(vla-remove vla:dic name)
(vlax-release-object vla:xrec)
(setq num (1+ num))
) ;_ progn
) ;_ if
) ;_ vlax-for
(vlax-release-object vla:dic)
(if (zerop num)
(princ "\nЛишних фильтров 2005 в рисунке не обнаружено.")
(princ "\nЛишние фильтры 2005 из рисунка удалены.")
) ;_ if
) ;_ progn
) ;_ if
(vlax-release-object vla:xdic)
) ;_ progn
(princ "\nФильтров в рисунке не обнаружено.")
) ;_ if
(vlax-release-object vla:lrs)
(princ)
) ;_ defun

(defun GetFolder (/ Dir Item Path)
(cond
((setq Dir (vlax-invoke
(vlax-get-or-create-object "Shell.Application")
'browseforfolder
0
"Select folder with DWG files:"
1
""))
(cond
((not
(vl-catch-all-error-p
(vl-catch-all-apply 'vlax-invoke-method (list Dir
'Items))
))
(setq Item (vlax-invoke-method
(vlax-invoke-method Dir 'Items)
'Item
))
(setq Path (vla-get-path Item))
(if
(not (member (substr Path (strlen Path) 1) (list "/"
"\\")))
(setq Path (strcat Path "\\"))
)))))
Path)


(defun vl-findfile (Location / DirList Path AllPath)
(MakeDirList Location)
(setq DirList (cons Location DirList))
(foreach Elem DirList
(if (setq Path (vl-directory-files Elem "*.dwg"))
(foreach Item Path
(setq AllPath (cons (strcat Elem "/" Item) AllPath))
)))
(reverse AllPath))

(defun MakeDirList (Arg / TmpList)
(setq TmpList (cddr (vl-directory-files Arg nil -1)))
(cond
(TmpList
(setq
DirList (append
DirList
(mapcar '(lambda (z) (strcat Arg "/" z)) TmpList)
))
(foreach Item TmpList (MakeDirList (strcat Arg "/" Item)))
)))
(setq *ERR-LIST* nil)

(if (not FileSystemObject)
(setq FileSystemObject
(vla-getInterfaceObject
(vlax-get-acad-object)
"Scripting.FileSystemObject"
)))

(cond
((= (getvar "SDI") 0)
(cond
((setq DwgPath (GetFolder))
(initget 1 "Yes No")
(setq
Subdir (cond
((getkword "\nОбрабатывать поддиректории? [Yes/No]: "))
(T "Yes")
))
(if (equal SubDir "Yes")
(setq Files
(vl-findfile (substr DwgPath 1 (1- (strlen DwgPath))))
)
(setq Files (mapcar '(lambda (x) (strcat dwgpath x))
(vl-directory-files DwgPath "*.dwg" 1)
)))
(setq Files (mapcar 'strcase Files))
(cond
(Files
(vlax-for & (vla-get-documents (vlax-get-acad-object))
(setq FilesList
(cons (strcase (vla-get-fullname &)) FilesList)
))
(foreach & Files
(cond
((not (member & FilesList))
(cond
((/= (logand (vlax-get-property
(vlax-invoke-method
FileSystemObject
'getfile
&
)
'Attributes
)
1
)
1
)
(cond
((setq File (vla-open (vla-get-documents
(vlax-get-acad-object)
)
&
)
)
(prompt
(strcat "\nОбработка файла" & ". Подождите...")
)
;;; (vla-purgeall File)
(dolay)
(prompt (strcat "\nSave and close " &))
(vla-save File)
(vla-close File)
(vlax-release-object File)
)
(T
(prompt
(strcat
"\nCannot open "
&
"\nDrawing file was created by an incompatible version. "
)))))
(T
(prompt (strcat & " is read-only. Purge canceled. "))
)))
(T (prompt (strcat & " is open now. Purge canceled. ")))
)))
(T (prompt "\nNothing files found to purge. "))
))
(T (prompt "\nNothing selected. "))
))
(T (prompt "\nThe routine is not available in SDI mode. "))
)
(if *ERR-LIST*
(progn
(princ "\n\n\n ** НЕ УДАЛОСЬ УСТАНОВИТЬ ЗНАЧЕНИЕ ПЕРЕМЕННЫХ
**\n\n")
(mapcar
'(lambda ( item )
(princ "\nФайл — " )(princ (car item))
(princ " переменная ")(princ (cadr item))
(princ " значение ")(princ (caddr item))
)
*ERR-LIST*
)
))
(setq *ERR-LIST* nil)
(princ)
)
(prompt "\n=== Команда загружена. Наберите CLAY ===")
(princ)

Создал экспериментальную папку, поместил в неё 5 файлов общим весом 15 МВ. Запускаю программку, после чистки папка стала весить не 15 МВ, а все 22МВ.
В ходе выполнения программа открывает файлы, чистит, сохраняет их и закрывает. В результате в папке появляются "ВАК"и которые и утяжилили папку. В некоторых архивах "ВАК"и просто не нужны. Как от них избавиться? В архивах где "ВАК"и необходимы приходится запускать программку два раза. Есть ли программы которые бы чистили файлы и удаляли "ВАК"и автоматически?
__________________
Заранее спасибо!
Просмотров: 4806
 
Непрочитано 26.05.2006, 13:46
#2
asys

архитектор
 
Регистрация: 10.08.2005
Ростов-на-Дону
Сообщений: 5,283


Так в настройках ACAD-а отключи создание баков или экспрессом назначь папку куда все они будут складываться
asys вне форума  
 
Автор темы   Непрочитано 26.05.2006, 13:51
#3
Гусев Георгий

Инженер
 
Регистрация: 24.01.2006
Подольский р-н, п.Поливаново
Сообщений: 28
<phrase 1=


У меня в распоряжении нет Express Tools, где его можно скачать?
__________________
Заранее спасибо!
Гусев Георгий вне форума  
 
Непрочитано 26.05.2006, 13:57
#4
asys

архитектор
 
Регистрация: 10.08.2005
Ростов-на-Дону
Сообщений: 5,283


В downloade здесь на сайте есть, поищи
asys вне форума  
 
Непрочитано 26.05.2006, 14:07
#5
shnn

Инженер
 
Регистрация: 18.02.2005
Самара
Сообщений: 747


>Asys
А как баки складывать в отдельную папку??
shnn вне форума  
 
Непрочитано 26.05.2006, 14:37
#6
asys

архитектор
 
Регистрация: 10.08.2005
Ростов-на-Дону
Сообщений: 5,283


Цитата:
Сообщение от shnn
>Asys
А как баки складывать в отдельную папку??
Код:
[Выделить все]
Command: movebak
Initializing...MOVEBAK command loaded.New value for MOVEBAK, or . for none <D:\baki>: 
*Cancel*
запускаешь команду и пишешь ей путь
asys вне форума  
 
Непрочитано 26.05.2006, 15:30
#7
Alan

CAD
 
Регистрация: 28.08.2003
Киев
Сообщений: 1,835
<phrase 1=


Цитата:
Сообщение от shnn
>Asys
А как баки складывать в отдельную папку??
Делать это не надо. КАТЕГОРИЧЕСКИ !!!
Почему? Обсуждалось, поищи поиском.
Если конечно нужно удалить баки перед помещением в архив, то можно воспользовать Панелью оболочки Far.
Ну очень незатейливо и быстро... А главное предсказуемо!
__________________
По теории майский жук летать не может.
Но он этого не знает. И летает...
Alan вне форума  
 
Непрочитано 26.05.2006, 17:01
#8
asys

архитектор
 
Регистрация: 10.08.2005
Ростов-на-Дону
Сообщений: 5,283


Цитата:
Делать это не надо. КАТЕГОРИЧЕСКИ !!!
А мне это очень помогает, один раз очень сильно. Все доводы я уже видел и знаю, но мне в одной папке держать их удобней
asys вне форума  
 
Непрочитано 26.05.2006, 17:42
#9
Alan

CAD
 
Регистрация: 28.08.2003
Киев
Сообщений: 1,835
<phrase 1=


Цитата:
Сообщение от Asys
А мне это очень помогает, один раз очень сильно. Все доводы я уже видел и знаю, но мне в одной папке держать их удобней
Создание Бак-файла в процессе работы не обсуждаем? Теперь место.
Представьте, что Вы назвали разные файлы ( в разных рабочих папках) одинаково, например, etag1. Представили?
При записи Бак-файла в одну общую произойдёт затирание предыдущей. Не есть правильно!?
Что Вы экономите? Время на поиске файла?
Нет, наоборот - Вы будете вынуждены переходить из рабочей директории в директорию с бак-файлами.
Место на диске? Тоже нет, ровно столько же!!!
Это папку автосохранения нужно иметь одну, писал я в теме
http://dwg.ru/forum/viewtopic.php?t=...r=asc&start=15
Процитирую себя оттуда.
Цитата:
Наверное только правильнее папку для автосохранения назвать не TEMP (она обычно служит для системного мусора), a Save.Dwg. Мы у себя сделали так, чего и Вам желаем.
Посмотрите также, Vova писал.
http://dwg.ru/forum/viewtopic.php?t=1528
__________________
По теории майский жук летать не может.
Но он этого не знает. И летает...
Alan вне форума  
 
Непрочитано 26.05.2006, 17:55
#10
asys

архитектор
 
Регистрация: 10.08.2005
Ростов-на-Дону
Сообщений: 5,283


Alan, спасибо что потратили силы на подробные объяснения.
Цитата:
Представьте, что Вы назвали разные файлы ( в разных рабочих папках) одинаково, например, etag1.
Я НИКОГДА не называю разные файлы одним именем. Всё моё файло носит уникальные имена. Дабы спустя n-цать лет не перебирать кучу одинаковых файлов. И не затереть случайно один другим. Этому меня научили еще в начале моего обучения. Как говорят: "впитал с потом и кровью" :? Спасибо, что потратили время, но я для себя уже сделал выводы
asys вне форума  
 
Непрочитано 26.05.2006, 18:51
#11
Alan

CAD
 
Регистрация: 28.08.2003
Киев
Сообщений: 1,835
<phrase 1=


Цитата:
Сообщение от Asys
Я НИКОГДА не называю разные файлы одним именем. Всё моё файло носит уникальные имена. Дабы спустя n-цать лет не перебирать кучу одинаковых файлов. И не затереть случайно один другим. Этому меня научили еще в начале моего обучения. Как говорят: "впитал с потом и кровью" :?
>Asys
Имена файлов д.б. названы в соответствии с СТП, но это другая тема.
Извините, но всё-таки еще раз вернусь к этой теме - bak-файлах:
1.Самое простое и рациональное решение - хранить bak-файлы рядом с рабочими, т.е. в той же директории.
2. Перед копирование файлов чертежей в архив - bak-файлы можно и удалить. Или их не копировать в архив.
Способов много. См.выше, например п.7. У нас правда это автоматически, но это уже другая история.
__________________
По теории майский жук летать не может.
Но он этого не знает. И летает...
Alan вне форума  
 
Непрочитано 30.05.2006, 09:42
#12
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>Гусев Георгий
Можно на время выполнения команды отключить создание bak файлов, а потом вернуть обратно. Системная переменная ISAVEBAK
Код на лиспе
Код в начале
Код:
[Выделить все]
        (foreach Item TmpList (MakeDirList (strcat Arg "/" Item)))
      )))
  (setq *ERR-LIST* nil)
(setvar "ISAVEBAK" 0) ;;;<== Вставить эту строку
 (if (not FileSystemObject)
    (setq FileSystemObject
Код в конце
Код:
[Выделить все]
(setq *ERR-LIST* nil) 
(setvar "ISAVEBAK" 1) ;;;<== Вставить эту строку 

(princ) 
) 
(prompt "\n=== Команда загружена. Наберите CLAY ===")
VVA вне форума  
 
Автор темы   Непрочитано 26.01.2008, 09:42
#13
Гусев Георгий

Инженер
 
Регистрация: 24.01.2006
Подольский р-н, п.Поливаново
Сообщений: 28
<phrase 1=


>VVA
Спасибо, помогло, вроде работает
Гусев Георгий вне форума  
Ответ
Вернуться   Форум DWG.RU > Отраслевые разделы > Инженерные сети > Электронный архив, проблемы

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

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