• Андрей
  • Восстановленный участник
  • На форуме с 9 июня 2006г.
  • Сообщений: 96
  • Спасибо: 0

Тема: Метод Wblock

Здравствуйте, уважаемые Знатоки.
В пространстве модели находиться  выделенная при помощи мыши полилиния , подскажите, как ее можно поместить в блок, без изменения координат ее вершин.
Недавно, на вашем форуме узнал, что данную задачу можно решить создав набор (selection set) объектов и применив метод Wblock.
Set objSelCol = ThisDrawing.SelectionSets
For Each objSelSet In objSelCol
If objSelSet.Name = "Имя набора" Then
objSelSet.Delete
Exit For
End If
Next
Set objSelSet = ThisDrawing.SelectionSets.Add("Имя набора")
objSelSet.SelectOnScreen
ThisDrawing.Wblock "Имя блока", objSelSet
Но блок остается без изменения.
Уточняю, что хочу разобраться не с созданием в блоке новых примитивов, а с добавлением в существующий блок выделенных мышкой объектов.

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

Re: Метод Wblock

> Андрей
Здесь лучше использовать метод CopyObjects
Вот пример как добавить один примитив в
указанный на экране блок
Выбери блок, потом выбери примитив
Если нужно добавить несколько тогда тоже
самое выбрать примитивы через SelectionSet
добавить их в массив а дальше тоже самое
Разбирайся сам:

Option Explicit
Public Sub AddToBlock()
Dim blkColl As AcadBlocks
Dim blkDef As AcadBlock
Dim blkRef As AcadBlockReference
Dim pickPt As Variant
Dim blkName As String
Dim objColl(0) As Object
Dim idPairs As Variant
Dim objEnt As AcadEntity
Dim insPt As Variant
Dim origPt As Variant
Dim ucsPt(0 To 2) As Double
On Error GoTo Err_Control
ThisDrawing.Utility.GetEntity blkRef, pickPt, "Select block reference >> "
blkName = blkRef.Name
insPt = blkRef.InsertionPoint
Set blkColl = ThisDrawing.Blocks
Set blkDef = blkColl.Item(blkName)
ThisDrawing.Utility.GetEntity objEnt, pickPt, "Select object to add to block >> "
ucsPt(0) = 0#
ucsPt(1) = 0#
ucsPt(2) = 0#
objEnt.Move insPt, ucsPt
Set objColl(0) = objEnt
ThisDrawing.CopyObjects objColl, blkDef, idPairs
objEnt.Delete
ThisDrawing.Regen acAllViewports
Err_Control:
MsgBox Err.Description
End Sub

~'J'~

  • Андрей
  • Восстановленный участник
  • На форуме с 9 июня 2006г.
  • Сообщений: 96
  • Спасибо: 0

Re: Метод Wblock

Огромное спасибо за помощь.

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

Re: Метод Wblock

> Андрей
Рад, если поспособствовал :)
~'J'~