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

Public Sub GetLayer()
Dim i As Integer
Dim mySelSet As AcadSelectionSet
Dim gpCode(0) As Integer
Dim dataValue(0) As Variant
Dim groupCode As Variant
Dim dataCode As Variant
Dim SaveName As String
For i = 0 To ThisDrawing.Layers.Count - 1
Set mySelSet = ThisDrawing.SelectionSets.Add("TextOnLayer")
gpCode(0) = 8 'layer
groupCode = gpCode
dataValue(0) = ThisDrawing.Layers(i).Name  'layer name
dataCode = dataValue
mySelSet.Select acSelectionSetAll, , , groupCode, dataCode
Debug.Print mySelSet.Count
ThisDrawing.Wblock "C:\Fred_" & ThisDrawing.Layers(i).Name, mySelSet
Set mySelSet = Nothing
ThisDrawing.SelectionSets.Item("TextOnLayer").Delete
Next
End Sub

;|
Limitations: file sould be opened "full" (not partial). All layers should
be thawed, on, unlocked (not controlled).
Layout entities will create unexpected result - be careful!
Actually there are some ways to change code to select only model entites
But i can't do it - i've got too much job 
And something else  - look how the code works 
* written by kpblc 2006 Nov 23
|;
(defun c:lay2file (/ adoc selset)
 (vl-load-com)
 (vla-startundomark
   (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
   ) ;_ end of vla-StartUndoMark
 (vlax-for ss (vla-get-selectionsets adoc)
   (if (= (vla-get-name ss) "temp")
     (progn
       (vla-clear ss)
       (vla-erase ss)
       ) ;_ end of progn
     ) ;_ end of if
   ) ;_ end of vlax-for
 (setq selset (vla-add (vla-get-selectionsets adoc) "temp"))
 (vlax-for lay (vla-get-layers adoc)
   (if (and (not (vla-select
                   selset
                   acselectionsetall
                   (vlax-make-variant
                     (vlax-safearray-fill
                       (vlax-make-safearray
                         vlax-vbdouble
                         '(0 . 0)
                         ) ;_ end of vlax-make-safearray
                       '(
                       ) ;_ end of vlax-safearray-fill
                     ) ;_ end of vlax-make-variant
                   (vlax-make-variant
                     (vlax-safearray-fill
                       (vlax-make-safearray
                         vlax-vbvariant
                         '(0 . 0)
                         ) ;_ end of vlax-make-safearray
                       (list (vla-get-name lay))
                       ) ;_ end of vlax-safearray-fill
                     ) ;_ end of vlax-make-variant
                   ) ;_ end of vla-select
                 ) ;_ end of not
            (> (vla-get-count selset) 0)
            ) ;_ end of and
     (vla-wblock
       adoc
       (strcat (getvar "dwgprefix") (vla-get-name lay) ".dwg")
       selset
       ) ;_ end of vla-Wblock
     ) ;_ end of if
   (vla-clear selset)
   ) ;_ end of vlax-for
 (vl-catch-all-apply '(lambda () (vla-delete selset)))
 (vla-endundomark adoc)
 (princ)
 ) ;_ end of defun

(defun c:lsave(/ actDoc layCol docName dwgName actSel fCount)
 (vl-load-com)
 (defun BrowseFolder (/ ShlObj Folder FldObj OutVal)
 (vl-load-com)
 (setq
   ShlObj (vla-getInterfaceObject
      (vlax-get-acad-object)
      "Shell.Application"
    )
   Folder(vlax-invoke-method ShlObj 'BrowseForFolder 0
    "Select Folder to create files" 0)
 )
 (vlax-release-object ShlObj)
 (if Folder
   (progn
     (setq
 FldObj (vlax-get-property Folder 'Self)
 OutVal (vlax-get-property FldObj 'Path)
     )
     (vlax-release-object Folder)
     (vlax-release-object FldObj)
     OutVal
   )
 )
)
 
 (setq actDoc(vla-get-ActiveDocument
        (vlax-get-acad-object))
actSel(vla-get-ActiveSelectionSet actDoc)
layCol(vla-get-Layers actDoc)
docName(vla-get-Name actDoc)
fCount 0
); end setq
 (if
   (setq wntPath
   (BrowseFolder))
   (progn
 (vlax-for lay layCol
   (setq layName(vla-get-Name lay)
  dwgName
   (strcat wntPath "\"
           (vl-filename-base docName)
            " - " layName ".dwg")
  ); end setq
(vla-clear actSel)(vla-erase actSel)
(vla-Select actSel acSelectionSetAll nil nil
 (vlax-safearray-fill
   (vlax-make-safearray vlax-vbInteger '(0 . 0))
    '(
 ) ; end vla-safearray-fill
 (vlax-safearray-fill
   (vlax-make-safearray vlax-vbvariant '(0 . 0))
    (list layName)
 ) ; end vla-safearray-fill
) ; end vla-select
   (if(/= 0(vla-get-Count actSel))
     (vla-WBlock actDoc dwgName actSel)); end if
   (setq fCount(1+ fCount))
   ); end vlax-for
 ); end progn
   ); end if
 (princ
   (strcat "\*** "
    (itoa fCount)
    " files were created *** "))
 (princ)
 ); end of c:lsave