（更新）[编程申请]：图纸拆分

eachy

最初由 hrbpkf 发布
[B]感谢斑竹 eachy 的支持，但是程序在2002下运行有问题。另外，能否提个建议，将每张图的图名自动生成新的文件名？ [/B]

新名称用什么？

hrbpkf

用每张标题栏中的图名中的内容，比如“基础平面布置图”抑或是“楼梯结构图”什么的！

eachy

最初由 hrbpkf 发布
[B]用每张标题栏中的图名中的内容，比如“基础平面布置图”抑或是“楼梯结构图”什么的！ [/B]

4楼改好了，再试一试。

风向

把不用的图层关了不就得了
该用的,就复制--粘贴
再继续了............

hrbpkf

OK，通过了，eachy真牛！佩服！佩服！！只是并在一起的两张图有一点小问题，不过还是不胜感激！

eachy

最初由 hrbpkf 发布
[B]OK，通过了，eachy真牛！佩服！佩服！！只是并在一起的两张图有一点小问题，不过还是不胜感激！ [/B]

如果你的图框是块，图签中图名是属性还可以省事。

另：文件中的 "c" 改为 "w" 就不会选择旁边的了。

zhengqg

斑竹能生成一个插件或按键,直接点击就更好了

chenhang1203

最初由 eachy 发布
[B]
如果你的图框是块，图签中图名是属性还可以省事。

另：文件... [/B]

这样还省事了，不过有个BUG，就是图形不在屏幕区域内时无法完整的切割，这对图纸多的情况是不方便的。。。

myfreemind

最初由 hrbpkf 发布
[B]斑竹能帮忙写个程序吗？将一个文件内的若干张图纸分解成若干个文件（每个文件一张图）？工作需要，愁死我了！ [/B]

用这个程序试试:
Sub wtblk() '批量写块
On Error Resume Next

Dim Ftype(0) As Integer
Dim Fdata(0) As Variant
Dim Fname As String
Dim i As Integer
Dim minpnt As Variant
Dim maxpnt As Variant
Dim cenpnt(0 To 2) As Double
Dim basepnt As String
Dim sset As AcadSelectionSet
ThisDrawing.SetVariable "filedia", 0

For i = 0 To ThisDrawing.SelectionSets.Count - 1
    ThisDrawing.SelectionSets.Item(i).Clear
    ThisDrawing.SelectionSets.Item(i).Delete
Next

Ftype(0) = 0
Fdata(0) = "INSERT"
'1:
Do While ThisDrawing.ModelSpace.Count > 0


Set sset = ThisDrawing.SelectionSets.Item("sset_blk")
If Err Then
Set sset = ThisDrawing.SelectionSets.Add("sset_blk")
End If




sset.Select acSelectionSetLast, , , Ftype, Fdata


sset.Item(0).GetBoundingBox minpnt, maxpnt
cenpnt(0) = (maxpnt(0) + minpnt(0)) / 2
cenpnt(1) = (maxpnt(1) + minpnt(1)) / 2
cenpnt(2) = 0

basepnt = cenpnt(0) & "," & cenpnt(1)

Fname = "k:\abc\" & sset.Item(0).Name & ".dwg"

ThisDrawing.SendCommand "-wblock " & Fname & vbCr & vbCr & basepnt & vbCr & "p" & vbCr & vbCr
sset.Item(0).Delete
sset.Clear
sset.Delete



Loop



End Sub

围棋

个人认为用WBLOCK比较好，不会出问题，外挂的程序多少会有些问题。
保存文件名时：先把图名文字DDMODIFY/MO，把文字Ctrl+C拷下，另存文件名时粘帖就行了，不用另外再打字。

hrbpkf

各位所提到的拷贝-新建-粘贴是我一直用的办法，但是几十张甚至上百张就很繁琐了。斑竹给的程序已经非常完美了，完全合乎我最开始的想象，现在工作效率很高，非常感谢eachy的帮助！

zzg123good

谢谢楼主的程序，感觉应该可以R14上用吧
楼主的程序有个小问题。
就是如果图里有粘贴进来的图片时，图片部分选不进来。还是留在原图里。