Информационный портал для профессионалов в области САПР
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Форумы CADUser → Программирование → LISP → Поделитесь программкой для чистки файлов
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Уважаемые господа, если возможно, не могли бы Вы поделится программкой по чистке файлов. Что бы можно было из акада указать папку и она последовательно вычистила (purge) бы все файлы находящиеся в указанной папке.
Много воды утекло с тех пор. Но если задача не до исх пор не решена, вот ее решение:
(defun PALL ( / ac patch fil sp)
(vl-load-com)
(setq ac(vlax-create-object "Autocad.Application"))
(vlax-put-property ac "Visible" :vlax-false)
(setq fil(vla-get-ActiveDocument ac))
(vlax-invoke-method fil "Close" :vlax-false)
(setq doc(vla-get-Documents ac))
(setq patch(getfiled "Выбор чертежей" "" "dwg" 16))
(setq patch(vl-filename-directory patch))
(setq sp(vl-directory-files patch "*.dwg" 1))
(setq sp(mapcar '(lambda(x)(strcat patch "\\" x))sp))
(foreach n sp
(setq fil (vlax-invoke-method doc "Open" n))
(vlax-invoke-method fil "Purgeall")
(vlax-invoke-method fil "Save")
(vlax-invoke-method fil "Close")
)
(vlax-invoke-method ac "Quit")
)Во время работы программы желательно ее не прерывать -
процесс достаточно длинный.
Больщое спасибо!
Попробовал Вашу программу. Она просит выбрать конкретный файл, а хотелось бы что бы можно было указать директорию с двумя десятками файлом и программы вычистила бы все двадцать файлов.
Конечно Ваша программа много лучше того, что я делал раньше, но всетаки...
Хотя и просит конкретный файл, но чистит все в этой дирректори. Попробую изменить.
Чтобы выбрать все файлы указанием на папку придётся использовать Doslib
https://www.caduser.ru/forum/topic6940.html
> AV
Это почему? В GETFILED по-моему есть какой-то бит, отвечающй за это.
Я пробовал найти такой бит. Что-то не получается.
Думаю, что предложенная прогр. не удалит за один проход вложенные блоки (ессно неиспользуемые).
Хотя, если использовать бит 1 вместо 16, то высвечивается имя текущего файла. Тогда выбирай любую нужную дирректорию и жми "Открыть". Все равно это имя в дальнейшем не используется.
> VVI
Да, похоже что и нету. Но влюбом случае, как было сделано у тебя - вполне нормально. Непонятно че они возмущаются...
Да, вложенные блоки не удалит. Но можно исправить. Если по простому зациклить хотя бы 3 раза процесс удаления с помощью repeat.
Я не знал что достататочно указать один файл.
Тогда все хорошо, спасибо!
Попробовал еще раз, добавив еще два раза
(vlax-invoke-method fil "Purgeall") - ОТЛИЧНО.
Еще раз спасибо!
Чтобы контролировать ошибки при откр. файлов
предлагаю так (на всякий случай):
(setq ct 0)
(repeat (length sp)
(setq fil (vl-catch-all-apply 'vla-open (list doc (nth ct sp))))
(if (not (vl-catch-all-error-p fil))
(progn
(vlax-invoke-method fil "Purgeall")
(vlax-invoke-method fil "Save")
(vlax-invoke-method fil "Close")
)
)
(setq ct (1+ ct))
)И ещё. Если один из файлов будет открыт прога сделает ручкой.
Нужно проверять на уже открытые.
Абсолютно с тобой согласен AV. Проверка нужна.
Программа VVI c доработкой AV (и без нее) выдает буквально следующее:Команда: (pall)
; ошибка: ActiveX Server возвратил ошибку: Сервер RPC недоступен
Что бы это значило? Где что нужно исправить?
У меня не срабатывает функция
(vlax-create-object "Autocad.Application")
После некоторых доработок получилось следующее:
(defun PurgeSomeFiles (
/
AcadObject
ActiveDocument
DocumentsCollection
path
FileList
Counter
path
x
)
(vl-load-com);Загрузка расширения
(setq AcadObject (vlax-get-acad-object))
(setq ActiveDocument (vla-get-activedocument AcadObject))
(setq DocumentsCollection (vla-get-documents AcadObject))
(setq path (vl-filename-directory (getfiled "Выберете любой чертеж в очищаемой папке" "" "dwg" 16)));получение пути
(alert "!!!Внимание!!!\n
Процесс чистки может занять много времени.\n
В целях ускорения процесса сессия будет невидима\n
Пожалуйста дождитесь завершения\n
Нажмите ОК для продолжения")
(vlax-put-property AcadObject "Visible" :vlax-false)
(setq FileList (vl-directory-files path "*.dwg" 1)) ;получение списка файлов в директории
(setq FileList (mapcar '(lambda (x) (strcat path "\\" x)) FileList));получение списка полных путей к файлам
(setq Counter 0)
(repeat (length FileList)
(setq ActiveDocument (vl-catch-all-apply 'vla-open (list DocumentsCollection (nth Counter FileList))))
(if (not (vl-catch-all-error-p ActiveDocument))
(progn
(vlax-invoke-method ActiveDocument "Purgeall")
(vlax-invoke-method ActiveDocument "Purgeall")
(vlax-invoke-method ActiveDocument "Purgeall")
(vlax-invoke-method ActiveDocument "Save")
(vlax-invoke-method ActiveDocument "Close")
);end progn
);end if
(setq Counter (1+ Counter))
)
(vlax-put-property AcadObject "Visible" :vlax-true)
(alert "Процесс чистки успешно завершен.")
(princ)
)> Random
Класс!!!
Может быть еще перед Purgeall добавить еще удаление невидимых, типа
(vl-cmdf "_erase" (ssget "_X" '((60 . 1)))),
хотя такое редко бывает, и перед save сделать zoom extents, чтобы красиво было.
И еще, если после чистки сделать wblock, то все-равно что-то еще убирается, может и wblock как-то добавить в программу.
Дополнение.
У меня возникло затруднение как набор, полученный с помощью ssget с фильтром преобразовать в набор, который поймет
(vlax-invoke-method ActiveDocument "Wblock" <имя файла> <набор>)
Еще одно дополнение.
Если делать выбор (vla-Select newSet acSelectionSetAll), то после wblock вылезают видовые экраны как видимые объекты в виде прямоугольников, а также пропадает все в пространстве листа независимо из листа запускаешь или из модели.
Команда wblock немного для других целей предназначена. Она если не ошибаюсь создает новый файл для использования его в виде блока.
Добавил в код проверку на уже открытые файлы. Приводить код смысла не вижу - качайте тут
http://dwg.ru/dwl/157
Как сделать так, чтобы не пуржила размерные слои ?
а можно сделать чтобы чистила все файлы в папке с вложенными папками????
Буду очень благодарен!
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Форумы CADUser → Программирование → LISP → Поделитесь программкой для чистки файлов
Форум работает на PunBB, при поддержке Informer Technologies, Inc
