Sheet Darstellung abfragen, bzw. vorgeben (Dassault Systemes - PLM Solutions/CATIA V5 Programmierung) - Lösung vorhanden!

Hallo Nachbar,

...also

Mein Problem unter VBA war, dass die Routine selbst funktioniert hat, aber sich VBA nach dem Makro-Ablauf aufgehängt hat.

Ich hab's dann mit VB6 umgesetzt. Da geht's mir besser von der Hand.

Ergebnis (Source und .exe V1.06) anbei ->

Das Makro
- sucht zunächst Catia oder startet es
- frägt nach dem Verzeichnis mit den Zeichnungen
- liest die Zeichnungen ein
- setzt den Display-Flag, falls nötig
- speichert die Zeichnung im gliechen Verzeichnis
- schliesst die Zeichnung
- Ende

Ein Fenster zeigt den Verlauf an.

Für die Verzeichnisauswahl und die Arbeitsschleife hab ich das Makro
http://catia2.cad.de/index.php/de/downloads/skripts-app likationen/94-generierung-einer-pdf-datei-aus-einer-v5-zeichnung
kannibalisiert.

Nachfolgend der Quell-Code:

Modul:

Code:

Option Explicit
'sendmessage variants
'Public Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, wParam As Long, lParam As Any) As Long
'Public Declare Function SendMessageAny Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, wParam As Any, lParam As Any) As Long
Public Declare Function SendMessageByNum Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'Public Declare Function SendMessageString Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
'window functions
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Public Declare Function EnumChildWindows Lib "user32" (ByVal hwndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Public Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function SetActiveWindow Lib "user32" (ByVal hwnd As Long) As Long
'button
Public Const BM_CLICK = &HF5& 'button message: schickt ein 'klick' an das ausgewählte fenster
Public Const BM_GETCHECK = &HF0 'get option button state
Public Const BM_SETCHECK = &HF1 'set
Public Const BST_CHECKED = &H1    'checked
Public Const BST_INDETERMINATE = &H2    'greyed
Public Const BST_UNCHECKED = &H0    'unchecked
'dialog handles
Public hWndApply As Long    'handle zu catia 'apply'-button des dialoges
Public hWndOK As Long 'handle zu catia 'ok'-button des dialoges
Public hWndClose As Long    'handle zu catia 'close'-button des dialoges
Public hWndDlg As Long    'handle zum dialog-fenster
Public hWndDisplay As Long    'handle zum 'Display-Button - Sheet Dialog
Public CATIA As Application 'CATIA-Object
Sub EditDisplayProps()
   Dim lRet As Long
   CATIA.StartCommand "Properties"    'open the dialog window
   CATIA.RefreshDisplay = True    'give catia some time to react
   DoEvents
   hWndDlg = FindWindow(vbNullString, "Properties") 'get parent handle
   If hWndDlg = 0 Then    'no such window
MsgBox "Dialog not found!", vbOKOnly Or vbCritical, "CatMain"
Exit Sub
   End If
   EnumChildWindows hWndDlg, AddressOf EnumChildProc, ByVal 0&   'get children handles
   If hWndDisplay <> 0 Then
lRet = SendMessageByNum(hWndDisplay, BM_GETCHECK, 0&, 0&)
If lRet <> BST_CHECKED Then
   PushButton hWndDisplay 'select display
   CATIA.RefreshDisplay = True    'give catia some time to react
End If
   End If
   PushButton hWndOK    'send click message to OK dialog button
   CATIA.RefreshDisplay = True
End Sub

Public Function EnumChildProc(ByVal hwndChild As Long, ByVal lParam As Long) As Long
   Dim strBuff As String    'string buffer
   On Error GoTo EnumChildProc_Error
   strBuff = Space$(GetWindowTextLength(hwndChild) + 1) 'Get the windowtext length
   GetWindowText hwndChild, strBuff, Len(strBuff) 'get the window text
   strBuff = Left$(strBuff, Len(strBuff) - 1) 'remove the last Chr$(0)
   Select Case strBuff
Case "OK" 'look for OK-Button
   hWndOK = hwndChild 'assign to public handle
Case "Close"    'look for Close-Button
   hWndClose = hwndChild    'assign to public handle
Case "Apply"    'look for Apply-Button
   hWndApply = hwndChild    'assign to public handle
Case "Display"    'look for Apply-Button
   hWndDisplay = hwndChild    'assign to public handle
Case Else
   End Select
   EnumChildProc = 1    'continue enumeration
   Exit Function
   '---------------------------------------------------------------------------------------
EnumChildProc_Error:
   Dim errMsg As String
   Dim errRet As VbMsgBoxResult
   Select Case Err.Number
   '    Case 438
   '    Case -2147467259
Case Else
   errMsg = Err.Number & ": " & Err.Description & " in procedure EnumChildProc"
   errRet = MsgBox(errMsg, vbOKOnly, "EnumChildProc")
   End Select
   'Resume Next 'fall thru to quit sub
   '---------------------------------------------------------------------------------------
End Function
Public Sub PushButton(hwnd As Long) 'push catia button
   SetActiveWindow hWndDlg    'activate dialog
   SendMessageByNum hwnd, BM_CLICK, 0&, 0&    'send click message to dialog button
End Sub
Sub GetCatiaObject()
   On Error Resume Next 'Disable automatic error handling
   Set CATIA = GetObject(, "CATIA.Application")
   If (Err.Number <> 0) Then    'Manually handle all errors
MsgBox Err.Description & vbCrLf & "Is Catia running?" _
   & vbCrLf & "Trying to start Catia!" _
   , vbOKOnly Or vbInformation, "GetCatiaObject"
On Error GoTo 0 'Invalidates the Resume Next and clears the error
DoEvents
Set CATIA = CreateObject("CATIA.Application") 'try to start catia
Do    'wait for it
   If Not CATIA Is Nothing Then 'then it's something
Exit Do
   End If
   DoEvents
Loop
CATIA.Visible = True    'show the main window
   End If
   On Error GoTo 0    'Invalidates the Resume Next and clears the error
End Sub

und die Form:

Code:

Option Explicit
Private Sub Form_Load()
   Dim Targetfolder As String
   Dim FileSystemObject As Object
   Dim myFolder As Folder
   Dim myFiles As Files
   Dim myFile As File
   Dim myDocument As Document
   On Error GoTo Form_Load_Error
   Caption = App.EXEName & " V" & App.Major & "." & App.Minor & "." & App.Revision
   GetCatiaObject 'abgespecktes GetObject
   If CATIA Is Nothing Then 'this should not normally happen
Unload Me
Exit Sub
   End If
   SetControlPos    'position controls
   Show vbModeless
   DoEvents
   'Fehlermeldungen ausschalten'
   CATIA.DisplayFileAlerts = False
   'Verzeichnis abfragen
   Targetfolder = SelectFolder("Bitte wählen Sie das Verzeichnis aus.")
   If Targetfolder = "" Then
MsgBox "Kein Verzeichnis gewählt." & vbCrLf & "Das Makro wird beendet.", vbOKOnly Or vbCritical, "Abbruch"
GoTo QuitSub
   End If
   'Verzeichnis einlesen
   Set FileSystemObject = CreateObject("Scripting.FileSystemObject")
   Set myFolder = CATIA.FileSystem.GetFolder(Targetfolder)
   Set myFiles = myFolder.Files
   'Dateien nach CATDrawings durchsuchen und exportieren
   For Each myFile In myFiles
If Right(myFile.Name, 10) = "CATDrawing" Then
   Set myDocument = CATIA.Documents.Open(myFile.Path)
   SetDisplay
   myDocument.Save
   myDocument.Close

GetNextFile:
End If
   Next
   'Fehlermeldungen einschalten'
   CATIA.DisplayFileAlerts = True
QuitSub:
   Unload Me
   End
Exit Sub
'---------------------------------------------------------------------------------------
Form_Load_Error:
   Dim errMsg As String
   Dim errRet As VbMsgBoxResult
   Select Case Err.Number
'    Case 438
   Case -2147467259
   MsgBox "Kann Zeichnung nicht einlesen! Release?" & vbCrLf & vbCrLf & myFile.Name, vbOKOnly Or vbInformation, "Zeichnung einlesen"
   Resume GetNextFile
   Case Else
   errMsg = Err.Number & ": " & Err.Description _
   & IIf(Erl <> 0, " at line " & CStr(Erl), "") _
   & " in procedure Form_Load of Formular frmSetDisplayChkBx"
   errRet = MsgBox(errMsg, vbOKOnly, "Form_Load")
   End Select
   Resume QuitSub
'---------------------------------------------------------------------------------------
End Sub
Sub SetDisplay()
   Dim oSH As DrawingSheet
   Dim oSel As Selection
   Dim n As Integer
   Dim strShName As String
   Dim strDocName As String
   On Error GoTo SetDisplay_Error
   Set oSel = CATIA.ActiveDocument.Selection
   For Each oSH In CATIA.ActiveDocument.Sheets
oSel.Add oSH
strShName = oSH.Name
strDocName = CATIA.ActiveDocument.Name
lblMacroStatus.Caption = "Checking document: " & strDocName & vbCrLf & "Checking sheet: " & strShName
DoEvents
EditDisplayProps
DoEvents
oSel.Clear    'empty selection
   Next
   Exit Sub
   '---------------------------------------------------------------------------------------
SetDisplay_Error:
   Dim errMsg As String
   Dim errRet As VbMsgBoxResult
   Select Case Err.Number
   '    Case 438
   '    Case -2147467259
Case Else
   errMsg = Err.Number & ": " & Err.Description & " in procedure SetDisplay"
   errRet = MsgBox(errMsg, vbOKOnly, "SetDisplay")
   End Select
   'Resume Next 'fall thru to quit sub
   '---------------------------------------------------------------------------------------
End Sub
Function SelectFolder(strTextforSelection As String) As String
Dim shellApp As Object
Dim FolBrowser As Object

Set shellApp = CreateObject("Shell.Application") 'erzeuge ein neues Objekt "Shell Application"
Set FolBrowser = shellApp.BrowseForFolder(0, strTextforSelection, 16, 17)

If Not FolBrowser Is Nothing Then 'wenn nicht Abbrechen gedrÃŒckt oder aus sonstigen GrÃŒnden
'nichts im Objekt "FolBrowser" steht, dann...
SelectFolder = FolBrowser.Self.Path
End If

End Function
Sub SetControlPos()
   Dim l As Single
   Dim t As Single
   Dim w As Single
   Dim h As Single
   Dim s As Single
   s = 5
   l = s
   t = s
   w = ScaleWidth - 2 * s
   h = ScaleHeight - 2 * s
   lblMacroStatus.Move l, t, w, h
End Sub

Das Makro kann wie eine normale .exe durch Doppel-Klick oder per Eingabe am Cmd-Prompt gestartet werden.

Zum Einbinden in Catia ein Start-Makro(siehe unten) entweder wie hier

http://catia2.cad.de/index.php/de/tipps-tricks/programmierung/207-makro-p er-tastenkombination-starten

oder/und hier

[URL=http://catia2.cad.de/index.php/de/catia-faq/programmierung/73-makros-als-icons-ablegen]http://catia2.cad.de/index.php/de/catia-faq/programmierung/73-makros-als-icons-ablegen[/ URL]

verfahren.

Das Start-Makro für die .exe sieht so aus:

Code:

Private Const SW_SHOWNORMAL As Long = 1
Private Const SW_SHOWMAXIMIZED As Long = 3
Private Const SW_SHOWDEFAULT As Long = 10
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hwnd As Long, _
   ByVal lpOperation As String, _
   ByVal lpFile As String, _
   ByVal lpParameters As String, _
   ByVal lpDirectory As String, _
   ByVal nShowCmd As Long) As Long
Sub CATMain()
   ShellExecute 0, "open", _
"E:\Catia_Files\Makros\MyMacros\SetDisplaySheetPropertyPage.exe", _
"", ".", SW_SHOWNORMAL
End Sub

Der Pfad muss natürlich entsprechend angepasst werden.

Tschau,
Joe

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