[Хотабыч]

Вообщем задачка такая.
Есть dxf файл с некоторым чертежом. Надо создать из всех примитивов чертежа блок програмно(желательно на vba), без распознования типа примитива.
Я делаю select acSelectionSetAll. Потом в цикле перебираю все объекты, распознаю его тип и запихиваю в блок, типа:

Код:

[Выделить все]

objBlock.AddText(...)
....
objBlock.AddLine(...)

а потом удаляю.
Есть ли способ по проще?

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

Если там нет атрибутов, попробуй copyobjects поковырять. Очень даже ничего...

[C1]

Можно и через sendcommand ("_wblock", ...).

[Елпанов Евгений]

Сообщение от Хотабыч Вообщем задачка такая. Есть dxf файл с некоторым чертежом. Надо создать из всех примитивов чертежа блок програмно ........................ ........................ Есть ли способ по проще?

Если нужен блок со всем содержимым файла - наверное проще использовать этот файл как блок для вставки...
PS. возможно я не до конца понял вопрос - слишком простое решение

[fixo]

Наверно для асов VBA это примитивно, но можешь
спробовать:

Код:

[Выделить все]

Option Explicit

''--- WBLOCK ---''

Public Sub BlockToWblock(BlkNme As String)

  Dim InsPnt(0 To 2) As Double
  Dim BlkDef As AcadBlock
  Dim i As Integer
  Dim j As Integer
  Dim BlkObj As AcadBlockReference
  Dim BlkExp As Variant
  Dim SelSet As AcadSelectionSet
  Dim BlkSet As AcadSelectionSet
  Dim pickPnt As Variant
  Dim sObj As AcadEntity
  Dim objCollection() As Object
  Dim retObjects As Variant
  Dim sysVarName As String
  Dim varData As Variant
    
  Set SelSet = NewSelectionSet("ITEMS_BLOCKSET")
  
  With ThisDrawing
    SelSet.SelectOnScreen
    pickPnt = ThisDrawing.Utility.GetPoint(, "Select a point...")

    Set BlkDef = .Blocks.Add(pickPnt, BlkNme)
    For i = 0 To SelSet.Count - 1
    ReDim Preserve objCollection(i)
    Set objCollection(i) = SelSet(i)
    Next i
    .CopyObjects objCollection, BlkDef

    Set BlkObj = .ModelSpace.InsertBlock(pickPnt, BlkNme, 1#, 1#, 1#, 0)
    Set BlkSet = NewSelectionSet("WBLOCKSET")
    With BlkObj
      BlkExp = .Explode
      .Delete
    End With
    BlkSet.AddItems BlkExp
    .Wblock BlkNme, BlkSet
  End With


End Sub


Public Function NewSelectionSet(AxsName As String) As AcadSelectionSet


  Dim SelSet As AcadSelectionSet
  Dim SelCol As AcadSelectionSets

  With ThisDrawing
    Set SelCol = .SelectionSets
    For Each SelSet In SelCol
      If SelSet.Name = AxsName Then
        .SelectionSets.Item(AxsName).Delete
        Exit For
      End If
    Next
    Set SelSet = .SelectionSets.Add(AxsName)
  End With

  Set NewSelectionSet = SelSet
End Function

Sub Test_Wblock()
Dim BlkName As String
BlkName = InputBox(Prompt:="Enter WBLOCK name " & _
Chr(13) & " without extension", Title:="WBlock Example")
BlockToWblock (BlkName)
End Sub

Fatty

~'J'~