Как и можно ли использовать Timer

@vaxo55 · Регистрация: 27.09.2012

Студворк — интернет-сервис помощи студентам

на этом примере в autocad открываю слой с названием "красный"
как сделать чтоб слой с названием "красный" открывался на 0,5 сек и закрывался или открывался периодически с периодом 0,5 сек?
код

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Dim PauseTime, Start, Finish, TotalTime
If (MsgBox("Press Yes to pause for 5 seconds", 4)) = vbYes Then
    PauseTime = 5    ' Set duration.
    Start = Timer    ' Set start time.
    Do While Timer < Start + PauseTime
        DoEvents    ' Yield to other processes.
  Set layerObj = ThisDrawing.Layers.Add("красный")
  ' включим слой "("красный")  layerObj.LayerOn = True
 
    Loop
    Finish = Timer    ' Set end time.
    TotalTime = Finish - Start    ' Calculate total time.
    MsgBox "Paused for " & TotalTime & " seconds"
Else
    End
End If

спасибо заранее

Скрипт · 18.11.2012, 14:04

vaxo55, если можно, то создайте аналогичную ситуацию в программе Excel, чтобы вам быстрее помогли, т.к. программа AutCad реже используется.

@vaxo55 · 18.11.2012, 14:21 **[ТС]**

способо Скрипт за отзыв
по моему никакого значения не имеет, если вместо

Visual Basic
1
2
Set layerObj = ThisDrawing.Layers.Add("красный")
  ' включим слой "("красный")  layerObj.LayerOn = True

поставим любую команду

@Novichek =) · 18.11.2012, 15:15

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
Public Sub test()
Application.OnTime Now + TimeValue("00:00:02"), "Work"
End Sub
 
Public Sub Work()
Application.OnTime Now + TimeValue("00:00:02"), "Work22"
UserForm1.Show False
End Sub
 
Public Sub Work22()
UserForm1.Hide
Application.OnTime Now + TimeValue("00:00:01"), "Test"
End Sub

взято из Возможно ли использование более одной Application.OnTime в VBA MS Word
Работоспособно, проверено на Экселе.
[quote=vaxo55;3716292]

Visual Basic
1
Set layerObj = ThisDrawing.Layers.Add("красный")[

/quote] - эту строчку каждый раз повторять не нужно, скорей всего будет ошибка (попытка каждый раз создать слой Layers.Add("красный"))

Кажется нужно использовать

Visual Basic
1
ThisDrawing.ActiveLayer.LayerOn = True

.
Пока не нашел OnTime для автокада (AcadApplication), пока в процессе поиска.

@Novichek =) · 18.11.2012, 16:15

Сообщение от Novichek =)

Пока не нашел OnTime для автокада (AcadApplication), пока в процессе поиска.

Не нашел.
Мы пойдем другим путем

1. Открываем Эксель, заходим в VBA, tools-reference подключаем библиотеки VBA AutoCAD
2. Создаем модуль с кодом

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Public Sub Созд_слоя()
  Dim objApp As AcadApplication
  Dim objDoc As AcadDocument
  Dim layerObj As AcadLayer
  Set objApp = GetObject(, "AutoCAD.Application") ' объявляем АВТОКАД
  Set objDoc = objApp.ActiveDocument ' работаем с активным документом
  Set layerObj = objDoc.Layers.Add("красный")
  objDoc.ActiveLayer = layerObj
    Application.OnTime Now + TimeValue("00:00:10"), "Выкл"
End Sub
 
Public Sub Выкл()
  Dim objApp As AcadApplication
  Dim objDoc As AcadDocument
  Dim layerObj As AcadLayer
  Set objApp = GetObject(, "AutoCAD.Application") ' объявляем АВТОКАД
  Set objDoc = objApp.ActiveDocument ' работаем с активным документом
    objDoc.ActiveLayer.LayerOn = False
    Application.OnTime Now + TimeValue("00:00:10"), "Вкл"
End Sub
 
Public Sub Вкл()
  Dim objApp As AcadApplication
  Dim objDoc As AcadDocument
  Set objApp = GetObject(, "AutoCAD.Application") ' объявляем АВТОКАД
  Set objDoc = objApp.ActiveDocument ' работаем с активным документом
    objDoc.ActiveLayer.LayerOn = True
    Application.OnTime Now + TimeValue("00:00:10"), "Выкл"
End Sub

3. Запускаем Sub Созд_слоя
4. Идем в Автокад где каждые 10 секунд слой "красный" включается и выключается.

Скрипт · 18.11.2012, 16:37

Я так понял, что в VBA для работы с миллисекундами ничего нет. Но можно как-то пристроить функцию Timer. Эта функция показывает, сколько секунд прошло с полночи. Т.е. в полночь Timer будет обнуляться. Но может быть можно использовать функцию Timer, чтобы как-то учитывать миллисекунды, т.к. функция Timer возвращает не целые секунды, а дробные.

