• Dimas
  • Восстановленный участник
  • На форуме с 25 июля 2006г.
  • Сообщений: 48
  • Спасибо: 0

Тема: Как сразу размножить один layout на 80 копий?

Есть линейный объект (100 км) есть лаяут на котором есть штамп, два вьювпорта рамка и тд. Надо этот лаяут размножить (получится листов 80 А3). То есть создать 80 точных копий потом вьювпорты настрою на изображение руками.

  • Fatty
  • Восстановленный участник
  • На форуме с 30 мая 2006г.
  • Сообщений: 989
  • Спасибо: 2

Re: Как сразу размножить один layout на 80 копий?

> Dimas
Можно так:

Sub test()
Dim oLayouts As AcadLayouts
Dim curLayt As AcadLayout
Dim nextLayt As AcadLayout
Dim iNum, iCount As Integer
On Error GoTo Err_Trapp
ThisDrawing.StartUndoMark
If ThisDrawing.ActiveSpace = acModelSpace Then
    MsgBox "This program will not work" & vbNewLine & _
    "in ModelSpace!" & vbNewLine & _
    "Toggle on PaperSpace!", vbCritical, _
    "Get A PaperSpace"
   Exit Sub
End If
iNum = 1
ThisDrawing.MSpace = True
Set oLayouts = ThisDrawing.Layouts
Set curLayt = ThisDrawing.ActiveLayout
iCount = CInt(InputBox("Enter number of new Layouts to add", "New Layouts Creation", "80"))
While iNum <= iCount
Set nextLayt = oLayouts.Add("NewLayout" & CStr(iNum))
nextLayt.CopyFrom curLayt
iNum = iNum + 1
Wend
Err_Trapp:
MsgBox Err.Description
End Sub

~'J'~

  • Dimas
  • Восстановленный участник
  • На форуме с 25 июля 2006г.
  • Сообщений: 48
  • Спасибо: 0

Re: Как сразу размножить один layout на 80 копий?

<<Fatty>> У меня твоя программа делает лаяуты, но они пустые, а нада точная копия исходного только с другим именем!!

  • Fatty
  • Восстановленный участник
  • На форуме с 30 мая 2006г.
  • Сообщений: 989
  • Спасибо: 2

Re: Как сразу размножить один layout на 80 копий?

> Dimas
Моя ошибка, я не правильно понял вопрос...
:(
~'J'~

  • На форуме с 23 апреля 2003г.
  • Сообщений: 795
  • Спасибо: 0

Re: Как сразу размножить один layout на 80 копий?

1.Сделать пустые layouts по примеру fatty
2.Установить свойства новых layout's в соответствии со свойством исходного.
2.Определить свойство block исходного layout и вновь созданных.(при создании раскладки акад создает блок в таблице блоков типа *Paper_spaceXXX который содержит все примитивы раскладки)
3.Методом copyobjects скопировать примитивы из исходного блока в целевые блоки paper_spaceXXX.
На лиспе мог-бы написать пример.С VBA не работаю, но суть одинакова.

  • Fatty
  • Восстановленный участник
  • На форуме с 30 мая 2006г.
  • Сообщений: 989
  • Спасибо: 2

Re: Как сразу размножить один layout на 80 копий?

> Эдуард
Прямо как в воду глядел
Рад тебя встретить снова :)

Option Explicit
Sub test()
Dim oLayouts As AcadLayouts
Dim curLayt As AcadLayout
Dim spaceBlk As AcadBlock
Dim nextLayt As AcadLayout
Dim objArr() As AcadObject
Dim unitObj As AcadObject
Dim ids, iNum, iCount, i As Integer
On Error GoTo Err_Trapp
ThisDrawing.StartUndoMark
If ThisDrawing.ActiveSpace = acModelSpace Then
    MsgBox "This program will not work" & vbNewLine & _
    "in ModelSpace!" & vbNewLine & _
    "Toggle on PaperSpace!", vbCritical, _
    "Get A PaperSpace"
   Exit Sub
End If
iNum = 1
ThisDrawing.MSpace = True
Set oLayouts = ThisDrawing.Layouts
Set curLayt = ThisDrawing.ActiveLayout
Set spaceBlk = curLayt.Block
For i = 0 To spaceBlk.Count - 1
Set unitObj = spaceBlk.Item(i)
ReDim Preserve objArr(i)
Set objArr(i) = unitObj
Next
iCount = CInt(InputBox("Enter number of new Layouts to add", "New Layouts Creation", "80"))
While iNum <= iCount
Set nextLayt = oLayouts.Add("NewLayout" & CStr(iNum))
nextLayt.CopyFrom curLayt
ThisDrawing.ActiveLayout = nextLayt
ThisDrawing.CopyObjects objArr, nextLayt.Block, ids
iNum = iNum + 1
Wend
Err_Trapp:
MsgBox Err.Description
End Sub

~'J'~

  • Dimas
  • Восстановленный участник
  • На форуме с 25 июля 2006г.
  • Сообщений: 48
  • Спасибо: 0

Re: Как сразу размножить один layout на 80 копий?

Работает! Только садит на лаяут еще один виевпорт, но это я думаю победю! А это (For i = 0 To /spaceBlk.Count — 1/) не заработало, пришлось присвоить переменной значение типа так:
NN = spaceBlk.Count — 1, а потом For i = 0 To /NN. БЛАГОДАРЮ!!!

  • Fatty
  • Восстановленный участник
  • На форуме с 30 мая 2006г.
  • Сообщений: 989
  • Спасибо: 2

Re: Как сразу размножить один layout на 80 копий?

> Dimas
Рад помочь
Успехов
~'J'~