---

Hallo liebe Community,

ich habe folgendes Problem:

Ich muss eine VBA-Makro schreiben welches im Hintergrund läuft. Sobald ich eine Bohrung erstelle wird überprüft ob die richtige Art von Bohrung eingesetzt wurde. Sollte es nicht der Fall sein wird ein Warnhinweis gegeben.
Ich weis wie man nach Bohrungen sucht:

Dim selection1 As Object
Set selection1 = CATIA.ActiveDocument.Selection
selection1.Search "CatPrtSearch.Hole,all"

Nur weis ich nicht wie ich VBA dazu kriege im Hintergrund zu laufen und nur dann einzugreifen wenn eine Bohrung nicht Regelkonform ist. Ich habe bereits einige Schleifen mit Do und DoEvents ausprobiert aber leider immer erfolglos  .

Ich bin auf eure freundliche Hilfe angewiesen.

Herzlichen Dank 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo cat,

bitte die Systeminfo ausfülllen, damit wir sehen womit Du arbeitest.

Hast Du's schon mit einem Timer probiert?

zB. alle 5s nachschauen, ob Bohrungen existieren.

Interessant wäre dabei, ob's möglich ist eine Bohrung als 'schon geprüft' zu taggen.
Das würde bei der Prüfung Zeit sparen. Birgt aber auch die Gefahr,
dass nachträglich geänderte Bohrungen überlesen werden.
Um das zu verhindern, müssten alle x Schleifen alle Bohrungen geprüft werden.

Hope it helps,
Joe

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo joehz,

vielen Dank für die schnelle Antwort.

Meine Systeminfo:
Window 7 64 bit
CATIA V5-6R2013
VB 6.5.1054

Ich werde mir dein Rat zu Herzen nehmen. Für weitere Infos währe ich dankbar.

Nochmals vielen Dank 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo cat,

soweit ich weiss, giibt's bei VBA keinen Timer-Control.

Stattdessen kann man aber die API nehmen.

Kopier folgendes in ein neues Modul mit Namen 'modTimer':

Code:

---

Option Explicit

Public Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type

Public Type SYSTEMTIME
  wYear As Integer
  wMonth As Integer
  wDayOfWeek As Integer
  wDay As Integer
  wHour As Integer
  wMinute As Integer
  wSecond As Integer
  wMilliseconds As Integer
End Type

Public Type TIME_ZONE_INFORMATION
  Bias As Long
  StandardName(32) As Integer
  StandardDate As SYSTEMTIME
  StandardBias As Long
  DaylightName(32) As Integer
  DaylightDate As SYSTEMTIME
  DaylightBias As Long
End Type

Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long

Public Declare Function EnumCalendarInfo Lib "kernel32" Alias "EnumCalendarInfoA" (ByVal lpCalInfoEnumProc As Long, ByVal Locale As Long, ByVal Calendar As Long, ByVal CalType As Long) As Long
Public Declare Function EnumDateFormats Lib "kernel32" (ByVal lpDateFmtEnumProc As Long, ByVal Locale As Long, ByVal dwFlags As Long) As Long
Public Declare Function EnumTimeFormats Lib "kernel32" (ByVal lpTimeFmtEnumProc As Long, ByVal Locale As Long, ByVal dwFlags As Long) As Long
Public Declare Sub GetLocalTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
Public Declare Function GetMessageTime Lib "user32" () As Long
Public Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
Public Declare Function GetSystemTimeAdjustment Lib "kernel32" (lpTimeAdjustment As Long, lpTimeIncrement As Long, lpTimeAdjustmentDisabled As Long) As Long
Public Declare Function GetTickCount Lib "kernel32" () As Long
Public Declare Function GetTimeFormat Lib "kernel32" Alias "GetTimeFormatA" (ByVal Locale As Long, ByVal dwFlags As Long, lpTime As SYSTEMTIME, ByVal lpFormat As String, ByVal lpTimeStr As String, ByVal cchTime As Long) As Long
Public Declare Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
Public Declare Sub SetLastError Lib "kernel32" (ByVal dwErrCode As Long)
Public Declare Function SetLocalTime Lib "kernel32" (lpSystemTime As SYSTEMTIME) As Long
Public Declare Function SetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME) As Long
Public Declare Function SetSystemTimeAdjustment Lib "kernel32" (ByVal dwTimeAdjustment As Long, ByVal bTimeAdjustmentDisabled As Boolean) As Long
Public Declare Function SetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
Public Declare Function SystemTimeToTzSpecificLocalTime Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION, lpUniversalTime As SYSTEMTIME, lpLocalTime As SYSTEMTIME) As Long

