Still under-construction...!!!Hard Hat Area!!! (vl-load-com) (defun c:fixd (/ path files file cn) (setq path (getfiled "Select Directory To Process" "SELECT FOLDER [SAVE]" "" 1 ) ) (if path (progn (setq path (substr path 1 (- (strlen path) 21))) (setq files (vl-directory-files path "*.dwg" 0)) (if files (progn (setq cn 0) (while (setq file (nth cn files)) (fixd-layers (strcat path "\\" file)) (setq cn (1+ cn)) ) ) ) ) ) (princ) ) (defun fixd-layers (dwgname / dbxDoc for-item name layer llist ob) (if (and (not (vl-registry-read "HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument.16\\CLSID" ) ) (findfile "axdb16.dll") ) (startapp "regsvr32.exe" (strcat "/s \"" (findfile "axdb16.dll") "\"") ) ) ; (setq dwgname (getfiled "Select Directory To Process" ; "[Enter To Complete...]" ; "dwg" ; 4 ; ) ; ) ;(prompt dir) ;(dbxblock dir) (if dwgname (progn (setq dbxDoc (vla-GetInterfaceObject (vlax-get-acad-object) "ObjectDBX.AxDbDocument.16" ; MUST reference autocad DBX version ) ) (vla-open dbxDoc DwgName) ;(fixd-setup-dwg dbxdoc) (vlax-for layer (vla-get-layers dbxdoc) (progn (setq llist (cons (strcase (vla-get-name layer)) llist)) ) ) ; Layers ; ;================================; ; a-detl-note ; ; a-detl-dims ; ; a-detl ; ; a-detl-patt ; (if (= (vl-position "A-DETL" llist) nil) (progn (setq ob (vla-add (vla-get-layers dbxdoc) "A-DETL")) (vla-put-description ob "DETAIL SECTION CUT") ) ) (if (= (vl-position "A-DETL-NOTE" llist) nil) (progn (setq ob (vla-add (vla-get-layers dbxdoc) "A-DETL-NOTE")) (vla-put-description ob "DETAIL NOTES") ) ) (if (= (vl-position "A-DETL-DIMS" llist) nil) (progn (setq ob (vla-add (vla-get-layers dbxdoc) "A-DETL-DIMS")) (vla-put-description ob "DETAIL DIMENSION") ) ) (if (= (vl-position "A-DETL-PATT" llist) nil) (progn (setq ob (vla-add (vla-get-layers dbxdoc) "A-DETL-PATT")) (vla-put-description ob "DETAIL HATCH PATTERN") ) ) (vlax-for for-item (vla-get-modelspace dbxDoc) (progn ; start of object cycle (setq name (vla-get-objectname for-item)) (if (or (= name "AcDbArc") (= name "AcDbLine") (= name "AcDbSpline") (= name "AcDbCircle") (= name "AcDbEllipse") (= name "AcDbPolyline") ) (progn ;Conditions (vla-put-layer for-item "A-DETL") ) ) (if (or (= name "AcDbText") (= name "AcDbMText") (= name "AcDbLeader") ) (progn ;Conditions (vla-put-layer for-item "A-DETL-NOTE") (vla-put-color for-item 31) ) ) (if (= name "AcDbHatch") (progn ;Conditions (vla-put-layer for-item "A-DETL-PATT") (vla-put-color for-item 6) ) ) (if (= name "AcDbBlockReference") (progn ;Conditions (vla-put-layer for-item "0") ) ) (if (= name "AcDbRotatedDimension") (progn ;Conditions (vla-put-layer for-item "A-DETL-DIMS") (vla-put-color for-item 31) ) ) ) ; end of object cycle ) ; end of progn of all objects in modelspace (vl-catch-all-apply '(lambda () (vla-close DBXDOC ':VLAX-TRUE 'ITEM)) ) (VL-CATCH-ALL-APPLY 'vlax-release-object (list dbxDoc dwgname for-item name layer llist ob) ) ;(vla-purgeall dbxdoc) (vla-saveas dbxdoc dwgname) (vlax-release-object dbxDoc) (setq dbxDoc nil) ) ) (princ) ) ; Filter object ; ;================================; ; Text ; ; Leader ; ; Lines ; ; Hatch ; ; Dimensions ; ; ; Layers ; ;================================; ; a-detl-note ; ; a-detl-dims ; ; a-detl ; ; a-detl-patt ; ; ; check hatch pattern scale ; ;================================; ; earth ; ; sand ; ; door grain ; ; conc. ; ; gyp. ; ; etc. ; ;(fixd-setup-dwg dbxdoc) (defun fixd-setup-dwg (doc / layer llist ob) (vlax-for layer (vla-get-layers doc) (progn (setq llist (cons (strcase (vla-get-name layer)) llist)) ) ) ; Layers ; ;================================; ; a-detl-note ; ; a-detl-dims ; ; a-detl ; ; a-detl-patt ; (if (= (vl-position "A-DETL" llist) nil) (progn (setq ob (vla-add (vla-get-layers doc) "A-DETL")) (vla-put-description ob "DETAIL SECTION CUT") (vla-put-color ob 31) ) ) (if (= (vl-position "A-DETL-NOTE" llist) nil) (progn (setq ob (vla-add (vla-get-layers doc) "A-DETL-NOTE")) (vla-put-description ob "DETAIL NOTES") (vla-put-color ob 31) ) ) (if (= (vl-position "A-DETL-DIMS" llist) nil) (progn (setq ob (vla-add (vla-get-layers doc) "A-DETL-DIMS")) (vla-put-description ob "DETAIL DIMENSION") (vla-put-color ob 31) ) ) (if (= (vl-position "A-DETL-PATT" llist) nil) (progn (setq ob (vla-add (vla-get-layers doc) "A-DETL-PATT")) (vla-put-description ob "DETAIL HATCH PATTERN") (vla-put-color ob 6) ) ) (princ) )