• На форуме с 17 декабря 2007г.
  • Сообщений: 25
  • Спасибо: 0

Тема: Работа с выделенными объектами при помощи VBA

Здравствуйте, хотелось бы реализовать следующий сервис, человек выделяет блок в автокаде, нажимает Ctrl+W и вызывается макрос поворачивающий выделение на 90 градусов. Слышал, что на лиспе такое можно, но желания учить лисп нет, потому как скоро уже получу деньги за проект, но чтобы людям было удобно хочется сделать это до "конца" (доделывать можно бесконечно). Да, желательно интернациональный вариант, или хотя бы для 2006, потому как я был удивлён отсутствием команды "-insert" в Русской версии 2006, не хотелось бы узнавать новые различия.

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

Re: Работа с выделенными объектами при помощи VBA

> Устинов Юрий
Попробуй для русской версии писать вместо:
-INSERT
так:
_-INSERT (знак подчеркивания вначале)
~'J'~

  • На форуме с 17 декабря 2007г.
  • Сообщений: 25
  • Спасибо: 0

Re: Работа с выделенными объектами при помощи VBA

:) нет там надо -ВСТАВИТЬ :)

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

Re: Работа с выделенными объектами при помощи VBA

> Устинов Юрий
Но в начале знак подчеркивания а потом минус
смотри внимательней
~'J'~

  • На форуме с 17 декабря 2007г.
  • Сообщений: 25
  • Спасибо: 0

Re: Работа с выделенными объектами при помощи VBA

> смотри
внимательней
Прошу прощения, ещё не пробовал, но действительно по невнимательности так ответил

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

Re: Работа с выделенными объектами при помощи VBA

Sub BlockRotate()
    Dim bl As AcadBlockReference
    Dim returnObj As AcadObject
    Dim basePnt As Variant
    Dim rotationAngle As Double
    rotationAngle = 0.7853981 * 2 ' 90 degrees
    On Error Resume Next
RETRY:
    ThisDrawing.Utility.GetEntity returnObj, basePnt, "Select an block"
    If TypeOf returnObj Is AcadBlockReference Then
        Set bl = returnObj
        basePnt = bl.InsertionPoint
        bl.Rotate basePnt, rotationAngle
        bl.Update
        Exit Sub
    Else
        MsgBox "The object type is: " & returnObj.EntityName & vbCrLf & "Try again, please!"
    End If
    GoTo RETRY
End Sub

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

Re: Работа с выделенными объектами при помощи VBA

Тут правда получилось без Ctrl+W, но думаю ты сможешь их приделать.

  • На форуме с 17 декабря 2007г.
  • Сообщений: 25
  • Спасибо: 0

Re: Работа с выделенными объектами при помощи VBA

Спасибо, Леонид, так сейчас и делаю, это
оказалось достаточно удобным для пользователя. Только я сделал несколько по другому определение типа объекта:

Do
Do
Err = 0
ThisDrawing.Utility.GetEntity returnObj, basePnt, "Выбирите объект, пожалуйста"
Loop While Err <> 0
Loop While returnObj.ObjectName <> "AcDbBlockReference"

  • kpblc
  • kpblc
  • Активный участник
  • Откуда: С.-Петербург
  • На форуме с 29 ноября 2004г.
  • Сообщений: 8,348
  • Спасибо: 24

Re: Работа с выделенными объектами при помощи VBA

Как говорится, "а если надо не по одному":

Public Function Pi() As Double
  Pi = Atn(1) * 4
End Function
Public Sub BlockRotate()
Dim fType(0) As Integer, fData(0) As Variant
Dim oSelSet As AcadSelectionSet, SelSetName As String
  SelSetName = "BlockReferenceRotateSelection"
  For Each oSelSet In ThisDrawing.SelectionSets
    If oSelSet.Name = SelSetName Then
      oSelSet.Delete
      Exit For
    End If
  Next oSelSet
  Set oSelSet = ThisDrawing.SelectionSets.Add(SelSetName)
  ThisDrawing.Utility.Prompt "Выберите блоки для поворота на +90 : "
  fType(0) = 0: fData(0) = "INSERT"
  oSelSet.SelectOnScreen fType, fData
Dim oAcadEnt As AcadBlockReference
  For Each oAcadEnt In oSelSet
    oAcadEnt.Rotation = oAcadEnt.Rotation + Pi / 2
  Next oAcadEnt
  oSelSet.Delete
End Sub

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

Re: Работа с выделенными объектами при помощи VBA