Ниже код с бесконечным циклом. Если случайно его запустили, то чтобы остановить, нужно нажать сочетание клавиш Ctlr + Break:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Sub Procedure_1()
 
    Dim PauseTime As Double
    Dim dateActionTime As Double
        
    'Указываем, через сколько секунд должно
    'совершаться действие.
    PauseTime = 0.5
        
    Do
        'Задаём время, когда нужно совершить действие.
        dateActionTime = Timer + PauseTime
        
        'Ждём 0.5 секунд.
        Do While Timer < dateActionTime
            'DoEvents - позволяет работать с программами,
            'пока выполняется код.
            DoEvents
        Loop
        
        'Действие.
        'Чтобы увидеть результат:
        'View - Immediate Window.
        Debug.Print "Действие"
        
    Loop
    
End Sub

Примечание

Есть функция API Win32 для работы с миллисекундами GetTickCount. Эта функция подсчитывает количество миллисекунд со времени запуска Windows.

Функция GetTickCount имеет тип данных Long. Поэтому, если компьютер давно не перезагружался, то возникнет ошибка, что сгенерировано число, большее чем Long. Это примерно через 30 дней.

@vaxo55 · 18.11.2012, 16:57 **[ТС]**

Novichek спосибо большое, но ведь в автокаде есть свой vba.
Скрипт спосибо большое- на страницах imediate пробегают строка "дейсвие", но слой не переключается .
подскажите пожалуйста куда прилепить строка чтоб слой "красный" перелючать

Скрипт · 18.11.2012, 17:15

Сообщение от vaxo55

подскажите пожалуйста куда прилепить строка чтоб слой "красный" перелючать

Если можно, то создайте аналогичную ситуацию в программе Excel, чтобы вам быстрее помогли, т.к. программа AutCad реже используется.

@Novichek =) · 19.11.2012, 12:02

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
Public Sub Procedure_1()
    Dim objApp As AcadApplication
    Dim objDoc As AcadDocument
    Dim layerObj As AcadLayer
    Dim PauseTime As Double
    Dim dateActionTime As Double
    Set objApp = GetObject(, "AutoCAD.Application") ' объявляем АВТОКАД
    Set objDoc = objApp.ActiveDocument ' работаем с активным документом
    Set layerObj = objDoc.Layers.Add("красный") 'создаем красный слой
    objDoc.ActiveLayer = layerObj 'красный слой делаем активным
        
    'Указываем, через сколько секунд должно
    'совершаться действие.
    'PauseTime = 1
        
    'Do
 
        'Задаём время, когда нужно совершить действие.
        'dateActionTime = Timer + PauseTime
        
        'Ждём 5 секунд.
        'Do While Timer < dateActionTime
            'DoEvents - позволяет работать с программами,
            'пока выполняется код.
            DoEvents
        'Loop
        
    If objDoc.ActiveLayer.LayerOn = False Then Call вкл Else Call выкл
           
    'Loop
    
End Sub
 
Public Sub выкл()
    Dim objApp As AcadApplication
    Dim objDoc As AcadDocument
    Set objApp = GetObject(, "AutoCAD.Application") ' объявляем АВТОКАД
    Set objDoc = objApp.ActiveDocument ' работаем с активным документом
    Set layerObj = objDoc.Layers.Add("красный") 'создаем красный слой
    objDoc.ActiveLayer = layerObj 'красный слой делаем активным
 
objDoc.ActiveLayer.LayerOn = False
    
End Sub
 
Public Sub вкл()
    Dim objApp As AcadApplication
    Dim objDoc As AcadDocument
    Set objApp = GetObject(, "AutoCAD.Application") ' объявляем АВТОКАД
    Set objDoc = objApp.ActiveDocument ' работаем с активным документом
    Set layerObj = objDoc.Layers.Add("красный") 'создаем красный слой
    objDoc.ActiveLayer = layerObj 'красный слой делаем активным
 
objDoc.ActiveLayer.LayerOn = True
    
End Sub

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

Добавлено через 6 минут

Сообщение от vaxo55

но ведь в автокаде есть свой vba.

Если бы его не было, я бы не написал пост 5

Просто я работал с автокадом, через Эксель, так как в автокаде нет OnTime (я не нашел).

Добавлено через 1 час 1 минуту
С учетом кода Скрипта, получено.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
Public Sub Procedure_1()
    Dim objApp As AcadApplication
    Dim objDoc As AcadDocument
    Dim layerObj As AcadLayer
    Dim PauseTime As Double
    Dim dateActionTime As Double
    Set objApp = GetObject(, "AutoCAD.Application") ' объявляем АВТОКАД
    Set objDoc = objApp.ActiveDocument ' работаем с активным документом
    Set layerObj = objDoc.Layers.Add("красный") 'создаем красный слой
    objDoc.ActiveLayer = layerObj 'красный слой делаем активным
        
    'Указываем, через сколько секунд должно
    'совершаться действие.
    PauseTime = 1
        
    Do
 
        'Задаём время, когда нужно совершить действие.
        dateActionTime = Timer + PauseTime
        
        'Ждём 5 секунд.
        Do While Timer < dateActionTime
            'DoEvents - позволяет работать с программами,
            'пока выполняется код.
            DoEvents
        Loop
        
    If objDoc.ActiveLayer.LayerOn = False Then Call вкл Else Call выкл
   
 
 
          
 
        
    Loop
    
