• На форуме с 30 октября 2006г.
  • Сообщений: 70
  • Спасибо: 0

Тема: Как задать или изменить значение атрибута?

Надо вставить блок в определении которого есть атрибут и задать значение атрибута.
Проверка наличия блока или его создания производится следующей функцией:

Public Function ПроверитьНаличиеСпециальногоБлока(strНазвБлока As String, dblВысотаТекста As Double)
Dim objСпецБлок As AcadBlock, lngНомОб As Long, objОбъект As AcadEntity, dblInsP(0 To 2) As Double, vТочка As Variant
   On Error Resume Next
   Err.Clear
   Set objСпецБлок = gobjАвтоКАД.ActiveDocument.Blocks(strНазвБлока)
   If Err.Number <> 0 Then
On Error GoTo ОбработкаОшибок
      Set objСпецБлок = gobjАвтоКАД.ActiveDocument.Blocks.Add(dblInsP, strНазвБлока)
      Set objОбъект = objСпецБлок.AddPoint(dblInsP): objОбъект.Layer = "0"
      Set objОбъект = objСпецБлок.AddAttribute(dblВысотаТекста, acAttributeModeNormal, "Укажи примечание для точки:", dblInsP, "Примечание", ""): objОбъект.Layer = "0"
   Else
On Error GoTo ОбработкаОшибок
'Проверим чтобы в блоке был объект - точка
      For lngНомОб = 0 To objСпецБлок.Count - 1
         Set objОбъект = objСпецБлок(lngНомОб)
         If objОбъект.ObjectName = "AcDbPoint" Then
            vТочка = objОбъект.Coordinates
            If vТочка(0) = 0 And vТочка(1) = 0 And vТочка(2) = 0 Then
               GoTo ПроверитьНаличиеАтрибута
            End If
         End If
      Next lngНомОб
'Объект точка небыл найден, поэтому добавим его самостоятельно
      Set objОбъект = objСпецБлок.AddPoint(dblInsP): objОбъект.Layer = "0"
'Проверим наличие атрибута
ПроверитьНаличиеАтрибута:
      For lngНомОб = 0 To objСпецБлок.Count - 1
         Set objОбъект = objСпецБлок(lngНомОб)
         If objОбъект.ObjectName = "AcDbAttributeDefinition" Then
            If objОбъект.TagString = "Примечание" Then
               objОбъект.Height = gdblМасштаб * dblВысотаТекста
               Exit Function
            End If
         End If
      Next lngНомОб
'Объект атрибут небыл найден, поэтому добавим его самостоятельно
      Set objОбъект = objСпецБлок.AddAttribute(dblВысотаТекста, acAttributeModeNormal, "Укажи примечание для точки:", dblInsP, "Примечание", ""): objОбъект.Layer = "0"
   End If
   Exit Function
ОбработкаОшибок:
   MsgBox "При проверке наличия специального блока произошла ошибка: " & Err.Number & vbLf & vbLf & _
   Err.Description, vbExclamation, gstrНазваниеПрограммы
   Resume Next
End Function

Вставка блоков в следующем коде:

'Начертим блоки с атрибутом примечанием
   For lngНомТочки = 1 To lngКолвоТочек
      dblInsP(0) = dblМассивОтметокПоОсиX(lngНомТочки)
      dblInsP(1) = dblМассивОтметокПоОсиY(lngНомТочки)
      strПримечание = strПримечания(lngНомТочки)
      Set objОбъект = gobjАвтоКАД.ActiveDocument.ModelSpace.InsertBlock(dblInsP, mstrНазвБлока, 1, 1, 1, 0)
      objОбъект.Layer = mstrНазвСлоя
      objОбъект.Update
   Next lngНомТочки

Каким образом атрибуту блока "Примечание" присвоить значение переменной strПримечание?

  • На форуме с 30 октября 2006г.
  • Сообщений: 70
  • Спасибо: 0

Re: Как задать или изменить значение атрибута?

Посмотрел в справке и сделал функцию:

Public Function ЗадатьЗначениеАтрибута(objБлок As Variant, strНазвАтрибута As String, strЗначение As String)
'Функция изменяет значение атрибута в блоке
Dim vАтрибуты As Variant, lngI As Long, objОбъект As AcadEntity
   vАтрибуты = objБлок.GetAttributes()
   For lngI = 0 To UBound(vАтрибуты)
      Set objОбъект = vАтрибуты(lngI)
      If objОбъект.TagString = strНазвАтрибута Then
         objОбъект.TextString = strЗначение
         Exit Function
      End If
   Next lngI
End Function

Кое что исправил в функции "ПроверитьНаличиеСпециальногоБлока" и предложил модератору исправления

  • На форуме с 9 ноября 2007г.
  • Сообщений: 8
  • Спасибо: 0

Re: Как задать или изменить значение атрибута?

вот мой код для блока с аттрибутами:

Dim blockRefObj As AcadBlockReference, InsPoint(0 To 2) As Double,varAttributes As Variant
InsPoint(0) = 0: InsPoint(1) = 0: InsPoint(2) = 0#
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(InsPoint, "prom_opora", 1#, 1#, 1#, 0#)
   
varAttributes = blockRefObj.GetAttributes
    For i = LBound(varAttributes) To UBound(varAttributes)
        Select Case varAttributes(i).TagString
            Case
                varAttributes(i).TextString = "Text"
        End Select
    Next

имя "NAME" указываешь имя своего аттрибута