• Maxim
  • Восстановленный участник
  • На форуме с 24 декабря 2005г.
  • Сообщений: 124
  • Спасибо: 0

Тема: Вставить блок

Помогите пожалуйста.
Как с помощью VBA вставить блок. Чертеж блока находится в отдельном файле.
Sub InsertPointScreen()
Dim PointIns As AcadBlock
Dim Puth As String
Dim Coord(0 To 2) As Double
Dim Desk As String
Dim objLayer As AcadLayer
Dim objLayers As AcadLayers
Putsh = "F:\ZNAK\"
Coord = ThisDrawing.Utility.GetPoint(, "Указать точку: ")
Desk = ThisDrawing.Utility.GetString(True, "Имя точки: ")
Dim blockRefObj As AcadBlockReference
Patsh = Putsh & Desk & ".dwg"
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(Coord, Patsh, 1, 1, 1, 0)
End Sub
Пишет что не найден ключ. Что не правильно?

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

Re: Вставить блок

> Maxim
Не мучайся с методом InserBlock
он не будет работать
Проще юзать SendCommand, хотя я этот
метод стараюсь обходить стороной, но в
этом случае не обойтись

Sub DwgInsert()
     Dim fname As String
     fname = "c:\\MyVBA\\blk.dwg"
     Dim pickPt As Variant
     Dim strPt As String, comStr As String
     With ThisDrawing
          pickPt = .Utility.GetPoint(, vbCr & "Pick a block insertion point: ")
          .SetVariable "FILEDIA", 0
          .SetVariable "CMDECHO", 0
          strPt = Replace(CStr(pickPt(0)), ",", ".") & "," & _
                  Replace(CStr(pickPt(1)), ",", ".") & "," & _
                  Replace(CStr(pickPt(2)), ",", ".")
          comStr = "(command " & Chr(34) & "-insert" & Chr(34) & " " _
                   & Chr(34) & fname & Chr(34) & " " _
                   & Chr(34) & strPt & Chr(34) & " " _
                   & Chr(34) & "1" & Chr(34) & " " _
                   & Chr(34) & "1" & Chr(34) & " " _
                   & Chr(34) & "0" & Chr(34) & ")"
          .SendCommand comStr & vbCr
          .SetVariable "FILEDIA", 1
          .SetVariable "CMDECHO", 1
          .Regen acActiveViewport
     End With
End Sub

~'J'~

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

Re: Вставить блок

Странно но у меня InsertBlock работает.
Попробуй так:

