Альбомы технических решений и чертежи
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Как програмно запихнуть в блок все примитивы

Как програмно запихнуть в блок все примитивы

Ответ
Поиск в этой теме
Непрочитано 04.05.2006, 17:09 #1
Как програмно запихнуть в блок все примитивы
Хотабыч
 
Регистрация: 02.06.2005
Сообщений: 15

Вообщем задачка такая.
Есть dxf файл с некоторым чертежом. Надо создать из всех примитивов чертежа блок програмно(желательно на vba), без распознования типа примитива.
Я делаю select acSelectionSetAll. Потом в цикле перебираю все объекты, распознаю его тип и запихиваю в блок, типа:
Код:
[Выделить все]
objBlock.AddText(...)
....
objBlock.AddLine(...)
а потом удаляю.
Есть ли способ по проще?
Просмотров: 2468
 
Непрочитано 04.05.2006, 17:23
#2
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 37,453


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

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 04.05.2006, 18:50
#3
C1


 
Регистрация: 13.06.2005
Сообщений: 314


Можно и через sendcommand ("_wblock", ...).
C1 вне форума  
 
Непрочитано 05.05.2006, 23:36 Re: Как програмно запихнуть в блок все примитивы
#4
Елпанов Евгений

программист
 
Регистрация: 20.12.2005
Москва
Сообщений: 1,440
Отправить сообщение для Елпанов Евгений с помощью Skype™


Цитата:
Сообщение от Хотабыч
Вообщем задачка такая.
Есть dxf файл с некоторым чертежом. Надо создать из всех примитивов чертежа блок програмно
........................
........................
Есть ли способ по проще?
Если нужен блок со всем содержимым файла - наверное проще использовать этот файл как блок для вставки...
PS. возможно я не до конца понял вопрос - слишком простое решение
Елпанов Евгений вне форума  
 
Непрочитано 06.05.2006, 21:03
#5
fixo

Lisp/VBA/VB.NET Hobbyist
 
Регистрация: 24.03.2005
Славен Град Петров
Сообщений: 367


Наверно для асов 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'~
fixo вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Как програмно запихнуть в блок все примитивы

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск