(defun c:PageSetupBasicExport
( / files includeSubFolders SetDefaultSetup
) (setq files
nil) ;Directory or list of files (setq includeSubFolders
nil) ;Change to 1 to include DWGs in subfolders (setq SetDefaultSetup
1) ;Will set the drawings all to the same pagesetup layout (pageSetupExport SetDefaultSetup files includeSubFolders)
)
(defun pageSetupExport
(SetDefaultSetup files subfiles
/ vlaPageSetups notifyExit plotConfigNames directoryFiles DBXCopyPlotConfigs currentPageSetup fixPageSetupNames runActiveXFunctionOnDwgs pageSetups amt ct dwgName doc f pageSetups
) (defun plotConfigNames
( / out
) )
)
(defun directoryFiles
( path fileFolderNamePattern searchSubFolders
/ temp
) ;Path is entire path where files/folders reside. FileFolderNamePattern is a wcmatchable string pattern for what to include. I.e. *.dwg for all dwg files. (if (> 259 (strlen (strcat fileFolderNamePattern path
))) ;The fileFolderNamePattern search + length of filename/path can not be 259 or longer character length (if (and searchSubFolders
(not (= 0 searchSubFolders
))) (if (not (or (= x
".") (= x
".."))) (directoryFiles temp fileFolderNamePattern 1)
(list (debug
"Too long: " (strlen (strcat fileFolderNamePattern temp
))) (debug
"Path: " temp
) (debug
"Pattern: " fileFolderNamePattern
)) )
)
)
)
)
)
)
)
(debug "Path too long: " path)
)
)
(defun DBXCopyPlotConfigs
(plotConfigs setDefault
/ plt
) ;DBX Function for copying plot configs to additional drawings vlaPageSetups
(setq vlaPageSetups
(cons x vlaPageSetups
)) )
)
)
(vlax-invoke *acdoc
* 'copyobjects vlaPageSetups plt
nil) ;Copy over the page setup from the source file
; (vlax-invoke it 'refreshplotdeviceinfo) ;I don't think this does anything....
)
)
)
)
)
;Returns the current layouts current pagesetup
(defun currentPageSetup
() )))
)
(defun fixPageSetupNames
(files
/ batFile scriptFile txt fl
) ;AutoCAD has a bug when exporting pagesetups via ObjectDB where they are given an anoynomous name. This an be easily fixed Lee Mac's solution by pulling the entities page setup name and replace the anoynomous name with the real one (setq txt
(strcat "FOR %%G IN (" txt
") DO \"" (findfile "accoreconsole.exe") "\" /i %%G /s \"" scriptFile
"\""))
;Write Bat File
)
)
;Write Script File
(write-line "((lambda (dic) (entmod (mapcar (function (lambda (a b) (if (and (= 003 (car a)) (= 350 (car b))) (cons 3 (cdr (assoc 1 (entget (cdr b))))) a))) dic (append (cdr dic) '( nil )))))(dictsearch (namedobjdict) \"ACAD_PLOTSETTINGS\")) qsave" fl
) )
)
)
(defun runActiveXFunctionOnDwgs
( / vlaRelease checkAlreadyOpenedDWG massOpenFilesCheck setDBXObject dwl
) (defun checkAlreadyOpenedDWG
(filename
/ dwl f lst s
) (if (and ;See if a DWL exists and it can't be deleted )
(if (setq f
(open dwl
"r")) ;Open it to get its info )
nil ;Otherwise not open
)
)
)
(defun massOpenFilesCheck
(filesToCheck
/ openList
) ;checks to see if any of the files are already opened )
(setq openList
(vl-remove nil (mapcar 'checkAlreadyOpenedDWG filesToCheck
))) ;This list is not just the fileName, includes additional information i.e. who has it open (if openList
;If files are open, give the user the option to close out (progn ;Print the results (princ "\nThe following files are opened and need to be closed:") )
)
)
(defun setDBXObject
( dbx
/ vrs
) ;Sets the DBX Object, from Lee )
)
)
(setDBXObject '*dbx*)
(massOpenFilesCheck files)
)
(princ (strcat "\nDrawing Name is unprocessable! See DWG: " dwg
)) (setq f
1) ;Set the doc is already open variable, we can use it to regen the viewport. Unopened documents will get generated when opened. )
)
(princ (strcat "\nCurrently in Drawing: [" (itoa ct
) "] (" dwgName
") out of [" (itoa amt
)"]")) (DBXCopyPlotConfigs pageSetups SetDefaultSetup) ;function uses the doc variable set above
(if f
(progn (vla-regen doc acActiveViewport
) (setq f
nil))) ;Drawing is already open, regen viewport just incase. )
(princ (strcat "\nUnable to interface with Drawing: [" (itoa ct
) "] (" dwgName
"). Drawing may be open!")) )
)
)
)
)
(vlaRelease *dbx*)
)
(setq pageSetups
(plotConfigNames
)) ((or (not files
) (= "" files
)) ;No drawings selected (notifyExit "ERROR: No DWG(s) Selected to Export Page Setups Into!") ;No DWG(s) Set to export page setups into
)
(notifyExit "ERROR: DWGs Process Directory Does Not Exist!") ;Incorrect directory for processing DWGs
)
(notifyExit "ERROR: No Page Setups Selected to Export!") ;No page setups selected
)
(T ;Everything good, Run the script
(if (= 'STR
(type files
)) ;get the files if files is a directory (setq files
(directoryFiles files
"*.dwg" subfiles
)) )
(alert "SET CURRENT the Page Setup to apply as default for all drawings.") (if (= "" (currentPageSetup
)) (notifyExit "ERROR: Current Page Setup set to None!")
)
)
)
)
)
(runActiveXFunctionOnDwgs)
(fixPageSetupNames files)
(print "Page Setups exported successfully!") )
)
)