Code:
Imports DRAFTINGITF
Imports SmApplic
Imports SmarTeam
Imports INFITFModule Functions
Private CATIA As Application 'CATIA-Application / alternativ: As Object
Private ActiveDrawing As DrawingDocument
Private DrwShts As DrawingSheets
Private ActiveDrwSht As DrawingSheet
Private ActiveDrwView As DrawingView
Private SmarTeamIntern As SmApplication
Private SmEngineIntern As ISmEngine
Private SmSessionIntern As ISmSession
Private FormLanguage As String = "German"
Public Function ReadValues_TDM() As Boolean
'''''''''''''''''Für dein Problemfall, ist das hier die Hauptroutine!'''''''''''''''''
'''''' Der Rest ist nur dafür da, dass der Code theoretisch funktioniert würde! ''''''
'-------------------------------------------------------------------------------
' Read Values from SmarTeam Datastore
'-------------------------------------------------------------------------------
Dim SmQuery As ISmQuery
Dim SmQueryDef As ISmQueryDefinition
Dim WorkObject As ISmObject
Dim tmpState As String
Dim tmpArtNrNew As String
Dim tmpName As String
Dim tmpProp As String
Dim RetCode As Boolean
Try
'initialisiere SmarTeam & CATIA
RetCode = Initialize_System()
'Prüfe ob die Applikationen geöffnet sind. Wenn ja fahre fort...
If Retcode = True then
'Erzeuge neues Query für die Suche
SmQuery = SmSessionIntern.ObjectStore.NewQuery
'Definiert den zu lesenden Datensatz und die Felder innerhalb der Datenbank. Diese sind über die Datenbank in Erfahrung zu bringen!
SmQueryDef = SmQuery.QueryDefinition
'Definiert die Klasse in der gesucht werden soll
SmQueryDef.Roles.Add(SmSessionIntern.MetaInfo.SmClassByName("CATIA Drawing").ClassId, "F")
'Definiert die Suchparameter nach denen der Datensatz definiert wird
SmQueryDef.Where.Add("", "DIRECTORY", "like", ActiveDrawing.Path & "%", False, "F")
SmQueryDef.Where.Add("", "FILE_NAME", "=", ActiveDrawing.Name, False, "F")
SmQueryDef.Where.Add("", "USER_OBJECT_ID", "=", SmSessionIntern.UserMetaInfo.UserId, False, "F")
'Definiert die Felder, die zurück gegeben werden sollen
SmQueryDef.Select.Add("CN_DESCRIPTION", "F", False)
SmQueryDef.Select.Add("CN_ARTICLENUMBER", "F", False)
SmQueryDef.Select.Add("CN_VERSION", "F", False)
SmQueryDef.Select.Add("CN_INDEX", "F", False)
SmQueryDef.Select.Add("CN_ARTIKELNAME", "F", False)
SmQueryDef.Select.Add("CN_ABMESSUNGEN", "F", False)
SmQueryDef.Select.Add("CN_ARTICLENAME", "F", False)
SmQueryDef.Select.Add("CN_PROPERTIES", "F", False)
SmQueryDef.Select.Add("STATE", "F", False)
'Führt die Suche aus
SmQuery.Run()
'Prüfe ob ein Datensatz gefunden wurde. Wenn einer gefunden wurde, fahre fort.
If SmQuery.QueryResult.RecordCount = 1 Then
'Übergibt den Datensatz
WorkObject = SmSessionIntern.ObjectStore.ObjectFromData(SmQuery.QueryResult.GetRecord(0), True)
'Schließt das Query. Wichtig! Alle Querys und Objekte müssen abgeschlossen und beendet werden.
SmQuery.Close()
'übergibt Parameter
tmpState = WorkObject.Value("STATE")
tmpArtNrNew = WorkObject.Value("CN_ARTICLENUMBER")
Msgbox(tmpArtNrNew)
Msgbox(WorkObject.Value("CN_VERSION"))
Msgbox(WorkObject.Value("CN_INDEX"))
tmpName = WorkObject.Value("CN_ARTIKELNAME")
tmpName.Trim()
tmpProp = WorkObject.Value("CN_ABMESSUNGEN")
tmpProp.Trim()
If tmpProp <> "" Then
Msgbox(tmpName.PadRight(25) & tmpProp)
Else
Msgbox(tmpName)
End If
tmpName = WorkObject.Value("CN_ARTICLENAME")
tmpProp = WorkObject.Value("CN_PROPERTIES")
If tmpProp <> "" Then
Msgbox(tmpName.PadRight(25) & tmpProp)
Else
Msgbox(tmpName)
End If
Return True
Else
MsgBox(GetText_Functions("ReadValues_TDM_MSG", FormLanguage), MsgBoxStyle.Information, GetText_Functions("ReadValues_TDM_MSG_Caption", FormLanguage))
Return False
End If
end if
Catch ex As Exception
MsgBox(ex.ToString, MsgBoxStyle.Critical, "Error in Modul ReadValues_TDM")
Application.DoEvents()
Return False
End Try
End Function
Public Function Initialize_System() As Boolean
'-------------------------------------------------------------------------------
' initialize active Document and Session
'-------------------------------------------------------------------------------
Dim i As Integer
Dim AppCount As Integer
On Error Resume Next
'Get Language
FormLanguage = GetLanguage()
'Get CATIA-Application
AppCount = Process.GetProcessesByName("CNEXT").Length
If AppCount > 1 Then
MsgBox(GetText_Functions("Initialize_System_MSG01", FormLanguage), MsgBoxStyle.Critical, GetText_Functions("Initialize_System_MSG01_Caption", FormLanguage))
Return False
ElseIf AppCount = 0 Then
MsgBox(GetText_Functions("Initialize_System_MSG02", FormLanguage), MsgBoxStyle.Critical, GetText_Functions("Initialize_System_MSG02_Caption", FormLanguage))
Return False
Else
CATIA = GetObject(, "CATIA.Application")
If Err.Number <> 0 Then
MsgBox(GetText_Functions("Initialize_System_MSG03", FormLanguage), MsgBoxStyle.Critical, GetText_Functions("Initialize_System_MSG03_Caption", FormLanguage))
Err.Number = 9999
Err.Clear()
Return False
End If
End If
'Get active Drawing
ActiveDrawing = CATIA.ActiveDocument
If Err.Number <> 0 Then
MsgBox(GetText_Functions("Initialize_System_MSG04", FormLanguage), MsgBoxStyle.Critical, GetText_Functions("Initialize_System_MSG04_Caption", FormLanguage))
Err.Number = 9999
Err.Clear()
Return False
End If
'Get Sheets
DrwShts = ActiveDrawing.Sheets
If Err.Number <> 0 Then
MsgBox(GetText_Functions("Initialize_System_MSG05", FormLanguage), MsgBoxStyle.Critical, GetText_Functions("Initialize_System_MSG05_Caption", FormLanguage))
Err.Number = 9999
Err.Clear()
Return False
End If
'Get active Sheet
ActiveDrwSht = DrwShts.ActiveSheet
ActiveDrwView = ActiveDrwSht.Views.ActiveView
If Err.Number <> 0 Then
MsgBox(GetText_Functions("Initialize_System_MSG06", FormLanguage), MsgBoxStyle.Critical, GetText_Functions("Initialize_System_MSG06_Caption", FormLanguage))
Err.Number = 9999
Err.Clear()
Return False
End If
'Get SmarTeam-Application
SmarTeamIntern = GetObject(, "SmarTeam.SmApplication")
If Err.Number <> 0 Then
MsgBox(GetText_Functions("Initialize_System_MSG07", FormLanguage), MsgBoxStyle.Information)
frmMain.cmdActualize.Enabled = False
TDMActive = False
Err.Number = 9999
Err.Clear()
Return True
End If
'Get active SmarTeam Engine
SmEngineIntern = SmarTeamIntern.Engine
If Err.Number <> 0 Then
MsgBox(GetText_Functions("Initialize_System_MSG07", FormLanguage), MsgBoxStyle.Information)
frmMain.cmdActualize.Enabled = False
TDMActive = False
Err.Number = 9999
Err.Clear()
Return True
End If
'Get active SmarTeam/CATIA-Session
For i = 0 To SmEngineIntern.SessionsCount - 1
If SmEngineIntern.Sessions(i).ApplicationName = "CATIA" Then
SmSessionIntern = SmEngineIntern.Sessions(i)
End If
Next
If Err.Number <> 0 Or IsNothing(SmSessionIntern) Then
MsgBox(GetText_Functions("Initialize_System_MSG07", FormLanguage), MsgBoxStyle.Information)
frmMain.cmdActualize.Enabled = False
TDMActive = False
Err.Number = 9999
Err.Clear()
Return True
End If
Err.Clear()
TDMActive = True
Return True
End Function
Public Function GetText_Functions(ByVal TextName As String, ByVal Language As String) As String
'-------------------------------------------------------------------------------
' language depended texts for Modul Functions
'-------------------------------------------------------------------------------
' Language: German, Else=English
'-------------------------------------------------------------------------------
Try
Select Case TextName
Case "ReadValues_TDM_MSG"
Select Case Language
Case "German"
Return "Die Zeichnung muss dem Smarteam bekannt und ausgecheckt sein, damit die Daten aus der Datenbank gelesen werden können." & _
"Die Felder können nicht aktualisiert werden."""
Case Else
Return "The Drawing should be known in SmarTeam with state ""checked out"" for getting dataset from SmarTeam for active file."
End Select
Case "ReadValues_TDM_MSG_Caption"
Select Case Language
Case "German"
Return "Die Datei ist nicht ausgecheckt oder dem SmarTeam nicht bekannt..."
Case Else
Return "The file is not checked out or not known in SmarTeam..."
End Select
Case "Initialize_System_MSG01"
Select Case Language
Case "German"
Return "Es wurden mehrere CATIA Instanzen gefunden." & vbLf & _
"Die Verarbeitung wird abgebrochen."
Case Else
Return "There are more then one instances of CATIA opened." & vbLf & _
"The processing will be canceled."
End Select
Case "Initialize_System_MSG01_Caption"
Select Case Language
Case "German"
Return "Es darf nur ein CATIA geöffnet sein!"
Case Else
Return "Only one CATIA should be opened!"
End Select
Case "Initialize_System_MSG02"
Select Case Language
Case "German"
Return "Es ist kein CATIA geöffnet." & vbLf & _
"Die Verarbeitung wird abgebrochen."
Case Else
Return "There is no CATIA opened." & vbLf & _
"The processing will be canceled."
End Select
Case "Initialize_System_MSG02_Caption"
Select Case Language
Case "German"
Return "CATIA steht nicht zur Verfügung!"
Case Else
Return "No CATIA available!"
End Select
Case "Initialize_System_MSG03"
Select Case Language
Case "German"
Return "CATIA reagiert nicht." & vbLf & _
"Die Verarbeitung wird abgebrochen."
Case Else
Return "The Application hangs." & vbLf & _
"The processing will be canceled."
End Select
Case "Initialize_System_MSG03_Caption"
Select Case Language
Case "German"
Return "CATIA steht nicht zur Verfügung!"
Case Else
Return "No CATIA available!"
End Select
Case "Initialize_System_MSG04"
Select Case Language
Case "German"
Return "Es ist keine Drawing verfügbar. Es muss eine Drawing aktiviert sein." & vbLf & _
"Die Verarbeitung wird abgebrochen."
Case Else
Return "There is no active drawing document. A CATDrawing should be active." & vbLf & _
"The processing will be cancelt."
End Select
Case "Initialize_System_MSG04_Caption"
Select Case Language
Case "German"
Return "Es steht keine Zeichnung zur Verfügung!"
Case Else
Return "There is no active drawing document."
End Select
Case "Initialize_System_MSG05"
Select Case Language
Case "German"
Return "Das aktive Dokument enthält keine Zeichnungsblätter." & vbLf & _
"Die Verarbeitung wird abgebrochen."
Case Else
Return "Active document is not in propper state." & vbLf & _
"The processing will be cancelt."
End Select
Case "Initialize_System_MSG05_Caption"
Select Case Language
Case "German"
Return "Es steht kein Blatt zur Verfügung!"
Case Else
Return "There are no sheets available!"
End Select
Case "Initialize_System_MSG06"
Select Case Language
Case "German"
Return "Das aktive Dokument enthält keine passenden Blätter." & vbLf & _
"Die Verarbeitung wird abgebrochen."
Case Else
Return "Active document is not in propper state. No suitable sheet found." & vbLf & _
"The processing will be canceled."
End Select
Case "Initialize_System_MSG06_Caption"
Select Case Language
Case "German"
Return "Das aktive Dokument ist fehlerhaft."
Case Else
Return "The active document is faulty."
End Select
Case "Initialize_System_MSG07"
Select Case Language
Case "German"
Return "CATIA ist entweder nicht mit SmarTeam verbunden oder SmarTeam ist nicht erreichbar." & vbLf & _
"Die Verarbeitung wird ohne Smarteam fortgeführt. Dabei können die Inhalte des Zeichnungskopfes nur manuell aktualisiert werden."
Case Else
Return "CATIA is not connected to the SmarTeam-Integration or the Application hangs." & vbLf & _
"The Macro continues without using SmarTeam functionalities . The Data could only be actualized manually."
End Select
Case Else
Return "not defined"
End Select
Catch ex As Exception
MsgBox(ex.ToString, MsgBoxStyle.Critical, "Error in Modul GetText_Functions")
Application.DoEvents()
Return "error"
End Try
End Function
Public Function GetLanguage() As String
Dim strLanguage As String
Try
strLanguage = GetLanguage_Registry()
If strLanguage = "none" Then
strLanguage = GetLanguage_OS()
End If
Return strLanguage
Catch ex As Exception
MsgBox(ex.ToString, MsgBoxStyle.Critical, "Error in Modul GetLanguage")
Application.DoEvents()
Return "English"
End Try
End Function
Public Function GetLanguage_Registry() As String
Dim strLanguage As String
Try
strLanguage = My.Computer.Registry.GetValue("HKEY_CURRENT_USER\Software\CAD\CAD-Macros", "All_Language", "none")
If strLanguage = "none" Then
strLanguage = My.Computer.Registry.GetValue("HKEY_CURRENT_USER\Software\CAD\CAD-Macros", "TitleBlock_Language", "none")
End If
Return strLanguage
Catch ex As Exception
MsgBox(ex.ToString, MsgBoxStyle.Critical, "Error in Modul GetLanguage_Registry")
Application.DoEvents()
Return "English"
End Try
End Function
Public Function GetLanguage_OS() As String
Dim strLanguage As String
Dim strOSLanguage As String
Try
strOSLanguage = System.Globalization.CultureInfo.CurrentCulture.ToString
If strOSLanguage = "de-DE" Then
strLanguage = "German"
Else
strLanguage = "English"
End If
Return strLanguage
Catch ex As Exception
MsgBox(ex.ToString, MsgBoxStyle.Critical, "Error in Modul GetLanguage_OS")
Application.DoEvents()
Return "English"
End Try
End Function
End Module