> Антон
Как я и подозревал...
Ты говоришь об атрибутах, а сам изменяешь слой
Второе. У блоков в черетеже пустые значения
TagString (имя атрибута) PromptString (подсказка атрибута)
На практике часто их делают одинаковыми
Третье. Обычно делают один блок и только
меняют значения атрибута
У тебя на каждый пикет свой блок (ну это дело
хозяйское)
Если надо добавить TagString и PromptString,
можешь выполнить следующую процедуру
Option Explicit
Sub AddTagsNPrompts()
Dim oBlock As AcadBlock
Dim oblkRef As AcadBlockReference
Dim attVar As Variant
Dim oItm As AcadObject
Dim oAtt As AcadAttribute
Dim oAttRef As AcadAttributeReference
Dim i As Integer
Dim strCommand As String
For Each oBlock In ThisDrawing.Blocks
If oBlock.Name Like "ст*" Then '<-- все блоки которые начинаются на "ст"
For i = 0 To oBlock.Count - 1
Set oItm = oBlock.Item(i)
If TypeOf oItm Is AcadAttribute Then
Set oAtt = oItm
oAtt.PromptString = "Номер_пикета"
oAtt.Update
oAtt.TagString = UCase(oAtt.PromptString)
oAtt.Update
End If
Next i
End If
'strCommand = "_ATTSYNC _N " & oBlock.Name & vbCr
'ThisDrawing.SendCommand strCommand
Next oBlock
Dim pfs As AcadSelectionSet
Set pfs = ThisDrawing.PickfirstSelectionSet
pfs.Clear
Dim ftype(1) As Integer
Dim fdata(1) As Variant
ftype(0) = 0: fdata(0) = "INSERT"
ftype(1) = 2: fdata(1) = "ст*"
pfs.Select acSelectionSetAll, , , ftype, fdata
For Each oItm In pfs
Set oblkRef = oItm
attVar = oblkRef.GetAttributes
For i = 0 To UBound(attVar)
Set oAttRef = attVar(i)
oAttRef.TagString = "НОМЕР_ПИКЕТА"
oAttRef.Update
Next i
Next oItm
ThisDrawing.Regen acAllViewports
End Sub
К сожалению команда ATTSYNC в твоем случае
неприменима, поскольку у тебя различные
положения атрибутов относительно точки
вставки чтоб не накладывался тест
А то что ты называешь именем это слой "_госакт_п_к" а не имя
Так что сначала советую посмотреть Help,
а то получается пустой разговор
~'J'~
PS Насчет фразочки:
Держи http://webfile.ru/1456985
хамить не советую... это тебе надо а не мне