Public Const WM_TIMER = &H113

Public Const ID_TIMER1 = 1
Public Const ID_TIMER2 = 2
Public Const ID_TIMER3 = 3
Public Const ID_TIMER4 = 4
Public Const ID_TIMER5 = 5
Public Const ID_TIMER6 = 6
Public Const ID_TIMER7 = 7
Public Const ID_TIMER8 = 8
Public Const ID_TIMER9 = 9
Public Const ID_TIMER10 = 10

Public iTimer As Integer
Public Const lDelay As Long = 5000

Public Function TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal iTimerID As Long, ByVal dwTime As Long) As Long
  KillTimer 0&, iTimer
  Debug.Print Time    'do stuff
 
End Function

Sub TimerTest()
  Debug.Print Time
  iTimer = SetTimer(0&, 0&, lDelay, AddressOf TimerProc)        'start timer
End Sub

---

Wenn Du das hast, starte bitte TimerTest.
Du solltest danach im Immediate Window zwei Uhrzeiten sehen mit 5 Sekunden Differenz.

Die 'Debug.Prints' dienen nur zur Kontrolle.

Nach Ablauf der Zeitspanne tritt in der TimerProc ein Ereignis (WM_TIMER) auf,
auf das Du mit Deiner Prüfroutine reagieren kannst.

Vor Du die Prüfung beginnst, den Timer stoppen, danach wieder anwerfen.

Wenn das Makro endet _immer_ den Timer killen, sonst gibt's einen Crash.

Unter Suche 'VBA SetTimer' findest im INet noch so einiges zum Thema.

Have fun,
Joe

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo joehz,

nochmals Danke für die schnelle Antwort. Ich versuche es mit Call TimerTest nur da tut sich leider nichts. Hab ich dich falsch verstanden? Oder ist das komplett falsch?

Grüße 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo zusammen,

VBA läuft im Thread von CATIA. Wenn du hier etwas machen willst, wird CATIA auf das Makro warten. Das kannst du eigentlich nur mit .Net abhandeln und da dürfte ein Watcher zu viel Performance fressen.

------------------
MFG
Rick Schulz

Nettiquette (CAD.de)  -  Was ist die Systeminfo?  -  Wie man Fragen richtig stellt.  -  Unities

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Zusammen,

hier ist ein downloadlink: http://www.herber.de/bbs/user/60469.xls

Diese Exeldatei beinhaltet ein Makro. Mit der F12 Taste wird ein Timer gestartet und gestopt. Könnte man diesen Timer nicht meine Bedürfnissen anpassen?

Grüße 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

ja, schon.
Gemeint war das Caret in die Routine TimerTest hinein zu stellen und F5 drücken.

Ich hab's umgebaut.

Code:

---

Public Function TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal iTimerID As Long, ByVal dwTime As Long) As Long
  KillTimer 0&, iTimer
  ListBodies            '<-- neu
  Debug.Print Time    'do stuff
 
End Function

Sub CATMain()            '<-- neu
  Debug.Print Time
  iTimer = SetTimer(0&, 0&, lDelay, AddressOf TimerProc)        'start timer
End Sub

