[OSIP]

т.е. у нас есть команда -ATTEDIT мне нужно через командную строку (в VBA потом пропишу команды) изменить значение атрибута.
И упираюсь в выбор атрибута и не знаю как его выбрать, кроме как мышкой!

Вот пример

Command: -ATTEDIT
Edit attributes one at a time? [Yes/No] <Y>: y
Enter block name specification <*>: имя блока
Enter attribute tag specification <*>: тэг атрибута
Enter attribute value specification <*>:
Select Attributes: ???

в справке к этой строке Window/Last/Crossing/BOX/Fence/WPolygon/CPolygon/Previous/AUto
но это мне не сильно помогло, не знаю как правильно воспользоваться

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

Изменять значение атрибута совсем необязательно через командную строку. Получаешь коллекцию атрибутов вхождения блока, через Item находишь указатель на нужный атрибут и задаешь ему TextString.

[OSIP]

А можешь вот с этого места "Получаешь коллекцию атрибутов вхождения блока," поподробнее объяснить?
А то я совсем запутался!
У меня есть данные: имя блока, тэг атрибута, надо отредактировать значение, вот как получить ту самую коллекцию атрибутов программно?
Спасибо!

[trir]

Код:

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

Sub Example_GetAttributes()
    ' This example creates a block. It then adds attributes to that
    ' block. The block is then inserted into the drawing to create
    ' a block reference.
    
    ' Create the block
    Dim blockObj As AcadBlock
    Dim insertionPnt(0 To 2) As Double
    insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0#
    Set blockObj = ThisDrawing.Blocks.Add(insertionPnt, "TESTBLOCK")
    
    ' Define the attribute definition
    Dim attributeObj As AcadAttribute
    Dim height As Double
    Dim mode As Long
    Dim prompt As String
    Dim insertionPoint(0 To 2) As Double
    Dim tag As String
    Dim value As String
    height = 1#
    mode = acAttributeModeVerify
    prompt = "Attribute Prompt"
    insertionPoint(0) = 5#: insertionPoint(1) = 5#: insertionPoint(2) = 0
    tag = "Attribute_Tag"
    value = "Attribute Value"
    
    ' Create the attribute definition object in model space
    Set attributeObj = blockObj.AddAttribute(height, mode, prompt, insertionPoint, tag, value)
    
    ' Insert the block
    Dim blockRefObj As AcadBlockReference
    insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
    Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "TESTBLOCK", 1#, 1#, 1#, 0)
    ZoomAll
    
    ' Get the attributes for the block reference
    Dim varAttributes As Variant
    varAttributes = blockRefObj.GetAttributes
    
    ' Move the attribute tags and values into a string to be displayed in a Msgbox
    Dim strAttributes As String
    Dim I As Integer
    For I = LBound(varAttributes) To UBound(varAttributes)
        strAttributes = strAttributes & vbLf & "  Tag: " & varAttributes(I).TagString & _
                        vbLf & "  Value: " & varAttributes(I).TextString & vbLf & "    "
    Next
    MsgBox "The attributes for blockReference " & blockRefObj.Name & " are: " & strAttributes, , "GetAttributes Example"
    
    ' Change the value of the attribute
    ' Note: There is no SetAttributes. Once you have the variant array, you have the objects.
    ' Changing them changes the objects in the drawing.
    varAttributes(0).TextString = "NEW VALUE!"
    
    ' Get the attributes
    Dim newvarAttributes As Variant
    newvarAttributes = blockRefObj.GetAttributes
    
    ' Again, display the tags and values
    strAttributes = ""
    For I = LBound(varAttributes) To UBound(varAttributes)
        strAttributes = strAttributes & vbLf & "  Tag: " & varAttributes(I).TagString & _
                        vbLf & "  Value: " & varAttributes(I).TextString & vbLf & "    "
    Next
    MsgBox "The attributes for blockReference " & blockRefObj.Name & " are: " & strAttributes, , "GetAttributes Example"
    
End Sub

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

Без особых проверок:

Код:

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

Option Explicit

Public Sub test()
Dim oBlockRef As AcadBlockReference
Dim oEntity As AcadEntity
Dim oPoint As Variant
On Error GoTo lErrorSelection
  ThisDrawing.Utility.GetEntity oEntity, oPoint, "Select block : "
  If oEntity.ObjectName = "AcDbBlockReference" Then
    Set oBlockRef = oEntity
    SetAttrValue oBlockRef, "Tag", "New Value"
  Else
    ThisDrawing.Utility.Prompt "This object is not block reference"
    Exit Sub
  End If
  ThisDrawing.Regen acActiveViewport
  Exit Sub