Sub InsertPointScreen()
Dim PointIns As AcadBlock
Dim Puth As String
Dim Coord(0 To 2) As Double
Dim Desk As String
Dim objLayer As AcadLayer
Dim objLayers As AcadLayers
Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject")
Putsh = "F:\ZNAK\"
Coord = ThisDrawing.Utility.GetPoint(, "Указать точку: ")
Desk = ThisDrawing.Utility.GetString(True, "Имя точки: ")
Dim blockRefObj As AcadBlockReference
Patsh = Putsh & Trim(Desk) & ".dwg"
If fs.fileexists(Patsh) Then
    Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(Coord, Patsh, 1#, 1#, 1#, 0#)
else
    temp=MsgBox("не могу найти фаил: " & Patsh)
endif

End Sub

Ответ от BP

  • BP
  • Восстановленный участник
  • На форуме с 19 мая 2005г.
  • Сообщений: 112
  • Спасибо: 0

Re: Вставить блок

Или проще, без FSO.

Patsh = Putsh & Trim(Desk) & ".dwg"
If [b]Dir(Patsh) <> ""[/b] Then
    Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(Coord, Patsh, 1#, 1#, 1#, 0#)
else
    temp=MsgBox("не могу найти фаил: " & Patsh)
endif

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

Re: Вставить блок

> Gogi
Будете смеяться но теперь и у меня работает
Переустановил AutoCAD :)
Только строчка

Dim Coord(0 To 2) As Double

выдает ошибку

Compile Error:
Can 't assign to array
лучше объявлять
Dim Coord As Variant

~'J'~

  • LeonidSN
  • Активный участник
  • На форуме с 30 мая 2005г.
  • Сообщений: 1,480
  • Спасибо: 5

Re: Вставить блок

А что было не так в оригинале у Maxima?
Похоже, просто намудрил с именем файла:
Puth,Desk,Putsh,Patsh...

  • Maxim
  • Восстановленный участник
  • На форуме с 24 декабря 2005г.
  • Сообщений: 124
  • Спасибо: 0

Re: Вставить блок

Огромное спасибо теперь все работает. Только точка вставки оказалась не в середине фигуры из-за этого сам блок отлетел от указанной точки.

  • SmeL
  • SmeL
  • Активный участник
  • Откуда: Молдова
  • На форуме с 29 сентября 2005г.
  • Сообщений: 464
  • Спасибо: 1

Re: Вставить блок

> Maxim
Точка вставки для блока есть начало координат блока, сместите объект в середину

  • Dron
  • Восстановленный участник
  • На форуме с 17 марта 2007г.
  • Сообщений: 97
  • Спасибо: 0

Re: Вставить блок

Немного о ромашке с InsertBlock, работает не работает. В версиях AutoCAD 14, с 2000 по 2002,
данный метод работает только с блоками уже определёнными в рабочем документе.
Только начиная с версии 2004 данный метод работает с внешними блоками. Если в имени
блока путь не указан, то вначале ищет в рабочем документе, затем по путям прописанным в настройках AutoCAD.
Кстати, изменения коснулись и списка допустимых символов в имени слоя:
AutoCAD 14, 2000-2002
<>/\"";?*|,+'
AutoCAD с 2004
<>/\"":;?*|,=`

  • BP
  • Восстановленный участник
  • На форуме с 19 мая 2005г.
  • Сообщений: 112
  • Спасибо: 0

Re: Вставить блок

Dron пишет:

В версиях AutoCAD 14, с 2000 по 2002,
данный метод работает только с блоками уже определёнными в рабочем документе

Ничего похожего. См. справку.

  • SmeL
  • SmeL
  • Активный участник
  • Откуда: Молдова
  • На форуме с 29 сентября 2005г.
  • Сообщений: 464
  • Спасибо: 1

Re: Вставить блок

> BP
Подтверждаю ни каких нарицаний к InsertBlock нету ACAD Map 2000i

  • Dron
  • Восстановленный участник
  • На форуме с 17 марта 2007г.
  • Сообщений: 97
  • Спасибо: 0

Re: Вставить блок

Начинал писать объектный код ещё под 14-тый, и данная информация была взята именно из хелпа,
изменения заметил только в 2004, в 2000i знаю точно что по крайней мере у меня не работало.
Но если в хелпе сказано, то рад что оказался не прав. Спасибо за поправку.

  • На форуме с 10 сентября 2007г.
  • Сообщений: 1
  • Спасибо: 0

Re: Вставить блок

День добрый.
Нижеприведенная часть кода вставляет чертеж из файла "E:\Blk1.dwg" в ативный документ как блок.
insPnt(0) = 0: insPnt(1) = 0: insPnt(2) = 0
TheDrw = "E:\Blk1.dwg"
Set oBlkRef = ActiveDocument.ModelSpace.InsertBlock(insPnt, TheDrw, 1, 1, 1, 0)
НО: это работает только для *.DWG. Файл с расширением *.DXF программа не воспринимает. Почему так, ведь команде InsertBlock безразлично, какое у файла расширение?

  • andrej2005
  • Восстановленный участник
  • На форуме с 27 ноября 2008г.
  • Сообщений: 11
  • Спасибо: 0

Re: Вставить блок

С помощью ниже напечатанной процедуры меняю значения атрибутов в чертеже. Но не все атрибуты встают на место в блоке правильно(посередине окошка), хотя если менять вручную, то все ОК. Может кто посоветует - чертежей много, около тысячи?

Private Sub FileProcessing(MainDoc As AxDbDocument)
    Dim MS As AcadModelSpace
    Set MS = MainDoc.ModelSpace
    Dim i As Integer
    Dim entObjectID As Long
    Dim tempObj As AcadObject
    Dim atribut, a As Variant
    Dim ent As AcadEntity
    Dim blokref As AcadBlockReference
    Dim stitek_atributu, newText, blokname As String
    Dim itemLocked As Boolean
    Dim pageObject As Page
    For Each pageObject In Me.MultiPage1.Pages
        On Error Resume Next
        For i = 0 To MS.count
            entObjectID = MS.Item(i).ObjectID
            Set tempObj = MainDoc.ObjectIdToObject(entObjectID)
            If (TypeOf tempObj Is AcadBlockReference) Then
                If (tempObj.Name = blokname) Then
                    Set ent = tempObj
                    Set blokref = ent
                    atribut = blokref.GetAttributes
                    a = -1
                    Do
                        a = a + 1
                        If (atribut(a).TagString = stitek_atributu) Then
                            atribut(a).TextString = newText
                        End If
                    Loop While atribut(a).TagString <> stitek_atributu
                End If
            End If
        Next i
    Next pageObject
    End Sub

  • andrej2005
  • Восстановленный участник
  • На форуме с 27 ноября 2008г.
  • Сообщений: 11
  • Спасибо: 0

Re: Вставить блок

Ой, сорри, не туда влепил!

  • На форуме с 28 июня 2010г.
  • Сообщений: 25
  • Спасибо: 1

Re: Вставить блок

А как вставить блок из файла?
Т.е. не чертеж файла, а отдельный блок хранящийся в файле?

Ответ от Vildar (изменено: Вильдар, 14 октября 2010г. 17:26:57)

  • Vildar
  • Активный участник
  • Откуда: Саратов
  • На форуме с 15 августа 2008г.
  • Сообщений: 574
  • Спасибо: 11

Re: Вставить блок

gesper,
1. Вставить чертеж как блок методом InsertBlock, потом удалить этот блок. При этом все блоки определенные во вставленном файле будут определены в исходном чертеже.
2. По 1 принципу, но использовать AttachExtenalReference, применить Bind к ссылке, потом удалить.
3. Открыть нужный чертеж и скопировать блок в исходный чертеж. В скрытом режиме можно использовать DBX.