Sub ListBodies()        '<--- neu
  Dim oADP As Part
  Dim oBd As Body
  Dim oSel As Selection
  Dim txtTemp As String
 
  Set oADP = CATIA.ActiveDocument.Part
  Set oSel = CATIA.ActiveDocument.Selection
  oSel.Search "CATPrtSearch.BodyFeature,all"

  For Each oBd In oADP.Bodies
      txtTemp = txtTemp & oBd.Name & vbCr
  Next
 
  oSel.Clear
 
  MsgBox txtTemp
 
End Sub

---

Zum austesten ein CatPart mit ein paar Bodies laden und über

'Tools/Macro/Macros.../modTimer'

das Makro ausführen.

Nach 5 Sekunden sucht die Routine alle Bodies und gibt ihre Name in einer MsgBox aus.

Nicht - ich wiederhole - NICHT! - das Programm dadurch erweitern indem Du einfach wieder den Timer wieder anwerfst.
Nicht solange Du nicht weisst, wie Du wieder aus der Schleife rauskommst.

Gewöhnlich würd ich für sowas einen kleinen Dialog vorsehen - mit Start und Stop.

Das soll erstmal reichen.

Tschau,
Joe

PS: Setzt auch mal die Zeit (lDelay) hoch, um zu sehen,
ob das Makro Dein Catia blockiert.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi cat,

'OnKey' versteht die Catia nicht.

Aber:
- 'Tools/Customize/Commands'->Macros->modTimer auswählen
- über 'Show Properties' ein Icon zuweisen
- 'Tools/Customize/Toolbars/New entweder eine neue Toolbar anlegen und über
   'Add' das Makro der Toolbar zuweisen oder gleich über 'Add' einer vorhandenen Toolbar zuweisen.
- wieder in 'Tools/Customize/Commands/Show Properties' kannst jetzt noch eine Tastenkombi angeben.

Allerdings reicht das nur um den Timer zu starten.
Wie stoppen, weiss ich jetzt auch noch nicht.

Interessant wird sein zu sehen, was passiert wenn Du ohne das Makro zu stoppen aus Catia aussteigst.

Tschau,
Joe

[Diese Nachricht wurde von joehz am 17. Jun. 2015 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi joe,

super es hat geklappt. Ich danke für die Geduld und für die Zeit. Wo hast du die Zeit mit 5 sekunden eingestellt? Was ist das Idelay und wie kann ich den Wert von Idelay ändern.

Nochmals Danke 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

lass VB danach suchen! (stell das Caret drauf und drück Shift-F2 oder eben mit F3 nach lDelay suchen)

Es wird Zeit, dass Du Dich mit Deiner Arbeitsumgebung befasst!

lDelay ist eine globale Variable.
Der Wert gibt den Zeitintervall in ms an zwischen zwei WM_TIMER-Events an.

Den Wert änderst indem Du ihn änderst ;-)

Tschau,
Joe

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo cat,

ich hab noch 'n Bißchen mit dem Gedanken gespielt.
Wenn man einen Wert für 'An/Aus' abspeichert, zB in der Registry(oder dem Environment),
dann geht's ganz leicht.

Ersetze die bisherigen Routinen(nicht die globalen Deklarationen!) mit nachstehendem Code:

Code:

---

Public Function TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal iTimerID As Long, ByVal dwTime As Long) As Long
  Static lCounter As Long                                          'just for fun, count the loops
 
  KillTimer 0&, iTimer                                              'stop timer
 
  CATIA.StatusBar = "Timer stopped"                                'send message
  ListBodies                                                        'do stuff
  lCounter = lCounter + 1                                          'start with 1
  Debug.Print lCounter                                              'print num of loops
 
  StartTimer                                                        'restart timer
 
End Function

