Блоки с одинаковым именем (Страница 1 из 2)

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

Я тоже так думал.
Но у меня есть чертеж. На нем куча блоков. При выделении выделяется только один. В свойствах: "Разное" "Имя" одно и то же у всех блоков. В "Атрибутах" "Number" имеет значение для всех индивидуальное. И не числовое, а символьное.
Вот и мне требуется реализовать такой режим. Как не представляю, так то же считал, что имя блоков уникальное.

Я разобрался с ситуацией, это блоки с одним именем и с разными атрибутами.
У них заданы атрибуты Tag (значение "NUMBER"), TextString ( уникальное значение у каждого блока).
Теперь появились вопросы по добавлению атрибутов.
Стандартное добавление

RetVal = object.AddAttribute(Height, Mode, Prompt, InsertionPoint, Tag, Value) 

Не совсем понятны параметры.

Height - высота. Высота чего?

Mode - а это что? Более того, в моих блоках это свойство отсутствует. При попытке просмотра выскакивает ошибка.

Prompt - аналогично отсутствует.

InsertionPoint - координаты вставки. Какие это координаты? Относительно точки привязки блока?

Tag - ?

Value - ? Также отсутствует.

А как добавить TextString?

И последнее. Блоки сразу можно создавать с одним и тем же именем и разными атрибутами или необходимо
создать сначала блоки с разными именами, а затем добавить атрибуты и переименовать?

Заранее спасибо.

Доброе время суток.

Так это точка привязки блока или атрибута блока? Ведь у блока есть своя точка привязки. Ее указываешь, когда вставляешь блок. А если это точка привязки атрибута, то какие указываются координаты -  абсолютные или это относительные координаты внутри блока относительно его точки привязки.
Когда я создавал блоки я так и поступал - все объекты помещал внутрь блока с координатами относительно точки привязки а затем помещал блок в нужное место.

Можно ли добавлять атрибуты к существующему блоку? Просто у меня есть уже готовая программа. Блоки создавал без атрибутов. Хотелось бы просто добавить их к существующим блокам.

И как добавить атрибут "TextString"?

И самое главное.

Можно ли сделать следующее - переименовать блоки, присвоить им одно и тоже имя и разное значение атрибутов TextString?

Прошу прощения за бестолковость, но пока никак не могу разобраться с атрибутами, "с чем их едят"! :D

Начни с этого

Option Explicit

Sub TestAddAttributes()
     Dim oSset As AcadSelectionSet
     Dim oEnt As AcadEntity
     Dim blkRef As AcadBlockReference
     Dim setName As String
     Dim dxfcode(0 To 1) As Integer
     Dim dxfdata(0 To 1) As Variant
     dxfcode(0) = 0
     dxfdata(0) = "INSERT"
     dxfcode(1) = 2
     Dim i As Integer
     Dim bName As String
     bName = InputBox(vbCr & vbCr & "Введи имя блока:", "Добавление атрибутов")
     dxfdata(1) = bName

     setName = "$Blocks$"
    
          ' удостоверяемся, что именованный выбор не существует

          With ThisDrawing.SelectionSets
               While .Count > 0
                    .Item(0).Delete
               Wend
               ' создаем новый выбор
          Set oSset = .Add(setName)
          End With
     
     oSset.Select acSelectionSetAll, , , dxfcode, dxfdata
     '
     If oSset.Count = 0 Then
          ThisDrawing.Utility.prompt (vbCr & "Блок " & bName & " не существует в рисунке")
     Else
          ThisDrawing.Utility.prompt (vbCr & "Выбрано: " & oSset.Count & " блоков")
     End If
     Dim attName As String
     attName = UCase(InputBox(vbCr & vbCr & "Введи имя атрибута:", "Добавление атрибутов", "TAG1"))
     If attName <> vbNullString Then
          Set oEnt = oSset.Item(0)
          Set blkRef = oEnt
          Dim attVar As Variant
          Dim oAtt As AcadAttributeReference
          Dim hasThisTag As Boolean
          hasThisTag = False
          attVar = blkRef.GetAttributes

          For i = 0 To UBound(attVar)
               Set oAtt = attVar(i)
               Dim txtHeight As Double
               txtHeight = oAtt.height
               Dim tagStr As String
               tagStr = oAtt.TagString
               If StrComp(attName, tagStr, vbTextCompare) = 0 Then
                    ThisDrawing.Utility.prompt (vbCr & "Тэг : " & attName & " не создан")
                    hasThisTag = True
                    Exit For
                    Exit Sub
               End If
          Next

          If Not hasThisTag Then
               Dim blkDef As AcadBlock
               Set blkDef = ThisDrawing.Blocks(bName)
               Dim origPt As Variant
               origPt = blkDef.Origin
               txtHeight = 250     '<--высота текста
               Dim insPt(2) As Double
               '______________________________________________
               ' Повтори следующий блок кода столько скольо нужно атрибутов,
               '  (точка вставки атрибута должна пересчитываться)
               'Точка вставки атрибута относительyj точки вставки блока!
               insPt(0) = origPt(0) + 200     '<--измени по своему условию
               insPt(1) = origPt(2) + 200     '<--измени по своему условию
               insPt(2) = origPt(2)
               Dim pmtStr As String
               pmtStr = InputBox(vbCr & vbCr & "Введи подсказку атрибута:", "Добавление атрибутов", "Моя подсказка")
               Dim valStr As String
               valStr = InputBox(vbCr & vbCr & "Введи значение атрибута:", "Добавление атрибутов", "0.000")
               Dim attObjDef As AcadAttribute
               Set attObjDef = blkDef.AddAttribute(txtHeight, acAttributeModeVerify, pmtStr, insPt, attName, valStr)
               '______________________________________________    
               With ThisDrawing
                    .SetVariable "CMDECHO", 0
                    .SendCommand "_ATTSYNC _N " & bName & vbCr
                    .SetVariable "CMDECHO", 1
                    .Regen acAllViewports
               End With

          End If

     End If

     oSset.Delete
     Set oSset = Nothing

End Sub

[FONT=Arial]~'J'~[/FONT]

С атрибутами получилось, все в порядке.
Но осталась главная проблема с переименованием.

Привожу свой код:

Public Sub ChangeCMB(X As Variant)
   Dim props() As AcadDynamicBlockReferenceProperty
   Dim prop As AcadDynamicBlockReferenceProperty
   Dim i As Integer
   Dim Attrs() As AcadAttributeReference
   Dim Attr As AcadAttributeReference
   Dim Dict As AcadDictionary
   Dim acBlockName As String
   Dim objBl As AcadBlock
   Dim ent As AcadBlockReference

   UserForm1.ListBox1.Clear
   index = UserForm1.ComboBox1.ListIndex
   
   UserForm1.ListBox1.AddItem ("Имя блока: " + entColl(index + 1).Name)
   UserForm1.ListBox1.AddItem ("Слой: " + entColl(index + 1).Layer)
   UserForm1.ListBox1.AddItem ("EffectiveName: " & entColl(index + 1).EffectiveName)
   UserForm1.ListBox1.AddItem ("ObjectName: " & entColl(index + 1).ObjectName)
   UserForm1.ListBox1.AddItem ("ObjectID: " & entColl(index + 1).ObjectID)
   UserForm1.ListBox1.AddItem ("OwnerID: " & entColl(index + 1).OwnerID)
   UserForm1.ListBox1.AddItem ("Координаты точки привязки:")
   UserForm1.ListBox1.AddItem ("X: " & entColl(index + 1).InsertionPoint(0))
   UserForm1.ListBox1.AddItem ("Y: " & entColl(index + 1).InsertionPoint(1))
   UserForm1.ListBox1.AddItem ("Z: " & entColl(index + 1).InsertionPoint(2))
   
   UserForm1.ListBox1.AddItem ("Свойства : ")
   props = entColl(index + 1).GetDynamicBlockProperties
   For i = LBound(props) To UBound(props)
     Set prop = props(i)
     UserForm1.ListBox1.AddItem ("PropertyName : " & prop.PropertyName & "  Value : " & prop.Value)
   Next i
 
   UserForm1.ListBox1.AddItem ("Атрибуты : ")
   Attrs = entColl(index + 1).GetAttributes
   For i = LBound(Attrs) To UBound(Attrs)
     Set Attr = Attrs(i)
     UserForm1.ListBox1.AddItem ("TagString : " & Attr.TagString)
     UserForm1.ListBox1.AddItem ("TextString : " & Attr.TextString)
     ' Переименование
     acBlockName = entColl(index + 1).Name
     If Attr.TextString Like "*МПВ*" Then
        Set objBl = ThisDrawing.Blocks(entColl(index + 1).Name)
        objBl.Name = "ВЭЗ"
     End If
   
     
     UserForm1.ListBox1.AddItem ("Constant : " & Attr.Constant)
     UserForm1.ListBox1.AddItem ("Height : " & Attr.Height)
     UserForm1.ListBox1.AddItem ("InsertionPoint X : " & Attr.InsertionPoint(0))
     UserForm1.ListBox1.AddItem ("InsertionPoint Y : " & Attr.InsertionPoint(1))
     UserForm1.ListBox1.AddItem ("InsertionPoint Z : " & Attr.InsertionPoint(2))
 
   Next i
   
   UserForm1.ListBox1.AddItem ("Dictionary : ")
   If entColl(index + 1).HasExtensionDictionary Then
      Set Dict = entColl(index + 1).GetExtensionDictionary
      UserForm1.ListBox1.AddItem ("Name : " & Dict.Name)
   End If

   entColl(index + 1).Highlight (True)