lErrorSelection:
  ThisDrawing.Utility.Prompt "Nothing selected"
  Exit Sub
End Sub

Public Function SetAttrValue(BlockRef As AcadBlockReference, Tag As String, value As String) As String
On Error GoTo lErrorNoAttr
Dim arAttr As Variant
  arAttr = BlockRef.GetAttributes
Dim oAttrRef As AcadAttributeReference
Dim iCounter As Integer
  For iCounter = LBound(arAttr) To UBound(arAttr)
    If (oAttrRef Is Nothing) And (UCase(arAttr(iCounter).TagString) = UCase(Tag)) Then
      Set oAttrRef = arAttr(iCounter)
    End If
  Next
  If oAttrRef Is Nothing Then
    ThisDrawing.Utility.Prompt "No attribute with tag " & Chr(34) & Tag & Chr(34)
    SetAttrValue = Null
  Else
    oAttrRef.TextString = value
  End If
  Exit Function
lErrorNoAttr:
  ThisDrawing.Utility.Prompt "No attributes"
  SetAttrValue = Null
  Exit Function
End Function

[OSIP]

Сообщение от trir Код: [Выделить все] Sub Example_GetAttributes() ' This example creates a block. It then adds attributes to that ' block. The block is then inserted into the drawing to create ' a block reference. ' Create the block Dim blockObj As AcadBlock Dim insertionPnt(0 To 2) As Double insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0# Set blockObj = ThisDrawing.Blocks.Add(insertionPnt, "TESTBLOCK") ' Define the attribute definition Dim attributeObj As AcadAttribute Dim height As Double Dim mode As Long Dim prompt As String Dim insertionPoint(0 To 2) As Double Dim tag As String Dim value As String height = 1# mode = acAttributeModeVerify prompt = "Attribute Prompt" insertionPoint(0) = 5#: insertionPoint(1) = 5#: insertionPoint(2) = 0 tag = "Attribute_Tag" value = "Attribute Value" ' Create the attribute definition object in model space Set attributeObj = blockObj.AddAttribute(height, mode, prompt, insertionPoint, tag, value) ' Insert the block Dim blockRefObj As AcadBlockReference insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0 Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "TESTBLOCK", 1#, 1#, 1#, 0) ZoomAll ' Get the attributes for the block reference Dim varAttributes As Variant varAttributes = blockRefObj.GetAttributes ' Move the attribute tags and values into a string to be displayed in a Msgbox Dim strAttributes As String Dim I As Integer For I = LBound(varAttributes) To UBound(varAttributes) strAttributes = strAttributes & vbLf & " Tag: " & varAttributes(I).TagString & _ vbLf & " Value: " & varAttributes(I).TextString & vbLf & " " Next MsgBox "The attributes for blockReference " & blockRefObj.Name & " are: " & strAttributes, , "GetAttributes Example" ' Change the value of the attribute ' Note: There is no SetAttributes. Once you have the variant array, you have the objects. ' Changing them changes the objects in the drawing. varAttributes(0).TextString = "NEW VALUE!" ' Get the attributes Dim newvarAttributes As Variant newvarAttributes = blockRefObj.GetAttributes ' Again, display the tags and values strAttributes = "" For I = LBound(varAttributes) To UBound(varAttributes) strAttributes = strAttributes & vbLf & " Tag: " & varAttributes(I).TagString & _ vbLf & " Value: " & varAttributes(I).TextString & vbLf & " " Next MsgBox "The attributes for blockReference " & blockRefObj.Name & " are: " & strAttributes, , "GetAttributes Example" End Sub

Спасибо, но я здесь ещё больше запутался!
Зачем создавать блок, зачем создавать атрибуты в блоке?

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

----- добавлено через ~11 мин. -----

Сообщение от Кулик Алексей aka kpblc ThisDrawing.Utility.GetEntity oEntity, oPoint, "Select block : "

Вот эту строчку не понял, здесь нужно выбрать блок руками или я неправильно понимаю!

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

OSIP, процедура только для проверки. Фактически вся работа идет внутри функции.

[OSIP]

Сообщение от Кулик Алексей aka kpblc OSIP, процедура только для проверки. Фактически вся работа идет внутри функции.

т.е. процедуру отбрасываем и смотрим только на функцию?

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

Если ты ухитришься вызвать функцию, передав ей все параметры - то вперед

[OSIP]

Сообщение от Кулик Алексей aka kpblc Если ты ухитришься вызвать функцию, передав ей все параметры - то вперед