Sub CATMain()
  Dim iDummy As Integer
 
  'if the timer is already running on reentry, then stop the script
  iDummy = GetSetting("TimerTest", "StartStop", "OnOff", 0)        'get timer setting
  If iDummy <> 0 Then                                              'if timer is already running
      KillTimer 0&, iDummy                                          'stop timer
      CATIA.StatusBar = "Timer stopped"                              'send message
      SaveSetting "TimerTest", "StartStop", "OnOff", 0              'set setting to off
      Exit Sub                                                      'quit
  End If
 
  StartTimer                                                        'start the timer

End Sub

Sub StartTimer()
 
  iTimer = SetTimer(0&, 0&, lDelay, AddressOf TimerProc)            'start timer
 
  If iTimer <> 0 Then                                              'is there a timer
      SaveSetting "TimerTest", "StartStop", "OnOff", iTimer          'save setting
      CATIA.StatusBar = "Timer started"
  Else                                                              'if no timer exists
      MsgBox "Couldn't create timer. Exiting...", _
        vbOKOnly Or vbCritical, "TimerTest_CatMain"                'send message
      'since the timerproc hasn't been initialized, the calling sub simply ends stopping the macro
  End If
 
End Sub

Sub ListBodies()
  Dim oADP As Part
  Dim oBd As Body
  Dim oSel As Selection
  Dim txtTemp As String
 
  Set oADP = CATIA.ActiveDocument.Part
  Set oSel = CATIA.ActiveDocument.Selection
  oSel.Search "CATPrtSearch.BodyFeature,all"

  For Each oBd In oADP.Bodies
      txtTemp = txtTemp & oBd.Name & vbCr
  Next
 
  oSel.Clear
  Debug.Print txtTemp
'  MsgBox txtTemp
End Sub

---

Starten über die gewählte Tastenkombi oder Icon; stoppen auch.

Enjoy,
Joe

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo joehz,

unglaublich es funktioniert. Ich weis nicht wie ich mich bedanken soll. Bist echt ein Segen für mich.

Thanks so much 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Tja, so bin ich halt. 8-)

Üblicherweise vergibt man, wenn's denn geholfen hat, ein paar Unities ;-)

Wenn Du ausserdem noch ein grünes Häckchen - für 'gelöst/erledigt' - setzt,
wär's perfekt. (das hab ich jetzt mal gemacht)

Tschau,
Joe

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Vielen Dank für die Info.

Hab so viele abgegeben wie ich konnte.

Thanks a lot 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi cat,

und vielen Dank dafür.

Etwas ist mir in der Nachbetrachtung noch aufgefallen:

Das Makro wird nicht wirklich beendet.

So wie's oben dasteht, bleibt das Makro bis zum Beenden von Catia selbst im Speicher.
Beweis: Der Schleifenzähler in der TimerProc fängt nicht jedesmal bei '1' an, sondern zählt munter immer weiter hoch.

Um das Makro zu beenden müsste die Exit Sub - Anweisung in CatMain durch ein 'End' ersetzt werden.

Also:

Code:

---

Sub CATMain()
   Dim iDummy As Integer
  
   'if the timer is already running on reentry, then stop the script
   iDummy = GetSetting("TimerTest", "StartStop", "OnOff", 0)         'get timer setting
   If iDummy <> 0 Then                                               'if timer is already running
      KillTimer 0&, iDummy                                           'stop timer
      CATIA.StatusBar = "Timer stopped"                              'send message
      SaveSetting "TimerTest", "StartStop", "OnOff", 0               'set setting to off
      End                                                        'stop the macro
   End If
  
   StartTimer                                                        'start the timer

End Sub

---

In VB ist 'End' gewöhnlich verpönt; es wird meistens ein 'Unload' bevorzugt.
Hier geht's aber nicht anders.

Have a nice one,
Joe

PS: Interessant ist auch, dass das Makro über die Tastenkombi auch dann startet, wenn das Icon/die Toolbar nicht sichtbar ist.

[Diese Nachricht wurde von joehz am 19. Jun. 2015 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi joehz,

danke hab es eingefügt.

Bis bald 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP