Вставка блока из другого файла

[Дамир]

Друзья, приветствую!
Наша PDM система позволяет выполнять VBS скрипты. Необходима команда для постановки подписи в  файл AutoCAD. В имеющийся файл “Наш чертеж” поместить блок из файла “Подпись”.
 
Руководствовался интернетом, в частности форумами. Примеры кода моих попыток:
 
Начало одинаковое:

Код - Visual Basic [Выбрать]

1. Dim FileDialog, FName, AcadApp, AcadDocs, Doc, DocNew
2. Set AcadApp = CreateObject("AutoCAD.Application")
3.  
4. Set doc1 = AcadDocs.Open("C:\Users\damir\Downloads\Sign\Наш чертеж.dwg")
5. Set doc2 = AcadDocs.Open("C:\Users\damir\Downloads\Sign\Подпись.dwg")

ВАРИНАТ 1
 

Код - Visual Basic [Выбрать]

1. set blocks1 = doc1.Blocks
2. set blocks2 = doc2.Blocks
3.  
4. set oldBlock = blocks2.Item("sss") ‘ естественно блок с именем  “sss” существует.
5. insp = oldBlock.Origin
6.  
7. redim objs(oldBlock.count)
8. i=0
9.  
10. For Each obj In oldBlock
11.    set objects(i) = obj
12.    i = i + 1
13. Next
14.  
15. set newBlock = blocks1.add(insp, "sss")
16. ‘Далее варианты команды CopyObjects
17. set res = doc1.CopyObjects(obs)
18. set res = doc1.CopyObjects(obs, newBlock)
19. doc1.CopyObjects(obs, newBlock)

‘ в результате получаю ошибку:
"Неверный массив объектов" - ошибка AutoCAD.Applocation

хотя при обращении msgbox obs(0).ObjectName получаю имя объекта (полилиния)
_______________________________________
ВАРИАНТ 2

Код - Visual Basic [Выбрать]

1. ‘Начало то же
2.  
3. Dim dblX, dblY, dblZ, dblRotation
4. dim varInsertionPoint(3)
5.  
6. varInsertionPoint(0) = Cdbl(0)
7. varInsertionPoint(1) = Cdbl(0)
8. varInsertionPoint(2) = Cdbl(0)
9.  
10.  
11. dblX = Cdbl(0)
12. dblY = Cdbl(0)
13. dblZ = Cdbl(0)
14. dblRotation = Cdbl(0)
15.  
16. Set objBlockRef = doc1.ModelSpace.InsertBlock(varInsertionPoint, "C:\Users\damir\Downloads\Sign\Подпись.dwg", dblX, dblY, dblZ, dblRotation)
17.  

Ничего не происходит. То есть вставку не наблюдаю. Прошелся по всему чертежу...

Возможно я использую не те методы AutoCAD. Либо допускаю ошибки. Прошу Вашей помощи в разрешении этого вопроса.
Заранее премного благодарен.

[Александр Ривилис]

На VBA я не пишу совсем, но это как понимать:

Код - Visual Basic [Выбрать]

1. redim objs(oldBlock.count)
2. i=0
3.  
4. For Each obj In oldBlock
5.    set objects(i) = obj
6.    i = i + 1
7. Next
8.  

Т.е. определяешь objs, а заполняешь objects. Это как?
Второе. При таком копировании ты копируешь описание блока, а не вставку блока. Т.е в самом чертеже ты так ничего и не увидишь.

Во втором случае ты вставляешь Пространство Модели из внешнего чертежа в Пространство модели своего чертежа, а совсем не блок "sss"
Ну и если в том чертеже в Пространстве модели ничего нет, то ты ничего и не видишь.

[Дамир]

Александр Ривилис, благодарю за скорый ответ!
Пройду по замечаниям. Многое осмотрел в примерах на ресурсах, посвященных этой теме.
1. По поводу obs и objects. Код был перелопачен изрядно. Видимо на форум поместил измененный фрагмент. Т.е. в рабочем коде везде obs.

