Тема: Сохранение в отдельные файлы
Программка должна сохранять все чертежи из одного файла в отдельные файлы. Рамки чертежей в виде блоков. Не пойму в чем дело. С одними файлами работает с другими нет. Или сохраняет какието непонятные фрагменты. Может настройки не те?
Public Sub Main()
Dim objSelSet As AcadSelectionSet
Dim objSelSet2 As AcadSelectionSet
Dim objSelCol As AcadSelectionSets
Dim objSelCol2 As AcadSelectionSets
Dim objEnt As AcadEntity
Dim intType(0) As Integer
Dim varData(0) As Variant
Dim i As Integer
Dim strAttributes As String
Dim varAttributes1 As Variant
Dim minExt As Variant
Dim maxExt As Variant
Dim filename As String
Set objSelCol = ThisDrawing.SelectionSets
Set objSelCol2 = ThisDrawing.SelectionSets
For Each objSelSet In objSelCol
If objSelSet.Name = "TEMP" Then
objSelSet.Delete
Exit For
End If
Next
Set objSelSet = objSelCol.Add("TEMP")
intType(0) = 0
varData(0) = "INSERT"
objSelSet.SelectOnScreen Filtertype:=intType, filterdata:=varData
i = 0
MsgBox objSelSet.Count
For Each objEnt In objSelSet
If objEnt.Name = "B-HOR-R1" Or objEnt.Name = "B-VER-R1" Or objEnt.Name = "A-HOR-R1" Or objEnt.Name = "A-VER-R1" Or objEnt.Name = "CPP1" Or objEnt.Name = "WPP1" Then
i = i + 1
objEnt.GetBoundingBox minExt, maxExt
Set objSelSet2 = objSelCol2.Add("TEMP2")
objSelSet2.Select acSelectionSetCrossing, minExt, maxExt
ThisDrawing.Wblock "c:\MULTIDWG\" & i & ".dwg", objSelSet2
objSelSet2.Delete
End If
Next
End Sub
