arri
Utente Master
Regione: Lombardia
14951 Messaggi |
Inserito il - 13 ottobre 2010 : 11:00:42
|
http://www.cadtutor.net/forum/showthread.php?10359-save-each-layer-in-a-separate-file/page2
;;--------------------=={ Layers 2 DWG }==--------------------;; ;; ;; ;; WBlocks all active layers to a separate drawing, as ;; ;; specified by the user ;; ;;------------------------------------------------------------;; ;; Author: Lee McDonnell, 2010 ;; ;; ;; ;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;; ;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;; ;;------------------------------------------------------------;;
(defun c:Layers2DWG ( / *error* _UniqueItem _LayerList doc docname SelSets file ss ) (vl-load-com) ;; © Lee Mac 2010
(defun *error* ( msg ) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ) )
(defun _UniqueItem ( collection seed ) ( (lambda ( i ) (while (LM:Itemp collection (strcat seed (itoa (setq i (1+ i)))))) (strcat seed (itoa i)) ) 0 ) )
(defun _LayerList ( doc / l ) (vlax-for layer (vla-get-layers doc) (if (not (or (eq :vlax-false (vla-get-layeron layer)) (wcmatch (vla-get-name layer) "*|*") ) ) (setq l (cons (vla-get-name layer) l)) ) ) (reverse l) )
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)) docname (vl-filename-base (vla-get-Name doc)) SelSets (vla-get-SelectionSets doc))
(if (setq file (getfiled "Create Output File" "" "dwg" 1)) (progn (setq ss (vla-Add SelSets (_UniqueItem SelSets "LayerSave"))) (LM:DXF->Variants (list (cons 8 (LM:lst->str (_LayerList doc) ","))) 'typ 'val)
(vla-Select ss acSelectionSetAll nil nil typ val)
(if (not (zerop (vla-get-Count ss))) (vla-WBlock doc file ss))
(vl-catch-all-apply 'vla-delete (list ss)) ) (princ "\n*Cancel*") )
(princ) )
;;------------------=={ Safearray Variant }==-----------------;; ;; ;; ;; Creates a populated Safearray Variant of a specified ;; ;; data type ;; ;;------------------------------------------------------------;; ;; Author: Lee McDonnell, 2010 ;; ;; ;; ;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;; ;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; datatype - variant type enum (eg vlax-vbDouble) ;; ;; data - list of static type data ;; ;;------------------------------------------------------------;; ;; Returns: VLA Variant Object of type specified ;; ;;------------------------------------------------------------;;
(defun LM:SafearrayVariant ( datatype data ) ;; © Lee Mac 2010 (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray datatype (cons 0 (1- (length data))) ) data ) ) )
;;------------------=={ DXF->Variants }==---------------------;; ;; ;; ;; Converts a DXF List to Type and Value Variants ;; ;;------------------------------------------------------------;; ;; Author: Lee McDonnell, 2010 ;; ;; ;; ;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;; ;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; lst - DXF List ;; ;; *typ - a quoted symbol (other than *typ) to house variant ;; ;; *val - a quoted symbol (other than *val) to house variant ;; ;;------------------------------------------------------------;;
(defun LM:DXF->Variants ( lst *typ *val) ;; © Lee Mac 2010 (set *typ (LM:SafearrayVariant vlax-vbInteger (mapcar 'car lst)))
(set *val (LM:SafearrayVariant vlax-vbVariant (mapcar '(lambda ( data ) (if (listp (setq data (cdr data))) (vlax-3D-point data) (vlax-make-variant data) ) ) lst ) ) ) )
;;-----------------------=={ Itemp }==------------------------;; ;; ;; ;; Retrieves the item with index 'item' if present in the ;; ;; specified collection, else nil ;; ;;------------------------------------------------------------;; ;; Author: Lee McDonnell, 2010 ;; ;; ;; ;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;; ;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; coll - the VLA Collection Object ;; ;; item - the index of the item to be retrieved ;; ;;------------------------------------------------------------;; ;; Returns: the VLA Object at the specified index, else nil ;; ;;------------------------------------------------------------;;
(defun LM:Itemp ( coll item ) ;; © Lee Mac 2010 (if (not (vl-catch-all-error-p (setq item (vl-catch-all-apply (function vla-item) (list coll item) ) ) ) ) item ) )
;;-------------------=={ List to String }==-------------------;; ;; ;; ;; Constructs a string from a list of strings separating ;; ;; each element by a specified delimiter ;; ;;------------------------------------------------------------;; ;; Author: Lee McDonnell, 2010 ;; ;; ;; ;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;; ;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; lst - a list of strings to process ;; ;; del - delimiter by which to separate each list element ;; ;;------------------------------------------------------------;; ;; Returns: String containing each string in the list ;; ;;------------------------------------------------------------;;
(defun LM:lst->str ( lst del ) ;; © Lee Mac 2010 (if (cdr lst) (strcat (car lst) del (LM:lst->str (cdr lst) del)) (car lst) ) )
|
Modificato da - arri in Data 13 ottobre 2010 11:02:26
|
|