Сейчас вроде первично разобрался с предложенными тобой функцией и процедурой, но не у видел в каком месте мы запрос к чертежу делаем, чтобы получить атрибут

Т.е. как я предполагаю, должна быть функция получения значения атрибута по блоку и по тэгу, потом её редактирование и функция возвращения (эту функцию я увидел)

----- добавлено через ~1 ч. -----

Сообщение от trir strAttributes = strAttributes & vbLf & " Tag: " & varAttributes(I).TagString & _ vbLf & " Value: " & varAttributes(I).TextString & vbLf & " "

Поясните, пожалуйста, эту строчку

[trir]

Я просто привёл пример из справки, к методу GetAttributes - это был мягкий способ сказать RTFM!!!

Код:

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

strAttributes = strAttributes & vbLf & "  Tag: " & varAttributes(I).TagString & _
                        vbLf & "  Value: " & varAttributes(I).TextString & vbLf & "    "

В этой строке просто формируется строка...

[OSIP]

Сообщение от trir Я просто привёл пример из справки, к методу GetAttributes - это был мягкий способ сказать RTFM!!! Код: [Выделить все] strAttributes = strAttributes & vbLf & " Tag: " & varAttributes(I).TagString & _ vbLf & " Value: " & varAttributes(I).TextString & vbLf & " " В этой строке просто формируется строка...

Про формирование строки я понял...
Всё теперь дошло, сам сижу туплю и буквы сливаются воедино!

Спасибо!

----- добавлено через ~17 ч. -----
Кулик Алексей aka kpblc,

Я всё по поводу этой строчки: ThisDrawing.Utility.GetEntity oEntity, oPoint, "Select block : "
Как мне получить блок чертежа без запроса к пользователю, чтобы он выбрал блок?
Т.е. у меня есть имя блока, даже его координаты (0,0,0), а вот как правильно задать их тут я не могу понять

----- добавлено через ~18 ч. -----
Вот код функции, всё работает кроме выбора объекта в чертеже, он постоянно запрашивает Select Object

Код:

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

Public Function GetAttrValue() As String
Dim blockRefObj As AcadBlockReference
Dim oEntity As AcadEntity
Dim oPoint As Variant
ThisDrawing.Utility.GetEntity oEntity, oPoint

If oEntity.ObjectName = "AcDbBlockReference" Then
    Set blockRefObj = oEntity
End If

Dim tag As String
tag = "CLDWG"
Dim value As String
value = "850"
Dim varAttributes As Variant
varAttributes = blockRefObj.GetAttributes
Dim oAttrRef As AcadAttributeReference
Dim strAttributes As String
Dim I As Integer
  For I = LBound(varAttributes) To UBound(varAttributes)
    If (oAttrRef Is Nothing) And (UCase(varAttributes(I).TagString) = UCase(tag)) Then
      Set oAttrRef = varAttributes(I)
    End If
  Next
If oAttrRef Is Nothing Then
    ThisDrawing.Utility.Prompt "No attribute with tag " & Chr(34) & tag & Chr(34)
    GetAttrValue = Null
Else
  value = value + Mid(oAttrRef.TextString, 12)
  oAttrRef.TextString = value
End If
End Function

[trir]

Для этого есть SelectionSet

Код:

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

Using Programming Languages other than VBA

Sub Example_Select()
	' This example adds members to a selection set, first by crossing and
	' then by filtering for circles.

	' Create the selection set
	Dim ssetObj As AcadSelectionSet
	Set ssetObj = ThisDrawing.SelectionSets.Add("SSET")


	' Add all object to the selection set that lie within a crossing of (28,17,0) and
	' (-3.3, -3.6,0) 
	Dim mode As Integer
	Dim corner1(0 To 2) As Double
	Dim corner2(0 To 2) As Double

	mode = acSelectionSetCrossing
	corner1(0) = 28: corner1(1) = 17: corner1(2) = 0
	corner2(0) = -3.3: corner2(1) = -3.6: corner2(2) = 0
	ssetObj.Select mode, corner1, corner2

	' Add all the Circles to the selection set that lie within the crossing of (28,17,0) and
	' (-3.3, -3.6,0) by filtering from the current drawing
	Dim gpCode(0) As Integer
	Dim dataValue(0) As Variant
	gpCode(0) = 0
	dataValue(0) = "Circle"

	Dim groupCode As Variant, dataCode As Variant
	groupCode = gpCode
	dataCode = dataValue

	ssetObj.Select mode, corner1, corner2, groupCode, dataCode

End Sub

http://entercad.ru/acadauto.en/