;;; HMsilva (Henrique) Routine to Copy all drawing (model) with basepoint 0.0.0 Paste in new dwg Save as and Overwrite existing file
;;; works with folder of dwg's
;;; Modified by Igal Averbuh 2016

;; Load Supporting Functions
;; Old Version of 'BrowseForFolder' by: Tony Tanzillo
(defun BrowseForFolder (Message / sh folder parentfolder folderobject result)
(vl-load-com)
(setq sh (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application"))
(setq folder (vlax-invoke-method sh 'BrowseForFolder 0 Message 0))
(vlax-release-object sh)
(if folder
(progn
(setq parentfolder (vlax-get-property folder 'ParentFolder))
(setq FolderObject (vlax-invoke-method ParentFolder 'ParseName (vlax-get-property Folder 'Title)))
(setq result (vlax-get-property FolderObject 'Path))
(mapcar 'vlax-release-object
(list folder parentfolder folderobject)
)
(if (/= (substr result (strlen result)) "\\")
(setq result (strcat result "\\"))
result
)
)
)
)
(defun c:cl (/ DirPath DwgFile DwgList Ofile Scrfile)
(if (setq DirPath (BrowseForFolder "Select directory to CLEAN drawings."))
(progn
(setq Scrfile (strcat DirPath "test.scr"))
(setq ofile (open Scrfile "w"))
(setq DwgList (vl-directory-files DirPath "*.dwg" 1))
(foreach Dwg DwgList
(setq DwgFile (strcat DirPath Dwg))
(write-line (strcat "_.open\r" (chr 34) DwgFile (chr 34) "\r") Ofile)
(write-line "_.ucs\r\w\r" Ofile)
(write-line "-layer\ru\r*\r\r" Ofile)
(write-line "_.copybase\r0,0,0\rall\r\r" Ofile)
(write-line "_.close\rno\r" Ofile)
(write-line "_.new\r\r" Ofile)
(write-line "_.pasteclip\r0,0,0\r" Ofile)
(write-line "_.zoom\r_e\r" Ofile)
(write-line (strcat "_.saveas\r\r" (chr 34) DwgFile (chr 34) "\rYes\r") ofile)
(write-line "_.close\r" Ofile)
)
(close Ofile)
(command "_.script" Scrfile)
)
)
(princ)
)
(c:cl)

Advertisements