С наступающим Новым годом! Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 5.00/12: Рейтинг темы: голосов - 12, средняя оценка - 5.00
vaxo55
0 / 0 / 0
Регистрация: 27.09.2012
Сообщений: 44
1

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

18.11.2012, 11:50. Просмотров 2331. Ответов 9
Метки нет (Все метки)

на этом примере в 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
спасибо заранее
0
Лучшие ответы (1)
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
18.11.2012, 11:50
Ответы с готовыми решениями:

Как можно сделать чтобы не использовать лист ITOG а при копировании нового листа итоги?
Доброго дня или вечера Я извиняюсь за свой визит, но у меня вот какая...

Можно ли использовать макрос без книги?
В макросе прописан скрип открывающий определенную книгу и поверх книги форму ,...

Можно ли использовать CУММЕСЛИ() с несколькими условиями?
Подскажите, можно ли использовать функцию CУММЕСЛИ() с несколькими условиями ?...

Можно ли использовать формулы Excel в коде VBA?
можно ли использовать формулы Excel в коде VBA? например есть такой ...

Можно ли использовать SQL внутри Exel файла?
Можно ли использовать SQL в макросе Exel для выборки данных из листа того же...

9
Скрипт
5446 / 1127 / 49
Регистрация: 15.09.2012
Сообщений: 3,420
18.11.2012, 14:04 2
vaxo55, если можно, то создайте аналогичную ситуацию в программе Excel, чтобы вам быстрее помогли, т.к. программа AutCad реже используется.
1
vaxo55
0 / 0 / 0
Регистрация: 27.09.2012
Сообщений: 44
18.11.2012, 14:21  [ТС] 3
способо Скрипт за отзыв
по моему никакого значения не имеет, если вместо

Visual Basic
1
2
Set layerObj = ThisDrawing.Layers.Add("красный")
  ' включим слой "("красный")  layerObj.LayerOn = True
поставим любую команду
0
Novichek =)
536 / 27 / 4
Регистрация: 25.04.2011
Сообщений: 238
18.11.2012, 15:15 4
Лучший ответ Сообщение было отмечено как решение

Решение

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), пока в процессе поиска.
2
Novichek =)
536 / 27 / 4
Регистрация: 25.04.2011
Сообщений: 238
18.11.2012, 16:15 5
Цитата Сообщение от 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 секунд слой "красный" включается и выключается.
1
Миниатюры
Как и можно ли использовать Timer  
Скрипт
5446 / 1127 / 49
Регистрация: 15.09.2012
Сообщений: 3,420
18.11.2012, 16:37 6
Я так понял, что в 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 дней.
2
vaxo55
0 / 0 / 0
Регистрация: 27.09.2012
Сообщений: 44
18.11.2012, 16:57  [ТС] 7
Novichek спосибо большое, но ведь в автокаде есть свой vba.
Скрипт спосибо большое- на страницах imediate пробегают строка "дейсвие", но слой не переключается .
подскажите пожалуйста куда прилепить строка чтоб слой "красный" перелючать
0
Скрипт
5446 / 1127 / 49
Регистрация: 15.09.2012
Сообщений: 3,420
18.11.2012, 17:15 8
Цитата Сообщение от vaxo55 Посмотреть сообщение
подскажите пожалуйста куда прилепить строка чтоб слой "красный" перелючать
Если можно, то создайте аналогичную ситуацию в программе Excel, чтобы вам быстрее помогли, т.к. программа AutCad реже используется.
1
Novichek =)
536 / 27 / 4
Регистрация: 25.04.2011
Сообщений: 238
19.11.2012, 12:02 9
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
Но работать при этом с автокадом невозможно, может быть еще что-то можно сделать.
0
Скрипт
5446 / 1127 / 49
Регистрация: 15.09.2012
Сообщений: 3,420
19.11.2012, 20:45 10
Ещё инструмент для выполнения команд кода через заданное время:
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
1
19.11.2012, 20:45
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
19.11.2012, 20:45

Можно ли использовать вложенные инструкции On error, которые ведут на разные метки
Подскажите, можно ли использовать вложенные инструкции On error, которые ведут...

ООП в VBA: Можно ли использовать методы класса внутри его самого
Интересует: является ли это хорошим стилем программирования, или это приведет к...

Как использовать куки, чтобы потом было можно их использовать в запросах
Скажите полажуйста! как добавить ! куки , чтобы потом было можно использовать в...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
10
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru