CADForums.net

Rudy Tovar · Guest

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)
)

	CADForums.net Forum Index -> Customization	All times are GMT
Page 1 of 1