> Устинов Юрий
Ну если работает, то хорошо. Но я, например, стараюсь избегать бесконечных циклов чтобы случайно не подвесить ACAD.

  • kpblc
  • kpblc
  • Активный участник
  • Откуда: С.-Петербург
  • На форуме с 29 ноября 2004г.
  • Сообщений: 8,348
  • Спасибо: 24

Re: Работа с выделенными объектами при помощи VBA

> LeonidSN
Жалко, что в VBA нельзя сделать набор из единственного примитива... Или можно?

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

Re: Работа с выделенными объектами при помощи VBA

> Кулик Алексей aka kpblc
Да почему же нельзя, делай сколько угодно.
Ты, наверное, имеешь в виду AcadSelectionSet:

    Dim ss As AcadSelectionSet
    --------------------
    ss.SelectOnScreen
    MsgBox ss.Count

  • kpblc
  • kpblc
  • Активный участник
  • Откуда: С.-Петербург
  • На форуме с 29 ноября 2004г.
  • Сообщений: 8,348
  • Спасибо: 24

Re: Работа с выделенными объектами при помощи VBA

> LeonidSN
Этот вариант, по-моему, не запрещает выбрать 2 или более примитивов. Ладно, забей, не мучайся :) Я сначала хотел мозги подразмять, но теперь уже пас...

  • kpblc
  • kpblc
  • Активный участник
  • Откуда: С.-Петербург
  • На форуме с 29 ноября 2004г.
  • Сообщений: 8,348
  • Спасибо: 24

Re: Работа с выделенными объектами при помощи VBA

P.S. Вспомнил, что я хотел добиться :)
Аналог 

(ssget "_.+:S")

ну а Highlight потом сделать и снять в общем-то не проблема ;)

  • На форуме с 17 декабря 2007г.
  • Сообщений: 25
  • Спасибо: 0

Re: Работа с выделенными объектами при помощи VBA

> LeonidSN
Согласен, я предложил проектировщику ограничение на N ложных нажатий, мы договорились на 10. Уж за 10 раз можно попасть :)

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

Re: Работа с выделенными объектами при помощи VBA

> Устинов Юрий
Ты код не выложил, но насколько я понимаю, в принципе пришел к тому же, что и я в свое время. То есть, когда уже никуда не деться и надо запускать цикл типа Do While - Loop, то ставишь дополнительное условие выхода с гарантированным срабатыванием.

> Кулик Алексей aka kpblc
Ты прав в том, что встроенных средств для ограничения набора в AcadSelectionSet по кол-ву элементов в VB(VBA) нет.

  • На форуме с 17 декабря 2007г.
  • Сообщений: 25
  • Спасибо: 0

Re: Работа с выделенными объектами при помощи VBA

> LeonidSN

Dim N As Integer
Do
Do
Err = 0
ThisDrawing.Utility.GetEntity returnObj, basePnt, "Выбирите объект, пожалуйста"
N = N + 1
Loop While (Err <> 0) And (N < 10)
Loop While (returnObj.ObjectName <> "AcDbBlockReference") And (N < 10)

  • bender
  • Восстановленный участник
  • На форуме с 5 мая 2003г.
  • Сообщений: 345
  • Спасибо: 0

Re: Работа с выделенными объектами при помощи VBA

Все гораздо проще. В "САПР на базе..." все очень доступно написано, а транслировать с Lisp на VBA (в данном случае) достаточно просто.
Комментариев не пишу, кому надо - разберется.

Option Explicit
Option Base 0
Option Compare Text
Sub TestMyGetEntity()
If Not MyGetEntity("AcDbBlockReference") Is Nothing Then
    MsgBox "Yes!"
Else
    MsgBox "No!"
End If
End Sub
Public Function MyGetEntity(Optional strNameEntity As String = "", _
                            Optional strPrompt As String = "Выберите объект <Отмена>:") As AcadEntity
Dim retObj As AcadEntity
Dim retPnt As Variant
On Error Resume Next
With ThisDrawing
    .SetVariable "ERRNO", 0
    Do While (retObj Is Nothing) And (.GetVariable("ERRNO") <> 52)
        .Utility.GetEntity retObj, retPnt, strPrompt
        If Not retObj Is Nothing Then
            If strNameEntity <> "" And StrComp(retObj.ObjectName, strNameEntity, vbTextCompare) <> 0 Then
                Set retObj = Nothing
            End If
        End If
    Loop
End With
Set MyGetEntity = retObj
Set retObj = Nothing
Set retPnt = Nothing
End Function

Можно усовершенствовать и какие-нибудь дополнительные проверки устроить.