[evgm]

привет всем!
из VBA методами add... добавляются линии, текст, блоки и тд
как бы их все объеденить, посадить куда-нибудь курсор мыши и позволить потом пользователю таскать это все то есть указать место вставки?
заранее спасибо

[Sleekka]

может тебе нужно group, хотя вопрос непонятен.

[evgm]

может быть...
(я недавно начал работать с акадом из VB так что....)
возможно я вообще некорректно формулирую вопрос... но постараюсь объяснить
модуль VBA что-то рисует (addline, addtext, addcircle и тд)
все что он рисует нужно сгруппировать (объеденить, выделить и тп)
задать базовую точку установить в нее курсор и датьвозможность пользователю указать самому место вставки этого всего
может group может selectionset
я еще начинающий так что если можно то поподробнее
спасибо заранее

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

ИМХО, ИМХО - по 3 раза на каждое слово.
1. Создать блок с предопределенным именем (например, evgm_temp_block). Можно создавать и анонимные блоки, но они не обрабатываются "_.change".
2. Добавлять отрезки, полилинии и прочую лабуду в этот блок.
3. Либо через ThisDrawing.SendCommand "_.-insert", либо через ThisDrawing.SendCommand "_.change" вставить блок и получить ссылку на конкретную вставку.
4. Разбить ее при успешном завершении команды (ent.Explode) и удалить (ent.Erase).
Код не пишу по нескольким причинам:
- я почти не знаю VBA
- для корректного работоспособного кода надо потратить массу времени (отслеживание состояния слоев, отследить активное пространство, обработать вариант "имя такое уже есть" ну и так далее), а я спать сильно хочу.

[evgm]

пытаюсь сделать так
Dim AcadPLine As AcadPolyline
Dim AcadText As AcadText
Dim newBlock As AcadBlock
Dim acBlockRef As AcadBlockReference

Set newBlock = Application.ActiveDocument.Blocks.Add(InsertionPoint, "insblock")

Set AcadPLine = Application.ActiveDocument.Blocks("insblock").AddPolyline(pLineArray)
Set AcadText = Application.ActiveDocument.Blocks("insblock").AddText("lalala", InsertionPoint, 0.36)

'вот тут не видно как таксается блок по экрану а хотелось бы

Set acBlockRef = .InsertBlock(Application.ActiveDocument.Utility.GetPoint(, "Точка вставки"), "insblock", 1, 1, 1, 0)

Call acBlockRef.Explode

'теперь слзданный блок как-нибудь удалить еще

Set newBlock = Nothing
Set AcadBlockRef = Nothing

Set AcadPLine = Nothing
Set AcadText = Nothing

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

Стоп. Ты все верно делаешь, но "не до конца".
Ты вставляешь созданное описание блока "куда-то". Теперь применяй _change к этой вставке.
Либо вообще не вставляй, а запускай сразу _-insert с указанием имени блока.

[evgm]

это как???
как это кодом то сделать???

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

Я почти не пользую VBA, так что за корявость кода прошу ногами по голове не бить

Код:

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

Option Explicit

Sub Test()
Dim ptInsert(2) As Double
Dim sBlockName As String
Dim lCounter As Long
Dim BlockDefinition As AcadBlock, BlockReference As AcadBlockReference
Dim acLWPLine As AcadLWPolyline, acText As AcadText
Dim acLWPlineVertex() As Double
  On Error GoTo lErrorPurge
  ptInsert(0) = 0#: ptInsert(1) = 0#: ptInsert(2) = 0#
  sBlockName = "TempInsBlock"
  On Error Resume Next
  If ThisDrawing.Blocks(sBlockName) Then
    ThisDrawing.PurgeAll
  End If
  On Error GoTo 0
  Set BlockDefinition = ThisDrawing.Blocks.Add(ptInsert, sBlockName)
  ReDim acLWPlineVertex(7)
  acLWPlineVertex(0) = -5#: acLWPlineVertex(1) = -5#: acLWPlineVertex(2) = 5#: acLWPlineVertex(3) = -5#
  acLWPlineVertex(4) = 5#: acLWPlineVertex(5) = 5#: acLWPlineVertex(6) = -5#: acLWPlineVertex(7) = 5#
  Set acLWPLine = BlockDefinition.AddLightWeightPolyline(acLWPlineVertex)
  acLWPLine.Closed = True
  Set acText = BlockDefinition.AddText("qwerty", ptInsert, 3.5)
  acText.Alignment = acAlignmentMiddleCenter
  acText.InsertionPoint = ptInsert
  ThisDrawing.SendCommand "_.-insert" & vbCr & BlockDefinition.Name & vbCr & _
    "_s" & vbCr & "1" & vbCr
  ThisDrawing.SendCommand "_.explode" & vbCr & "_l" & vbCr & vbCr
  Exit Sub
lErrorPurge:
  ThisDrawing.PurgeAll
  Resume
End Sub

Как предотвратить запрос поворота - я пока не знаю. Оставлю это на твоей совести

[evgm]

оба на!!!
огромное спасибо - все ок...

[evgm]

только вот что -то какой-то ужас происходит если при insert
не указать сразуже точку вставки а попытаться переместить лист средней клавишей мыши...

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

Странно. Только что специально проверил на AutoCAD 2005 Eng - все работает... Можно поподробнее?

[evgm]

у меня 2006 En

ThisDrawing.SendCommand "_.-insert" & vbCr & BlockDefinition.Name & vbCr & _
"_s" & vbCr & "1" & vbCr

вот тут как мне кажется нужно дождаться завершения вставки
а при нажатии на среднюю клавишу выполнения кода продолжается хотя акад реально блок не вставил еще
начинает просить угол поворота, масштабы и вообще просит зачем-то секонд поинт... а ему подсовывается
_.explode и _l вместо этого...

ThisDrawing.SendCommand "_.explode" & vbCr & "_l" & vbCr & vbCr

[evgm]

кстати запрос угла поворота задается
"_r" & vbCr & "0"

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

ADT 2006 Rus + SP1, запущен как AutoCAD. Глюков со вставкой не заметил. Запуск макроса выполнялся как через Alt+F8, так и через _-vbarun.
Зато заметил, что блок, собака, не разбивается. Стоит поставить точку останова на

Код:

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

ThisDrawing.SendCommand "_.explode" & vbCr & "_l" & vbCr & vbCr

как все начинает корректно разбиваться. Чего ему не нравится - я пас
> пост #13 : Ну вот видишь, а говорил "сам не могу, не получается"...

[evgm]

да все вставляется вот так
ThisDrawing.SendCommand "_.-insert" & vbCr & tmp_Имя & vbCr & "_s" & vbCr & "1" & vbCr & "_r" & vbCr & "0" & vbCr & vbCr
по крайней мере вроде внешних без глюков...
а explode не выполняется потому что при нажатии мыши акад еще ждет каких-то параметров для вставки а ему в след строке вместо этих параметров подсовывается сначала _.-explode а потом _l
то есть команда вставки не до конца зевершилась...