Example Dbx and layers...

Discussion in 'AutoCAD' started by Rudy Tovar, Jan 11, 2005.

  1. Rudy Tovar

    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)
    )
     
    Rudy Tovar, Jan 11, 2005
    #1
Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments (here). After that, you can post your question and our members will help you out.