[Pavel Tesko]

В AutoCAD я обычно использую в среднем 8 слоёв. Уважаемые форумчани, подскажите пожалуйста есть ли возможность в AutoCAD, выбирать слой не курсором мышки, а с помощью клавиатуры. Например следующим образом: нажимается какая-то базовая или сочетания клавиш запускающая команду выбрать слой, а затем выбирается слой посредствам ввода порядкового номера присвоенного индивидуально каждому из используемых слоёв. Возможно ли это?

[Boxa]

Сообщение от Gefest1 Прочитав тему я так понял, что способ не придумали? У меня сейчас такое ТЗ для программы: -переключение слоёв должно происходить внутри действующего фильтра слоёв. -команда задается сочетанием клавиш на клавиатуре -выбор слоя осуществляется колесом мышки (либо, по желанию пользователя, по началу названия слоя набираемого с клавы), название слоя отображается возле курсора -подтверждение выбора слоя осуществляется по нажатию ЛКМ (либо ПКМ, либо колесика) -после этого выбранный слой становится текущим, а если был выбран объект - то объект переносится на выбранный слой. По моему, получится удобно (ели фильтр настроен грамотно) Если слои назвать например 1,2,3,.. то получаем результат, который хотел ТС. Получится такое сделать?

С первого взгляда проблем не вижу, ничего сложного в ТЗ нет, все реализуемо, надо просто сеть и написать.
ЗЫ.
Я со стороны C# смотрю.

[Кулик Алексей aka kpblc]

Offtop: Boxa, вот зря ты это написал Сейчас на тебя насядут: ну так сделай, раз не сложно!

[Setvar]

А я бы вообще ничего не стал делать, если предполагается слои называть просто цифрами. IMHO.

[Boxa]

Offtop:

Сообщение от Кулик Алексей aka kpblc Сейчас на тебя насядут: ну так сделай, раз не сложно!

Автор спрашивал: "Получится такое сделать?. Я написал, что получится. реализуемо != не сложно

[Gefest1]

Ок, уточню: есть ли энтузиасты, недавно изучившие как писать программы для автокада, жаждущие попрактиковаться и получить творческое удовольствие, и создать полезную для людей программу?
Если есть - сделайте пожалуйста, и если всё будет хорошо - похвалим и вам будет приятно, если нет - узнаете что надо повысить квалификацию)
В другой раз для вас тоже что-нибудь хорошее сделают.

[Boxa]

Сообщение от Gefest1 энтузиасты, недавно изучившие как писать программы

Кулик Алексей aka kpblc, А ты говоришь насядут =о) Я тут по всем параметрам сразу мимо. =о)

[Alexeipost]

Добрый день!
Как во всей подшивке (разные файлы) сделать один определенный слой непечатаемым?
Точнее как добраться до слоёв в каждом файле из подшивки с помощью vba?

[Сергей812]

Сообщение от Alexeipost Точнее как добраться до слоёв в каждом файле из подшивки с помощью vba?

никак) Из подшивки можно получить имена *.dwg файлов, содержащие листы, включенные в подшивку.

[Alexeipost]

До "печатаемости" слоя в данном файле добрался.

Код:

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

Sub Слой_печать_вкл_выкл()
Dim i As Integer

For i = 0 To ThisDrawing.Layers.Count - 1
    If ThisDrawing.Layers.Item(i).Name = "Печать_подписи" Then
        If ThisDrawing.Layers.Item(i).Plottable = False Then
            ThisDrawing.Layers.Item(i).Plottable = True
        Else
            ThisDrawing.Layers.Item(i).Plottable = False
        End If
    End If

Next

End Sub

Теперь надо добраться до остальных файлов в подшивке.

2 Сергей812
Можно маленький примерчик как взять подшивку и перебрать все файлы в ней, пожалуйста)))

[Сергей812]

А разве так работать не будет:

Код:

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

Dim lLayer As AcadLayer
On Error Resume Next
Set lLayer = ThisDrawing.Layers(%Имя  слоя%)
If (Err.Number = 0) then  lLayer.Plottable = Not lLayer.Plottable

писал на коленке, VBA в акаде у меня уже много лет даже не установлен)

Сообщение от Alexeipost Можно маленький примерчик как взять подшивку и перебрать все файлы в ней, пожалуйста)))

