[praeeo]

Приветствую!
Никак не могу решить задачу изменения определенного цвета (например, черного) у всех объектов чертежа на другой цвет. Есть вот набросок макроса, но он отчего-то не работает. Подскажите, куда двигаться дальше.

Код:

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

Sub Sel()
Dim objSS As AcadSelectionSet
Dim objEnt As AcadEntity
On Error Resume Next
If SelectionSets(0).Name = "" Then
SelectionSets.Add ("q")
End If
Set objSS = SelectionSets(0)
objSS.Select (acSelectionSetAll)
For Each objEnt In objSS
objEnt.color = acGreen
Debug.Print objEnt.ObjectName
Next
End Sub

Апдейт:

Изменил For Each на For

Код:

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

For i = 0 To objSS.Count
objSS(i).color = acWhite

Стало лучше, но цвет все равно меняется не у всех элементов (как я понимаю, у блоков не меняется). И с размеров исчезают цифры, только линии остаются

[TararykovDG]

praeeo, Твой код очень даже работает, только он изменяет цвет всем объектам независимо от их текущего цвета на зеленый
А вот так будет изменяться только у объектов черного цвет

Код:

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

Sub Sel()
Dim objSS As AcadSelectionSet
Dim objEnt As AcadEntity
On Error Resume Next
If SelectionSets(0).Name = "" Then
SelectionSets.Add ("q")
End If
Set objSS = SelectionSets(0)
objSS.Select (acSelectionSetAll)
For Each objEnt In objSS
If (objEnt.color = acWhite) Then
objEnt.color = acGreen
End If
Debug.Print objEnt.ObjectName
Next
End Sub

[praeeo]

Код с заменой Each For работает увереннее, но все равно не у всех элементов цвет меняется (у блоков и размеров он не меняется). Сейчас решить хотя бы задачу замены цвета всех элементов независимо от их исходного цвета.

[TararykovDG]

Цвет у блоков тоже меняется, просто блок состоит из элементов у которых цвет может быть выставлен отдельно от самого блока ("послою" или вообще напрямую конктретный цвет), для того чтобы цвет элемента менялся вместе с цветом самого блока необходимо в описании блока для каждого элемента установить цвет "поблоку". Поэтому надо переопределить описание блока, тогда во всех его вхождениях установятся новые параметры (например цвет)

[praeeo]

Сообщение от TararykovDG Цвет у блоков тоже меняется, просто блок состоит из элементов у которых цвет может быть выставлен отдельно от самого блока ("послою" или вообще напрямую конктретный цвет), для того чтобы цвет элемента менялся вместе с цветом самого блока необходимо в описании блока для каждого элемента установить цвет "поблоку". Поэтому надо переопределить описание блока, тогда во всех его вхождениях установятся новые параметры (например цвет)

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

[TararykovDG]

praeeo, я не пишу на VBA, поэтому не знаю насколько логичным получился код, поковырялся в справке и получилось как-то так

Код:

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

Sub Sel()

Dim blkColl As AcadBlocks
Dim blkDef As AcadBlock
Dim ent As AcadEntity
Dim i As Integer
' Перебираем все описания блоков чертежа
Set blkColl = ThisDrawing.Blocks    ' коллекция всех блоков чертежа
For Each blkDef In blkColl          ' описание каждого блока из коллекции всех блоков чертежа
    If ((Not (blkDef.Name Like "*Model_Space")) And _
    (Not (blkDef.Name Like "*Paper_Space*"))) Then    ' пропускаем блок модели чертежа и блоки листов чертежа
        For Each ent In blkDef      ' текущий элемент текущего описания блока
            ent.color = acByBlock   ' устанавливаем цвет "поблоку"
        Next
    End If
Next

Dim objSS As AcadSelectionSet
Dim objEnt As AcadEntity
On Error Resume Next
If SelectionSets(0).Name = "" Then
SelectionSets.Add ("q")
End If
Set objSS = SelectionSets(0)
objSS.Select (acSelectionSetAll)
For Each objEnt In objSS
If (objEnt.color = acWhite) Then
objEnt.color = acGreen
End If
Debug.Print objEnt.ObjectName
Next
End Sub