End Sub

На файле примера он с успехом выполняется. Блоки (изначально имеющие одно и тоже имя переименовываются).    Изменяется и .Name и .EffectiveName.

Однако, когда пытаюсь применить данный код к чертежу, построенному моей программой, переименовывается только первый блок! Затем выдается ошибка - "Дублирование данных". И вот здесь ничего не могу понять!
Все атрибуты, выдаваемые на экран этим кодом, одинаковые.

Вставку блока в своей программе делаю через

         ThisDrawing.ModelSpace.InsertBlock p2, objWorksheet.Cells(i, 1).Value, 1, 1, 1, 0

Так в чем может быть причина?

Это вроде понятно и само собой подразумевается.
Но как быть с примером? Всю бошку сломал.

Доброе время суток.

В данном фале множество блоков, которые имеют одно и то же имя (например, ИИ22002) и различные атрибуты (свойство Number с различным значением).
Эти блоки создавались вручную через надстройку к ACAD.

У меня задача создать такие же блоки. И, самое главное, чтобы они также имели одно и тоже имя и различались атрибутами.
И вот последнее у меня не удается!
Хотя в том же файле примера спокойно переименовываю эти блоки, присваивая одно и тоже имя (другое).

И вот никак не могу понять, как были созданы эти блоки с одним и тем же именем.

Они имеют одинаковые тэги и разные значения.
Но вся проблема, чтобы программно создать такие же блоки - одинаковые имена, одинаковые тэги с различными значениями. И вот это у меня не получается.

Спасибо, обязательно проверю, но позже.
Но, насколько я понимаю, речь идет об изменении атрибутов и работе с ними.
С этим уже проблем нет (благодаря Вам, отдельное спасибо).

Проблема с именами блоков!
Выше я приводил свой код.
Проблема в следующем месте:

If Attr.TextString Like "*МПВ*" Then
   Dim objBl As AcadBlock
   Set objBl = ThisDrawing.Blocks(entColl(index + 1).Name)
   objBl.Name = "ВЭЗ"
End If

На чертеже примера этот код работает. И все блоки вместо имени ИИ22002 получают имя ВЭЗ.
Однако, когда я пытаюсь выполнить данную процедуру к своему чертежу, построенному моей программой,
этот код выполняется только один раз. На втором блоке выдается сообщение об ошибке - "Дублирование данных".
И я никак не пойму - как могли появиться блоки с одинаковыми именами?
Я не могу найти отличия между блоками в примере и в моем чертеже.

А почему на чертеже примере все проходит нормально!? Там блоки чем то отличаются?

Так суть в том, чтобы создать блоки с одним именем или переименовать программным путем.

Попробовал.

oBlk.Name = "Íîâîå èìÿ áëîêà" 

Выдает ошибку - Неверный ввод.
Изменил на явную строку.
Ситуация повторилась.
На чертеже примера блоки последовательно переименовываются.
На моем чертеже переименовывается один блок. На втором ошибка - дублирующиеся записи.