Перебираете подшивку, получаете листы в цикле. Из листа получаете имя привязанного файла *.dwg, проверяете - нет ли такого уже файла во вспомогательном списке имен файлов. Если нет - добавляете. Если используется древовидную структуру листов в подшивке, то будут еще субнаборы (в .Net это AcSmSubset) листов. Обрабатываете листы в этих субнаборах с помощью рекурсии.

[Boxa]

Сообщение от Alexeipost Можно маленький примерчик как взять подшивку и перебрать все файлы в ней, пожалуйста)))

Нда... неужели настолько лень документацию читать... C:\Program Files\Autodesk\AutoCAD 20ХХ\Sample\ActiveX\SheetSetVBA\

[Сергей812]

Дополнению к коду в посте №109 - если нашли слой, то можно выходить из цикла. Или надеетесь, что ещё будет слой с таким же именем?)

[Alexeipost]

2 Сергей812
Ваш код работает.

2 Boxa
Читать не лень. По указанному адресу нет такой папки у меня.

[Сергей812]

Тут на форуме есть все, как в Греции) За правильность не ручаюсь - лень вчитываться)

[Alexeipost]

Заклинание непинания: "Я не программист! Я делаю свою работу удобнее и быстрее!"

Для чего эта программа?
Если надо отправить на печать (на плоттер или в пдф) документ с подписями и печатями, то данная программа включает слой "Печать_подписи" (у меня именно в этом слое находятся подписи и печати) во всех листах подшивки.
Если надо этот слой выключить, то по месту (1) см.код вместо True надо поставить False.
Вот что получилось:

Код:

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

Sub Layer_Plotable_on()
Dim lLayer As AcadLayer  'Слой
Dim oEnumDb As IAcSmEnumDatabase 'База подшивок
Dim oItem As IAcSmPersist 'Одна подшивка
Dim oSheetSetMgr As AcSmSheetSetMgr
Set oSheetSetMgr = New AcSmSheetSetMgr

Set oEnumDb = oSheetSetMgr.GetDatabaseEnumerator
Set oItem = oEnumDb.Next 'Берем первую подшивку

Dim oSheetDb As AcSmDatabase

'Перебор открытых подшивок
Do While Not oItem Is Nothing
    Set oSheetDb = oItem
    
    oSheetDb.LockDb oSheetDb 'Блокировка подшивки для работы с ней
    If oSheetDb.GetLockStatus = 1 Then
        On Error Resume Next
        Dim oEnum As IAcSmEnumPersist
        Dim oItemSh As IAcSmPersist
        Dim oacSht As IAcSmSheet 'Один лист в подшивке
        
        Set oEnum = oSheetDb.GetEnumerator
        Set oItemSh = oEnum.Next 'Берем один лист
        Do While Not oItemSh Is Nothing
            If oItemSh.GetTypeName = "AcSmSheet" Then 'Если свойство листа подшивки AcSmSheet, то вытаскиваем имя файла данного листа подшивки
                Set oacSht = oItemSh
                ThisDrawing.Application.Documents.Open (oacSht.GetLayout.ResolveFileName) 'открываем этот файл
                Set lLayer = ThisDrawing.Layers("Печать_подписи") 'Ищем слой "Печать_подписи"
                If (Err.Number = 0) Then
                    lLayer.Plottable = True 'Если находим, то делаем этот слой печатаемым (1) False вместо True делает слой непечатаемым
                Else
                    MsgBox "Слой ""Печати_подписи"" не найден" 'Если не находим сообщаем что такого слоя в файле нет
                End If
                ThisDrawing.Close True 'Закрываем с сохранением файл
            End If
        Set oItemSh = oEnum.Next 'Берем следующий лист подшивки
    Loop 'Конец перебора листов

    oSheetDb.UnlockDb oSheetDb 'Разблокируем подшивку
    End If
    Set oItem = oEnumDb.Next 'Берем следующую подшивку
Loop 'Конец перебора подшивок
End Sub

Код не оптимальный.
У меня некоторые листы подшивки ссылаются на один и тот же файл.
Прога каждый раз открывает файл листа подшивки делает своё дело и закрывает его.
Ускорить работу данного кода можно открыв все файлы листов подшивки, потом по очереди менять значение plotable и закрывать файлы. Для этого надо сделать проверку "если файл уже открыт, то не открывать его".
Допустим у меня есть подшивка, в которой десять листов ссылаются на один файл.
Вот так вот.

[Boxa]

Если Вы все равно используете On Error Resume Next, то зачем вот это:

Код:

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

