• Максим
  • Восстановленный участник
  • На форуме с 18 мая 2005г.
  • Сообщений: 16
  • Спасибо: 0

Тема: Выбор слоя для построения и уничтожения объектов на нем

Здравствуйте!
Я хочу строить точки на определенном слое. Таких построений мне надо выполнить несколько серий. Надо уничтожать точки, построенные в прошлой серии перед тем, как строить точки новой серии. Как строить точки на конкретном слое и все удалять их потом оттуда?

  • JS
  • Восстановленный участник
  • На форуме с 12 мая 2005г.
  • Сообщений: 51
  • Спасибо: 0

Re: Выбор слоя для построения и уничтожения объектов на нем

Для создания слоя использую такую функцию (я работаю в AC2002, если AC старше, то с цветом там по другому):

Public Function PrepareLayer(vDoc As AcadDocument, _
            ByVal LayerName As String, _
            Optional LayerColor As Integer = 7) As AcadLayer
    On Error Resume Next
        Set PrepareLayer = vDoc.Layers.Item(LayerName)
    If Err Then
        Err.Clear
        Set PrepareLayer = vDoc.Layers.Add(LayerName)
        If Not IsMissing(LayerColor) Then PrepareLayer.Color = LayerColor
    End If
End Function

Далее в своей программе делаешь так.

Dim pColPoint As New Collection
Dim pPnt As AcadPoint
Dim pPoint(2) As Double
Dim i As Long
    Set pACD = ThisDrawing
    pACD.ActiveLayer = PrepareLayer(pACD, "NewLay", 1)
    For i = 1 To 10
        pPoint(0) = i
        pPoint(1) = i
        Set pPnt = pACD.ModelSpace.AddPoint(pPoint)
        pColPoint.Add pPnt
    Next i

И они появляются. А для уничтожения 

    For Each pPnt In pColPoint
        pPnt.Delete
    Next pPnt
    Set pColPoint = Nothing

Это если все операции производятся на уровне процедуры. Если нужно создавать точки в одной процедуре, а уничтожать в другой, то определение коллекции толжно быть сделано на уровне модуля. Но это, в общем азы программирования. Говорю об этом, потому, что и вопрос, вроде как из начальной школы.
Вызов 

pACD.ActiveLayer = PrepareLayer(pACD, "NewLay", 1)

обеспечивает создание слоя и установку его текущим. Можно вызвать так:

PrepareLayer pACD, "NewLay"

, тогда при создании объектов (здесь - точек) нужно устанавливать имя слоя обьекта у каждого в отдельности.
Теперь, если нужно зачистить все объекты на слое, то можно так:

Public Function ClearLayer(vBlc As AcadBlock, _
            ByVal LayerName As String, _
            Optional LayerDelete As Boolean = True) As Boolean
Dim pE As AcadEntity
Dim i As Long, ii As Long
    On Error Resume Next
    ii = vBlc.Count
    For i = ii - 1 To 0 Step -1
        Set pE = vBlc.Item(i)
        If pE.Layer = LayerName Then
            pE.Delete
            If Err Then Err.Clear
        End If
    Next i
    If LayerDelete Then
        vBlc.Document.Layers.Item(LayerName).Delete
        If Err Then
            Err.Clear
        Else
            ClearLayer = True
        End If
    End If
End Function

Вызов функции:

    pACD.ActiveLayer = pACD.Layers("0")
    ClearLayer pACD.ModelSpace, "NewLay"

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