При таком копировании ты копируешь описание блока, а не вставку блока. Т.е в самом чертеже ты так ничего и не увидишь.

Вы имеете ввиду эти методы:

Код - Visual Basic [Выбрать]

1. set newBlock = blocks1.add(insp, "sss")
2. ‘Далее варианты команды CopyObjects
3. set res = doc1.CopyObjects(obs)
4. set res = doc1.CopyObjects(obs, newBlock)
5. doc1.CopyObjects(obs, newBlock)

Получается таким способом нельзя скопировать объект из одного чертежа в другой? Наверное я что то не понимаю. В справке к AutoCAD нашел о методе CopyObjects:

Duplicates multiple objects (deep cloning).
RetVal = object.CopyObjects(Objects [, Owner] [, IDPairs])

2.

Во втором случае ты вставляешь Пространство Модели из внешнего чертежа в Пространство модели своего чертежа, а совсем не блок "sss"

Данный способ посмотрел в примере:

Код - Visual Basic [Выбрать]

1. Set objBlockRef = doc1.ModelSpace.InsertBlock(varInsertionPoint, "C:\Users\damir\Downloads\Sign\Подпись.dwg", dblX, dblY, dblZ, dblRotation)

По поводу копирования пространств модели спорить не буду, но во втором чертеже есть объект - сплайн. Его при копировании не наблюдаю.

3. Ну и самый главный вопрос: если перечисленные методы не подходят, то каким же пользоваться для простого копирования блока из  одного чертежа в другой? Прошу Вашей  помощи, ибо уж все перепробовал...

[Александр Ривилис]

По поводу копирования пространств модели спорить не буду, но во втором чертеже есть объект - сплайн. Его при копировании не наблюдаю.

А ты не обратил внимание, что у тебя в коде нулевые масштабные коэффициенты по X,Y,Z??? Я так понимаю, что они должны быть единичными.

[Дамир]

Александр Ривилис, да обратил кончено.
Следующий код возвращает ошибку: "Недопустимое число элементов в Safearray" - AutoCAD.Appplication

Код - Visual Basic [Выбрать]

1. redim startPoint(3)
2.  
3. startPoint(0) = cdbl(1.0)
4. startPoint(1) = cdbl(1.0)
5. startPoint(2) = cdbl(1.0)
6.  
7. Dim convArr1
8. convArr1 = ThisApplication.Utility.VariantToArray(startPoint)
9.  
10. dblX = cdbl(1.0)
11. dblY = cdbl(1.0)
12. dblZ = cdbl(1.0)
13. dblRotation = cdbl(0.0)
14.  
15. Set objBlockRef = doc1.ModelSpace.InsertBlock(convArr1, "C:\Users\damir\Downloads\Sign\Подпись.dwg", dblX, dblY, dblZ, dblRotation)

Вопрос остается открытым: какой метод исползовать для копирования объектов, блоков из чертежа в чертеж, либо вставки блока в чертеж???

[Александр Ривилис]

Ты должен сначала скопировать описание блока при помощи CopyObjects, а потом вставить его при помощи InsertBlock

P.S.: Не забывай на форум вставлять теги кода [code=vb]... здесь сам код...[/code]

[Александр Ривилис]

У меня получилось что-то такое:

Код - Visual Basic [Выбрать]

1. Option Explicit
2.  
3. Sub TestDwg2DwgBlkTrans()
4.     Dim strPath As String
5.     Dim strPathTo As String
6.     Dim strBlockName As String
7.     Dim objBlock As AcadBlock
8.     Dim entRef As AcadBlockReference
9.     Dim dblPkPt() As Double
10.     strBlockName = "shtamp" ' Имя блока штампа
11.    strPath = "C:\shab_shtamp.dwg" ' Имя файла с блоком штампа
12.    strPathTo = "C:\Тестовый чертеж.dwg" ' Имя файла в который вставляем штамп
13.    On Error Resume Next
14.     DbxCopyBlock strBlockName, strPath, strPathTo ' Копируем описание блока и выполняем вставку его
15. End Sub
16.  
17. Sub DbxCopyBlock(strBlockName As String, strPathFrom As String, strPathTo As String)
18.     Dim strFullDef As String
19.     Dim objBlock As AcadBlock
20.     Dim colBlocks As AcadBlocks
21.     Dim objArray(0) As Object
22.     Dim ACDbxFrom As Object
23.     Dim entRef As AcadBlockReference
24.     Dim ACDbxTo As Object
25.     Set ACDbxFrom = GetAcDbxDoc()
26.     ACDbxFrom.Open strPathFrom
27.     Set ACDbxTo = GetAcDbxDoc()
28.     ACDbxTo.Open strPathTo
29.     Set colBlocks = ACDbxFrom.Blocks
30.     Set objBlock = colBlocks.Item(strBlockName)
31.     Set objArray(0) = objBlock
32.     ACDbxFrom.CopyObjects objArray, ACDbxTo.Blocks
33.     Dim insertionPnt(0 To 2) As Double
34.     insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0#
35.     Set entRef = ACDbxTo.ModelSpace.InsertBlock(insertionPnt, strBlockName, 1#, 1#, 1#, 0#)
36.     ACDbxTo.SaveAs strPathTo
37.     Set ACDbxFrom = Nothing
38.     Set ACDbxTo = Nothing
39. End Sub
40.  
41. Function GetAcDbxDoc() As Object
42.     Dim strAcadVersion As String
43.     With ThisDrawing.Application
44.        strAcadVersion = Mid(.Version, 1, 2)
45.        If CInt(strAcadVersion) < 16 Then
46.            Set GetAcDbxDoc = .GetInterfaceObject("ObjectDBX.AxDbDocument")
47.        Else
48.            Set GetAcDbxDoc = .GetInterfaceObject("ObjectDBX.AxDbDocument." & strAcadVersion)
49.        End If
50.     End With
51. End Function
52.  

1. Учти, что на VBA я не пишу и не уверен, что синтаксис VBA и VBS абсолютно одинаков.
2. Проверки ошибок в моём коде нет вообще. Например, подразумевается, что в файле, в который мы копируем нет блока с таким именем, который есть в файле шаблона.

[Дамир]

Александр Ривилис, огромное Вам спасибо.

Конечно проблему пока решить так и не удалось. Грешу в большей степени на работу VBS с типами данных. К примеру, чтобы поместить графический объект мы используем точку с координатами x, y, z. Причем в VBA пишем эти координаты в виде массива (пример из Вашего кода)

Код - Visual Basic [Выбрать]

1.  Dim insertionPnt(0 To 2) As Double
2.     insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0#

В VBS этот номер не проходит, поэтому создаем альтернативную запись:

Код - Visual Basic [Выбрать]

1. redim insertionPnt(3)
2.   insertionPnt(0) = Cdbl(0.0)
3.   insertionPnt(1) = Cdbl(0.0)
4.   insertionPnt(2) = Cdbl(0.0)
5.  

На выходе имеем массив с координатами. Тип данных массива - Variant? что AutoCAD'y не нравится и он жалуется ошибкой: "Неверный массив объектов" .

В системе, где я пишу свой код есть метод, позволяющий конвертировать в массивы формата VBScript в типизированные VBA массивы. Что мне собственно и нужно. Однако, переконвертировав массив получаю пустую ошибку используемой мною системы.

Аналогичная ситуация при работе с массивами, содержащими объекты:

Код - Visual Basic [Выбрать]

1. Set objArray(0) = objBlock

 Все это указывает на проблему с типами данных.

[Александр Ривилис]

Ну с этим я вряд ли смогу помочь. Придется тебе самостоятельно с этим разбираться. Не исключаю, что каких-то возможностей VBS может просто не хватить.

[Александр Ривилис]

P.S.: Метод CopyObjects не допускает позднего связывания.

[Алексей Кулик]

Дамир, а конструкция типа

Код - Visual Basic [Выбрать]

1. Dim insPoint
2. insPoint = (0.0, 0.0, 0.0)

не сработает?

[Дамир]

Друзья, благодарю вас!

Решил проблему. Причина была действительно в типах массивов, которые при создании в VBS были непонятны AutoCAD.
Рабочий вариант:
Так я заполняю массив координат для точки вставки:

Код - Visual Basic [Выбрать]

1. Dim insertionPnt, insertionPnt2                                                             ' ПЕРВАЯ РАЗНИЦА В СРАВНЕНИИ С ПРЕДЫДУЩИМ КОДОМ
2.  insertionPnt = array(Cdbl(0.0), Cdbl(0.0), Cdbl(0.0))
3.   insertionPnt2 = array(Cdbl(100.0), Cdbl(100.0), Cdbl(0.0))
4.  

Далее как и ранее преобразую его в понятный AutoCAD'y тип данных (объект состоящий из Double элементов)

Код - Visual Basic [Выбрать]

1. set doc1 = AcadDocs.Open(strPath)                            
2.   conv1 = ThisApplication.Utility.VariantToArray(insertionPnt)
3.   conv2 = ThisApplication.Utility.VariantToArray(insertionPnt2)
4.  

Код - Visual Basic [Выбрать]

1. set doc2 = AcadDocs.Open(strPathTo)                    
2.  
3.   Set colBlocks = doc1.Blocks                                                 ' определяю блоки чертежа, из которого буду забирать нужный мне блок  
4.  Set objBlock = colBlocks.Item(strBlockName)                      ' нужный мне блок
5.    
6.   Dim  objArray
7.   objArray = array(objBlock)                                                   ' ЕЩЕ ОДНА РАЗНИЦА! ПРИСВАИВАЮ ЗНАЧЕНИЕ МАССИВА ПО ДРУГОМУ
8. '  Set objArray(0) = objBlock                              
9.  convArr = ThisApplication.Utility.VariantToArray(objArray)   '  преобразую его в понятный AutoCAD'y тип данных массива    
10.  doc1.CopyObjects convArr, doc2.Blocks                               '  помещаю объекты искомого блока в состав блоков второго чертежа
11.        
12.   Set entRef = doc2.ModelSpace.InsertBlock(conv1, strBlockName, 1, 1, 1, 0) ' помещаю сам блок
13.  

Друзья проблему со вставкой решили. Однако, теперь стоит более глобальная задача - вставка блока на все листы чертежа.
Сейчас вставка осуществляется в пространство модели ModelSpace, для вставки в пространство листа строку меняю так:

Код - Visual Basic [Выбрать]

1. Set entRef = doc2.ModelSpace.InsertBlock(conv1, strBlockName, 1, 1, 1, 0)

При этом блок вставляется в активный лист. А мне нужно во все листы. Возникают вопросы:
1. Какой командой активировать лист? Чтобы потом поместить блок командой Set entRef = doc2.PaperSpace.InsertBlock(conv1, strBlockName, 1, 1, 1, 0)
либо
2. Как вставить блок в конкретный лист? На Layuot не нашел команды InsertBlock

Заранее премного благодарен!

[Алексей Кулик]

Если обращаться с CAD'ом через СОМ, то по свойству Layouts текущего документа можно получить перечень всех листов. А у каждого листа есть свойство Block. Думаю, что надо искать в этом направлении.

[Александр Ривилис]

Сначала немного теории (хотя вариант Алексея тоже вполне рабочий). Каждому листу соотвествует блок с именем вида *Paper_SpaceN:

Т.е. можно пройтись по всем блокам, отобрать только те, имена которых соответствуют *Paper_SpaceN и выполнить blk.InsertBlock для них.
Если нужно только в конкретный лист, то тогда лучше идти по схеме Алексея, т.к. у каждого Layout есть свойство Name, по которому можно идентифицировать лист, ну а дальше по свойству Block находим блок в который и вставляем.

[Алексей Кулик]

Одно "но": для пространства модели тоже есть свой Block. Так что это придется учитывать.