[编程交流] 将每个层保存在单独的

;;---------------------=={ Layer 2 DWG }==--------------------;;
;;                                                            ;;
;;  WBlocks all active layers to separate drawings, saved to  ;;
;;  the specified directory                                   ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
(defun c:Layer2DWG ( / *error* _UniqueFilename _UniqueItem _LayerList doc docname SelSets Path ss )
 (vl-load-com)
 ;; © Lee Mac 2010
 (defun *error* ( msg )
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )
 (defun _UniqueFileName ( seed )
   (
     (lambda ( i / filename )
       (if (findfile (setq filename (strcat seed ".dwg")))
         (while (findfile (setq filename (strcat seed "(" (itoa (setq i (1+ i))) ").dwg"))))
       )
       filename
     )
     1
   )
 )
 (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 Path (LM:DirectoryDialog "Select Directory for New Files" nil 0))
   (progn
     (setq ss (vla-Add SelSets (_UniqueItem SelSets "LayerSave")))
     
     (mapcar
       (function
         (lambda ( layer )
           (LM:DXF->Variants (list (cons 8 layer)) 'typ 'val)
           (vla-Select ss acSelectionSetAll nil nil typ val)
           (if (not (zerop (vla-get-Count ss)))
             (progn
               (vla-WBlock doc (_UniqueFilename (strcat Path "\" docname "_" layer)) ss)
               (princ (strcat "\n>>> Extracted Layer: " layer))
             )
             (princ (strcat "\n[ Nothing Found on Layer: " layer " ]"))
           )
           (vla-clear ss)            
         )
       )
       (_LayerList doc)
     )
     (vl-catch-all-apply 'vla-delete (list ss))
   )
   (princ "\n*Cancel*")
 )
 (princ)
)
;;-------------------=={ Directory Dialog }==-----------------;;
;;                                                            ;;
;;  Displays a dialog prompting the user to select a folder   ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  msg  - message to display at top of dialog                ;;
;;  dir  - root directory (or nil)                            ;;
;;  flag - bit coded flag specifying dialog display settings  ;;
;;------------------------------------------------------------;;
;;  Returns:  Selected folder filepath, else nil              ;;
;;------------------------------------------------------------;;
(defun LM:DirectoryDialog ( msg dir flag / Shell Fold FObj Path ac )
 ;; © Lee Mac 2010
 (setq Shell (vla-getInterfaceObject (setq ac (vlax-get-acad-object)) "Shell.Application")
       Fold  (vlax-invoke-method Shell 'BrowseForFolder (vla-get-HWND ac) msg flag dir))
 (vlax-release-object Shell)
 
 (if Fold
   (progn
     (setq FObj (vlax-get-property Fold 'Self))
     (setq Path (vlax-get-property FObj 'Path))
     (vlax-release-object Fold)
     (vlax-release-object FObj)
     
     (and (= "\" (substr Path (strlen Path)))
          (setq Path (substr Path 1 (1- (strlen Path)))))
   )
 )
 Path
)
;;------------------=={ 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
 )
)

;;--------------------=={ 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)
 )
)