|
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
|
|
Salvare ogni Layer in file dwg indipendente
