ADN Club > VBA
Вставка блока из другого файла
Александр Ривилис:
Ты должен сначала скопировать описание блока при помощи CopyObjects, а потом вставить его при помощи InsertBlock
P.S.: Не забывай на форум вставлять теги кода [code=vb]... здесь сам код...[/code]
Александр Ривилис:
У меня получилось что-то такое:
--- Код - Visual Basic [Выбрать] ---Option Explicit Sub TestDwg2DwgBlkTrans() Dim strPath As String Dim strPathTo As String Dim strBlockName As String Dim objBlock As AcadBlock Dim entRef As AcadBlockReference Dim dblPkPt() As Double strBlockName = "shtamp" ' Имя блока штампа strPath = "C:\shab_shtamp.dwg" ' Имя файла с блоком штампа strPathTo = "C:\Тестовый чертеж.dwg" ' Имя файла в который вставляем штамп On Error Resume Next DbxCopyBlock strBlockName, strPath, strPathTo ' Копируем описание блока и выполняем вставку егоEnd Sub Sub DbxCopyBlock(strBlockName As String, strPathFrom As String, strPathTo As String) Dim strFullDef As String Dim objBlock As AcadBlock Dim colBlocks As AcadBlocks Dim objArray(0) As Object Dim ACDbxFrom As Object Dim entRef As AcadBlockReference Dim ACDbxTo As Object Set ACDbxFrom = GetAcDbxDoc() ACDbxFrom.Open strPathFrom Set ACDbxTo = GetAcDbxDoc() ACDbxTo.Open strPathTo Set colBlocks = ACDbxFrom.Blocks Set objBlock = colBlocks.Item(strBlockName) Set objArray(0) = objBlock ACDbxFrom.CopyObjects objArray, ACDbxTo.Blocks Dim insertionPnt(0 To 2) As Double insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0# Set entRef = ACDbxTo.ModelSpace.InsertBlock(insertionPnt, strBlockName, 1#, 1#, 1#, 0#) ACDbxTo.SaveAs strPathTo Set ACDbxFrom = Nothing Set ACDbxTo = NothingEnd Sub Function GetAcDbxDoc() As Object Dim strAcadVersion As String With ThisDrawing.Application strAcadVersion = Mid(.Version, 1, 2) If CInt(strAcadVersion) < 16 Then Set GetAcDbxDoc = .GetInterfaceObject("ObjectDBX.AxDbDocument") Else Set GetAcDbxDoc = .GetInterfaceObject("ObjectDBX.AxDbDocument." & strAcadVersion) End If End WithEnd Function
1. Учти, что на VBA я не пишу и не уверен, что синтаксис VBA и VBS абсолютно одинаков.
2. Проверки ошибок в моём коде нет вообще. Например, подразумевается, что в файле, в который мы копируем нет блока с таким именем, который есть в файле шаблона.
Дамир:
Александр Ривилис, огромное Вам спасибо.
Конечно проблему пока решить так и не удалось. Грешу в большей степени на работу VBS с типами данных. К примеру, чтобы поместить графический объект мы используем точку с координатами x, y, z. Причем в VBA пишем эти координаты в виде массива (пример из Вашего кода)
--- Код - Visual Basic [Выбрать] --- Dim insertionPnt(0 To 2) As Double insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0# В VBS этот номер не проходит, поэтому создаем альтернативную запись:
--- Код - Visual Basic [Выбрать] ---redim insertionPnt(3) insertionPnt(0) = Cdbl(0.0) insertionPnt(1) = Cdbl(0.0) insertionPnt(2) = Cdbl(0.0) На выходе имеем массив с координатами. Тип данных массива - Variant? что AutoCAD'y не нравится и он жалуется ошибкой: "Неверный массив объектов" .
В системе, где я пишу свой код есть метод, позволяющий конвертировать в массивы формата VBScript в типизированные VBA массивы. Что мне собственно и нужно. Однако, переконвертировав массив получаю пустую ошибку используемой мною системы.
Аналогичная ситуация при работе с массивами, содержащими объекты:
--- Код - Visual Basic [Выбрать] ---Set objArray(0) = objBlock
Все это указывает на проблему с типами данных.
Александр Ривилис:
Ну с этим я вряд ли смогу помочь. Придется тебе самостоятельно с этим разбираться. Не исключаю, что каких-то возможностей VBS может просто не хватить.
Александр Ривилис:
P.S.: Метод CopyObjects не допускает позднего связывания.
Навигация
Перейти к полной версии