将每个层保存在单独的
大家好，我正在寻找一种自动拆分a的方法。包含多个图层的dwg。仅包含一个图层的dwg（每个图层应使用图层名作为新文件名分别保存在新文件中）。
有人知道一个简单的方法吗？
谢谢
泽维尔 你可以写一个lisp文件，它会自动为你做。
另一种有点麻烦但确实起作用的方法是使用qselect命令。
应用于：整个图形
对象类型：多个
特性：图层
操作员=
值（每次单独选择层）
创建外部图块
文件名和路径（图层名）并保留所有其他内容
好啊
然后重新开始下一层
希望这对你有所帮助，直到有人为你发布列表 谢谢，这就是我一直在做的。。。
只是一个问题：什么是
“wblock
文件名和路径（图层名）并保留所有其他内容
“好的”
这个函数在哪里？（我正在使用Acad 2005）
这可能比选择“复制新文件”“粘贴”更快？
事实上，我真的在寻找一种自动方式！ 对不起，如果有点多云，
按qselect中的ok按钮（选择后）
在命令行中键入wblock（writeblock）
在文件名和路径中：（输入图层名）
按ok（确定）按钮。
将创建一个新文件。然后我建议从下一层开始循环。
在一幅画中是可以忍受的，但在负载下是痛苦的。
希望其中一个lisp向导很快就会为您生成一个这样做的例程 泽维尔，
您好。
这当然可以做到，下面的代码可以做到，但只是证明，而不是一个完成的例程。你需要稍微了解VBA才能完成它！
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
WBLOCK（写块）用于从现有图形的部分中创建新图形。可以选择图形中定义的单个项目或块。 尝试使用。看看评论！
;|
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
在VBA中，代码可能更可读。 谢谢大家！
我的编程是=0，但我会问一个知道（多一点）的人。。。
如果我们做不到，我会回来的！
同时，如果有人有其他建议。。。
再次感谢
泽维尔 还有一件事：在http://www.cadforum.cz/cadforum_en/default.asp?tab=4&cat=33我发现：
我没有加载和测试它。还要看看http://www.jtbworld.com/lisp/layoutstodwgs.htm 辛布罗，你的方式比我做的要快。。。总比什么都没有好！
事实上，我第一次尝试时它没有起作用，因为我的wblock拼写为wbloc。。。法语！
泽维尔 还有一个，选择目标文件夹。
(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
>kpblc不可能跟上你。
页:
[1]
2