[serg72]

Уважаемые форумчане! Окажите помощь новичку. Как мне обратиться к выбранному в чертеже объекту (блоку) чтобы в макросе VBA изменить его атрибуты. Для нового вставляемого блока есть примеры - там мне все понятно, а вот как быть с уже выбранным?

[trir]

А в чём проблема? К выбранному - через текущий SelectSet.

[casemsot]

Offtop: Глукоуважаемый, ваше благородие мой избранник! Разрешите пожалуйста к Вам обратиться....

[serg72]

Пробую так:

Dim blockRefObj As AcadBlockReferenc
Dim sset As AcadSelectionSet
Dim currXScaleFactor As Double

Set sset = ThisDrawing.ActiveSelectionSet
currXScaleFactor = blockRefObj.XScaleFactor

Как теперь от sset перейти к blockRefObj чтобы менять свойства блока?

[gomer]

Сообщение от casemsot Глукоуважаемый, ваше благородие мой избранник! Разрешите пожалуйста к Вам обратиться....

Сообщение от serg72 Для нового вставляемого блока есть примеры - там мне все понятно, а вот как быть с уже выбранным?

Читайте справку и начинайте уже думать!!! У каждого объекта есть методы и свойства... Посмотрите свойство Attributes у объекта BlockRef (экземпляр блока)! Нету??? А методы какие есть?
зы код из #4 работать не будет

[trir]

AcadSelectionSet - это коллекция, перебираем её в поисках нашего блока, получаем его как блок и работаем

[gomer]

Сообщение от trir AcadSelectionSet - это коллекция, перебираем её в поисках нашего блока, получаем его как блок и работаем

Сообщение от gomer Читайте справку и начинайте уже думать!!!

Для кого есть метод GetEntity ?

[Олег (jr.)]

Сообщение от serg72 Уважаемые форумчане! Окажите помощь новичку. Как мне обратиться к выбранному в чертеже объекту (блоку) чтобы в макросе VBA изменить его атрибуты. Для нового вставляемого блока есть примеры - там мне все понятно, а вот как быть с уже выбранным?

Код:

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

Option Explicit
' change all attributes
' based on Tony Tanzillo's code
Public Function GatteEx(ByRef objBlk As AcadBlockReference, _
                              tagArr As Variant, valArr As Variant)
     Dim attVar As Variant
     Dim objAtt As AcadAttributeReference
     Dim i As Long, j As Long
     attVar = objBlk.GetAttributes
     If UBound(attVar) <> UBound(tagArr) Or _
        UBound(valArr) <> UBound(tagArr) Then
          MsgBox "Error with array"
          Exit Function
     End If
     For i = LBound(attVar) To UBound(attVar)
          Set objAtt = attVar(i)
          For j = LBound(tagArr) To UBound(tagArr)
               If objAtt.TagString = tagArr(j) And _
                  valArr(j) <> "" Then
                    objAtt.TextString = valArr(j)
               End If
          Next j
     Next i
     objBlk.Update

End Function

' Usage example:
Sub DoStuff()
Dim oEnt As AcadEntity
Dim varPt, tagArray, valueArray ' all are variants
Dim blk As AcadBlockReference
ThisDrawing.Utility.GetEntity oEnt, varPt, "Select block"
Set blk = oEnt
' tag array:
tagArray = Array("TAG1", "TAG2", "TAG3", "TAG4") ' <--your attributes tags here
' to change all the attributes:
valueArray = Array("0.001", "0.002", "0.003", "0.004") ' <--your attributes values here
' but if you need to change certain attributes only
' you can pass empty string in place where you do not want
' to change these attributes, i. e.:
' valueArray = Array("0.001", "0.002", "", "0.004") ' <-- the second attribute tag was omitted
' you can get these both arrays from excel sheet, i.e.
' tags= Sheet1.Range("A1:D1").Value
' values= Sheet1.Range("A2:D2").Value or something similar on it
GatteEx blk, tagArray, valueArray
' or you can call it like this (argumments are inside of parenthesises):
' Call GatteEx( blk, tagArray, valueArray)
End Sub]

[serg72]

Всем спасибо за помощь. Получилось через GetEntity. Сейчас возникла другая проблема в лиспе не получается переименовать блок.

_$ (setq blk (vlax-ename->vla-object (car (entsel "/nУкажите блок"))))
#<VLA-OBJECT IAcadBlockReference 2e2cb5b4>
_$ (vla-put-name blk "0")
; ошибка: Ошибка Automation. Ключ не найден

[trir]

Переименовать блок можно, только если нет его вхождений.

[serg72]

Сообщение от trir Переименовать блок можно, только если нет его вхождений.

Как раз уменя вхожнение в блок. Может есть другие способы, ведь в Acad есть возможность вручную переименовать блок.

[trir]

Я про ручной способ и говорю. В вхождении вообще нельзя. Создай новый блок как копию исходного, а потом поменяй вхождения.

BlockRef: A block reference can be assigned the name of only a valid block definition in the drawing. Assigning a block reference a unique name will not automatically create a new block definition. To create a new block definition, use the Add method to add a new Block object to the Blocks collection.

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

Сообщение от trir Переименовать блок можно

В любом случае. Вручную: _.rename. Программно - просто надо работать с описаниями блоков, а не с вхождениями:

Код:

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

 (vla-put-name (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (vla-get-effectivename (vlax-ename->vla-object (car (entsel "\nSelect block : "))))) "Новое имя")

[serg72]

Спасибо за помощь, все понял.