Set lLayer = ThisDrawing.Layers("Печать_подписи") 'Ищем слой "Печать_подписи"
If (Err.Number = 0) Then
    lLayer.Plottable = True 'Если находим, то делаем этот слой печатаемым (1) False вместо True делает слой непечатаемым
Else
     MsgBox "Слой ""Печати_подписи"" не найден" 'Если не находим сообщаем что такого слоя в файле нет
End If

проще сделать все сразу:

Код:

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

ThisDrawing.Layers.Item("Печать_подписи").Plottable = True

Если есть, то включит, если нет то ошибку проглотит...

Хотя я бы конструцию On Error Resume Next и условия не использовал, а обошелся бы конструкцией

Код:

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

For Each lLayer In ThisDrawing.Layers
    If lLayer.Name = "Печать_подписи" Then
        lLayer.Plottable = True
        Exit For
    End If
Next

ЗЫ.
В .NET проще, там можно напрямую спросить, есть ли слой с заданным именем....

[Сергей812]

Общие замечания и рекомендации:
1. В начале программы вставить запрос - включить и выключить слой через функцию GetKeyword.
2. Использовать логирование в комстроку акада, закрывать каждый раз MsgBox - не совсем френдли интерфейс.
3. Сначала перебрать все подшивки, собрать оттуда имена файлов, а потом уже обрабатывать файлы. Попробуйте для создания списка уникальных имен файлов использовать Scripting.Dictionary с поздним связыванием (если админы не отключили скрипты, конечно).
4. Выводить имена обрабатываемых файлов в комстроку акада и статус обработки типа: ОК, не удалось открыть, не найден слой.
5. Сделайте счетчики для разных состояний статуса обработки и выводите в комстроке в конце суммарную информацию: всего файлов, из них успешно и т.д.

[Alexeipost]

Сообщение от Сергей812 Общие замечания и рекомендации: 1. В начале программы вставить запрос - включить и выключить слой через функцию GetKeyword.

Можно и так, но у меня на панели две разные кнопки ("принтер" и "зачеркнутый принтер"), а в файле plot_on_off.dvb два кода (вкл/выкл).

Сообщение от Сергей812 2. Использовать логирование в комстроку акада, закрывать каждый раз MsgBox - не совсем френдли интерфейс.

Согласен что не френдли. Как применить логирование? (У себя строку с MsgBox убрал апострофом)

Сообщение от Сергей812 3. Сначала перебрать все подшивки, собрать оттуда имена файлов, а потом уже обрабатывать файлы. Попробуйте для создания списка уникальных имен файлов использовать Scripting.Dictionary с поздним связыванием (если админы не отключили скрипты, конечно).

Админы у нас конечно те ещё звери, но я к скриптам отношения не имею))) По этому смотрю в сторону "открытия файла если такой файл еще не открыт".

Сообщение от Сергей812 4. Выводить имена обрабатываемых файлов в комстроку акада и статус обработки типа: ОК, не удалось открыть, не найден слой.

Поделитесь примером на VBA

Сообщение от Сергей812 5. Сделайте счетчики для разных состояний статуса обработки и выводите в комстроке в конце суммарную информацию: всего файлов, из них успешно и т.д.

Надо заморочиться на это.

[Сергей812]

Сообщение от Alexeipost Можно и так, но у меня на панели две разные кнопки ("принтер" и "зачеркнутый принтер"), а в файле plot_on_off.dvb два кода (вкл/выкл).

дублировать весь код из-за одной строки со значением - я бы вынес в отдельную процедуру с параметром: Boolean - статус печати и уже ее бы в командах вызывал.

Сообщение от Alexeipost Согласен что не френдли. Как применить логирование? (У себя строку с MsgBox убрал апострофом)

Сообщение от Alexeipost Поделитесь примером на VBA

ThisDrawing.Utility.Prompt - принимает один аргумент в виде строки. Соответственно, формируете строки (для переноса строк используя vbCrLf) и выводите в комстроку акада.

Сообщение от Alexeipost Админы у нас конечно те ещё звери, но я к скриптам отношения не имею))) По этому смотрю в сторону "открытия файла если такой файл еще не открыт".

это внутри кода VBA создаваемый объект, просто в отличие от встроенных в сам VBA коллекций более гибкий инструмент.

[feel-alex]

В адаптации назначаете горячую клавишу и в ней пишите макрос
^C^C(setvar "CLAYER" "ИМЯСЛОЯ")
Можете и в контекстное меню поставить и горячие клавиши назначить