End Sub
 
Public Sub выкл()
    Dim objApp As AcadApplication
    Dim objDoc As AcadDocument
    Set objApp = GetObject(, "AutoCAD.Application") ' объявляем АВТОКАД
    Set objDoc = objApp.ActiveDocument ' работаем с активным документом
    Set layerObj = objDoc.Layers.Add("красный") 'создаем красный слой
    objDoc.ActiveLayer = layerObj 'красный слой делаем активным
 
objDoc.ActiveLayer.LayerOn = False
objApp.Update
    
End Sub
 
Public Sub вкл()
    Dim objApp As AcadApplication
    Dim objDoc As AcadDocument
    Set objApp = GetObject(, "AutoCAD.Application") ' объявляем АВТОКАД
    Set objDoc = objApp.ActiveDocument ' работаем с активным документом
    Set layerObj = objDoc.Layers.Add("красный") 'создаем красный слой
    objDoc.ActiveLayer = layerObj 'красный слой делаем активным
 
objDoc.ActiveLayer.LayerOn = True
objApp.Update
    
End Sub

Но работать при этом с автокадом невозможно, может быть еще что-то можно сделать.

Скрипт · 19.11.2012, 20:45

Ещё инструмент для выполнения команд кода через заданное время:

Visual Basic
1
2
3
4
5
6
7
8
9
10
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
Sub Procedure_1()
 
    'Указываются миллисекунды.
    Sleep 5000
    
    MsgBox "Run"
 
End Sub

Новые блоги и статьи Все статьи Все блоги /
SDL3 для Web (WebAssembly): Реализация движения на Box2D v3 - трение и коллизии с повёрнутыми стенами 8Observer8 20.02.2026 Содержание блога Box2D позволяет легко создать главного героя, который не проходит сквозь стены и перемещается с заданным трением о препятствия, которые можно располагать под углом, как верхнее. . .	Конвертировать закладки radiotray-ng в m3u-плейлист damix 19.02.2026 Это можно сделать скриптом для PowerShell. Использование . \СonvertRadiotrayToM3U. ps1 <path_to_bookmarks. json> Рядом с файлом bookmarks. json появится файл bookmarks. m3u с результатом. # Check if. . .	Семь CDC на одном интерфейсе: 5 U[S]ARTов, 1 CAN и 1 SSI Eddy_Em 18.02.2026 Постепенно допиливаю свою "многоинтерфейсную плату". Выглядит вот так: https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=11617&stc=1&d=1771445347 Основана на STM32F303RBT6. На борту пять. . .	Камера Toupcam IUA500KMA Eddy_Em 12.02.2026 Т. к. у всяких "хикроботов" слишком уж мелкий пиксель, для подсмотра в ESPriF они вообще плохо годятся: уже 14 величину можно рассмотреть еле-еле лишь на экспозициях под 3 секунды (а то и больше),. . .
И ясному Солнцу zbw 12.02.2026 И ясному Солнцу, и светлой Луне. В мире покоя нет и люди не могут жить в тишине. А жить им немного лет.	«Знание-Сила» zbw 12.02.2026 «Знание-Сила» «Время-Деньги» «Деньги -Пуля»	SDL3 для Web (WebAssembly): Подключение Box2D v3, физика и отрисовка коллайдеров 8Observer8 12.02.2026 Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами и вызывать обработчики событий столкновения. . . .	SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL_LoadPNG (без SDL3_image) 8Observer8 11.02.2026 Содержание блога Библиотека SDL3 содержит встроенные инструменты для базовой работы с изображениями - без использования библиотеки SDL3_image. Пошагово создадим проект для загрузки изображения. . .

Скрипт 5472 / 1150 / 50 Регистрация: 15.09.2012 Сообщений: 3,576
	18.11.2012, 14:04
	vaxo55, если можно, то создайте аналогичную ситуацию в программе Excel, чтобы вам быстрее помогли, т.к. программа AutCad реже используется. 1

@vaxo55 7 / 7 / 1 Регистрация: 27.09.2012 Сообщений: 99
	18.11.2012, 16:57 [ТС]
	Novichek спосибо большое, но ведь в автокаде есть свой vba. Скрипт спосибо большое- на страницах imediate пробегают строка "дейсвие", но слой не переключается . подскажите пожалуйста куда прилепить строка чтоб слой "красный" перелючать 0

Как и можно ли использовать Timer

Решение