'--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'-------------------------------------------------Zeichnungslinks erstellen------------------------------------------------------------------------------------------------------
'Author:           Daniel Frauenrath
'Department:   L/B2/EK-IN
'Phone:           +49 841 881-2363
'Mail:               daniel.frauenrath@contiautomotive.com
'Release:        08.05.2008
'
'*************************************************************************************************************************************************************************
'<<<<<<<<<<<<<<<<Beschreibung / Discription>>>>>>>>>>>>>>>>>>>>
'**************************************************************************************************************************************************************************
'
'DE: Das Makro verknuepft eine Zeichnung (die mit Neu aus erzeugt wurde) mit einem Part oder Produkt. Dies geschieht
'      unabhaengig von der UUID und der Fileextension des urspruenglich auf die Zeichnung verknuepften Models.
'      Es ist jedoch unbedingt darauf zu achten das sich das urspruenglich auf die Zeichnung verlinkte Model exakt
'      an der gleichen Position (im Raum) befindet wie das neue Model, da es sonst zu fehlerhaften Projektionen der Views
'      fuehrt.
'      Des weiteren gehen jegliche Bezuege der Dimensions verloren. Diese muessen im Anschluss durch die Re-route
'      Funktion neu generiert werden
'
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'
'EN: The macro link a drawing (which was generated with new from) with a Part or a Product. This is done
'       regardless of the UUID and the file extension of the originally model linked to the drawing.
'       However, it is essential to ensure that the originally model linked to the drawing exactly
'       at the same location (in space) is how the new model, otherwise it leads to wrong projections of the Views.
'       In addition to any remuneration of Dimensions lost. Subsequent they must be approved by the Re-route function
'
'************************************************************************************************************************************************

'**********************************Definition globale Variablen**********************************

Private ErrorCode As Integer
Private oldPfadRaw As String
Private oldNameRaw As String
Private oldName As String
Private nDrawing As String
Private sTmpPath As String
Private DocumentSeperator
Private DrawingPath As String
Private SemiDrawing As Document
Private SemiPart As Document
Public HelpPath as String

'****************************************************************************************************************************************************
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<Hauptmakro>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'****************************************************************************************************************************************************

Sub CATMain()

'**********************************Definition der Hilfedatei**********************************

Name = "HELP_ZEICHNUNGSLINK_MAKRO.HLP"
Path = "D:\Catia Files\Macros\Zeichnungslinks\"

HelpPath = Path & Name

'**********************************Nullsetzen aller globalen Variablen**********************************

  	ErrorCode = 0
  	DocumentSeperator = 0
	DocSepFin = False

'**********************************Disclaimer**********************************

 	 Dim M1, M2, M3, M4, M5, M6, M7, M8, M9, M10, Titel, Skin

  	M1 = "==>Dieses Makro erstellt neue (UUID und Fileextension unabhaengige) Zeichnungslinks <=="
  	M2 = "Der Autor sprich sich von jeglicher Haftung frei!"
  	M3 = "Dieses Makro wurde nur zu Testzwecken entwickelt. Fuer jegliche andere Art von Nutzung ist ausschließlich der Anwender haftbar."
  	M4 = "Das Makro unterliegt keinen gesetzlichen Richtlinien. Es kann vervielfaelltigt, geaendert und verkauft werden."
 	M5 = "<<<<<<<<<<<<Mit dem klick auf den OK Button bestaetigt der Anwender die oben genannten Bedingungen>>>>>>>>>>>>"
	M6 = "Autor:     Daniel Frauenrath"
	M7 = "Firma:     Continental Automotive Systems"
	M8 = "Email:     daniel.frauenrath@contiautomotive.com"
	M9 = "Datum:    07.05.2008"
	M10 = "Fuer weiteren Support und Hilfe benutzen sie bitte die Hilfedatei"
	Titel = "Disclaimer"
	Skin = vbExclamation + vbOKOnly + vbMsgBoxSetForeground + vbMsgBoxHelpButton

	Box = MsgBox(M1 + Chr(10) + Chr(10) + M2 + Chr(10) + M3 + Chr(10) + M4 + Chr(10) + Chr(10) + M5 + Chr(10) + Chr(10) + M6 + Chr(10) + M7 + Chr(10) + M8 + Chr(10) + M9 + Chr(10) + Chr(10) + M10, Skin, Titel, HelpPath, 130)

'**********************************Dateityp-Abfrage**********************************

	M1 = "Bitte waehlen Sie nun zwischen folgenden Funktionen und geben Sie die Kennziffer in das Feld ein."
	M2 = "Bitte benutzen sie den Hilfebutton falls zu zusaetzliche Informationen benoetigen!"
	M3 = "===> OK zum Starten des Makros"
	M4 = "===> CANCEL zum Abbrechen des Makros"
	M5 = "1. Zeichnung auf neues Part verlinken"
	M6 = "2. Zeichnung auf ein neues Product verlinken"
	Titel = "Makro-Optionen"

	DocumentSeperator = InputBox(M1 + Chr(10) + M2 + Chr(10) + Chr(10) + M3 + Chr(10) + M4 + Chr(10) + Chr(10) + M5 + Chr(10) + M6, Titel, "1")
    	If DocumentSeperator = "" Then
        	Box = MsgBox("Sie haben die Auswahl entwerder abgebrochen, oder das Eingabefeld war leer!" + Chr(10)+ "Das Makro wird nun abgebrochen", vbOKOnly + vbExclamation, "Abbruch")
        	Exit Sub
    	End If

	On Error Resume Next
    If DocumentSeperator = 1 Then
		iErr = Err.Number
		If (iErr<>0) then
			Box = MsgBox("Sie haben eine falschen Eingabe getaetigt!" + Chr(10) + "Bitte geben sie nur die ===> 1 <=== (CATPart) bzw. die ===> 2 <=== (CATProduct) ein!" + Chr(10) + "Das Makro wird nun abgebrochen", vbCritical, "Abbruch")
			Exit Sub
		End If
	End If
	On Error Goto 0
    
    

'**********************************Abfrage geöffnete Documente**********************************

	Krit = CATIA.Documents.Count

	M1 = "Es (ist) sind ==>  "
	M2 = "  <== Dokument(e) in der Session verfuegbar."
	M3 = "Dies kann zu schweren Fehler innerhalb des Makrolaufes fuehren."
	M4 = "Bitte schließen sie alle geoeffneten Dokumente und starten sie das Makro erneut."
	M5 = "Starten sie ggf. die Session erneut falls der Fehler nochmals auftritt und starten sie das Makro direkt im Anschluss."
	Titel = "Session-Abbruch"
	Skin = vbCritical + vbOKOnly +vbMsgBoxHelpButton

	If CATIA.Documents.Count <> 0 Then
    	Box = MsgBox(M1 & Krit & M2 + Chr(10) + M3 + Chr(10) + M4 + Chr(10) + M5, Skin, Titel, HelpPath, 70)
    	Exit Sub
 	End If


'**********************************New From ausfuehren mit Fehlerbehandlung**********************************

	NewFrom
    	If ErrorCode = 10 Then
        	Box = MsgBox("Laufzeitfehler (ScriptingError Code  ==> 10)" + Chr(10) + Chr(10) + "Sie haben keinen temporaeren Dateipfad fuer die Zeichnung angegeben." + Chr(10) + "Das Makro kann nicht weiter ausgefuehrt werden und wird deshalb abgebrochen", vbCritical + vbMsgBoxHelpButton , "Abbruch", HelpPath, 110)
        	Exit Sub
    	ElseIf ErrorCode = 11 Then
        	Box = MsgBox("Laufzeitfehler (ScriptingError Code  ==> 11)" + Chr(10) + Chr(10) + "Sie haben keine Zeichnung ausgewaehlt!" + Chr(10) + "Das Makro wird nun beendet", vbCritical + vbMsgBoxHelpButton, "Abbruch", HelpPath, 110)
        	Exit Sub
    	End If
    
'**********************************Neuen Link erzeugen mit Fehlerbehandlung**********************************

	Link_erzeugen
    	If ErrorCode = 13 Then
        	Box = MsgBox("Laufzeitfehler (ScriptingError Code  ==> 13)" + Chr(10) + Chr(10) + "Sie haben keine Datei gewaehlt die mit der Zeichnung verknuepft werden kann." + Chr(10) + "Das Makro kann nicht weiter ausgefuehrt werden und wird deshalb abgebrochen", vbCritical + vbMsgBoxHelpButton , "Abbruch", HelpPath, 110)
        	SemiDrawing.Close
			Exit Sub
    	ElseIf ErrorCode = 111 Then
        	Box = MsgBox("Laufzeitfehler (ScriptingError Code  ==> 111)" + Chr(10) + Chr(10) + "Bitte locken sie alle Views die keine externen Referenzen zu Modellen besitzen" + Chr(10) + Chr(10) + "==> KEINE GEBROCHENEN VIEW-SYMBOLE <==" + Chr(10) + Chr(10)+ "Starten Sie das Makro im Anschluss erneut", vbCritical + vbMsgBoxHelpButton, "Abbruch", HelpPath, 110)
        	SemiDrawing.Close
			SemiPart.Close
			Exit Sub
    	End If

End Sub

'****************************************************************************************************************************************************
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<Makro zum erzeugen der neuen Zeichnung>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'****************************************************************************************************************************************************

Sub NewFrom()

'**********************************Definition der Varaiblen**********************************

	Dim oFile As String
	Dim nDoc As Document
	Dim oFileName As String
	Dim oPfad As String
	Dim oSpeichername As String
	Dim oDraw As DrawingDocument
	Dim oFileSys As FileSystem

'**********************************Erstellen des temporaeren Speicherpfads**********************************
	Set oFileSys = CATIA.FileSystem
    sTmpPath=CATIA.SystemService.Environ("CATTemp")
    	If (Not oFileSys.FolderExists(sTmpPath)) Then
      		sTmpPath = InputBox("Der temporaere Pfad des Environments wurde nicht gefunden" + Chr(10) + "Bitte geben Sie einen alternativen temporaeren Pfad an", "Fehler temporaerer Pfad", "C:\Temp\")
    	End If


'**********************************Neu Aus Befehl durchfuehren**********************************

	oFile = CATIA.FileSelectionBox("Bitte waehlen Sie eine Zeichnung aus", "*.CATDrawing", 0)

	If oFile = "" Then
    	ErrorCode = 11
    	Exit Sub
	End If

	Set nDoc = CATIA.Documents.NewFrom(oFile)

'**********************************Original Dateinamen auslesen und neuen generieren. Anschliessend speichern**********************************

	Set Document = CATIA.ActiveDocument
	oFileName = CATIA.ActiveDocument.FullName
	Set oDraw = CATIA.ActiveDocument
	hlp = Split(oDraw.FullName, "_1.CAT")
	nFilename = hlp(0)

    If (Not oFileSys.FolderExists(sTmpPath)) Then
    	sTmpPath = InputBox("Der angegebene temporaere Pfad exisiert nicht" + Chr(10) + "Bitte geben Sie einen alternativen temporaeren Pfad an", "Fehler temporaerer Pfad")
    End If

	oSpeichername = sTmpPath & nFilename & ".CATDrawing"

	CATIA.ActiveDocument.SaveAs (oSpeichername)

	Set SemiDrawing = CATIA.ActiveDocument
	nDrawing = SemiDrawing.FullName
	DrawingPath = SemiDrawing.Path
	'oDoc.Close

End Sub

'****************************************************************************************************************************************************
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<Makro zum erzeugen der Links>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'****************************************************************************************************************************************************

Sub Link_erzeugen()

	If DocumentSeperator = 1 Then
    	oFile = CATIA.FileSelectionBox("Bitte waehlen Sie das Part aus das mit der Zeichnung verknuepft werden soll", "*.CATPart", 0)
	Else
	    oFile = CATIA.FileSelectionBox("Bitte waehlen Sie das Product aus das mit der Zeichnung verknuepft werden soll", "*.CATProduct", 0)
	End If

	If oFile = "" Then
    	ErrorCode = 13
    	Exit Sub
	End If


	Set SemiPart = CATIA.Documents.Open(oFile)
	SemiDrawing.Activate

'**********************************Sicherheitsabfrage iniatlisieren**********************************

	Dim Ml1, Ml2, Ml3, Ml4, Titel, Skin

	Ml1 = "Es wurden keine gelockten Views auf der Zeichnung gefunden!"
	Ml2 = "Bitte locken sie alle Views, die keine Referenz zu Modellen haben (Views die nur Texte, Anmerkungen, isolierte Details, etc. beinhalten)"
	Ml3 = "Klicken sie ABBRECHEN wenn sie das Makro jetzt abbrechen wollen um die Views zu isolieren"
	Ml4 = "Klicken sie ausschließlich OK wenn alles Views der Zeichnung zu Modellen referenziert waren (alle Views werden gebrochen dargestellt!!!)"
	Titel = "Kontrollabfrage"
	Skin = vbCritical + vbOKCancel + vbDefaultButton2 + vbMsgBoxHelpButton

	Set oDRWDoc = CATIA.ActiveDocument
	l = 0
	Zaehler = 0
    	For i = 1 To CATIA.ActiveDocument.Sheets.Count
        Set oSheet = CATIA.ActiveDocument.Sheets.Item(i)
        	If oSheet.IsDetail = False Then
            	For j = 3 To oSheet.Views.Count
            	Set oView = oSheet.Views.Item(j)
                	On Error Resume Next
                		Select Case CStr(oView.LockStatus)
                			Case "Wahr"
                   				Zaehler = Zaehler + 1
                		End Select
            	Next
        	End If
    	Next

	If Zaehler = 0 Then
    	Abfrage = MsgBox(Ml1 + Chr(10) + Ml2 + Chr(10) + Ml3 + Chr(10) + Ml4, Skin, Titel, HelpPath, 80)
    		If Abfrage = vbCancel Then
        		ErrorCode = 111
        		Exit Sub
    		Else
        		Box = MsgBox("Das Makro wird nun fortgesetzt." + Chr(10) + "Falls Sie dennoch einen Fehler entdecken (nicht alle Views ohne Referenzen waren gelockt) fuehren Sie das Makro erneut aus und loeschen sie die fehlerhafte Datei", vbInformation + vbOKOnly + vbMsgBoxHelpButton, "Hinweis", HelpPath, 80)
    		End If
	End If

'**********************************Links umhaengen**********************************

	Set oDRWDoc = CATIA.ActiveDocument
	l = 0
	For i = 1 To oDRWDoc.Sheets.Count
    Set oSheet = oDRWDoc.Sheets.Item(i)
        If oSheet.IsDetail = False Then
            For j = 3 To oSheet.Views.Count
            Set oView = oSheet.Views.Item(j)
                If oView.LockStatus = False Then
                    oView.GenerativeLinks.RemoveAllLinks
                    oView.GenerativeLinks.AddLink SemiPart.Product
                End If
            Next
        End If
    Next

	oDRWDoc.Update

'**********************************Zeichnung und Modell neu abspeichern**********************************

	newDrwNameRaw = SemiPart.FullName
	Dateipfad = SemiPart.Path
	newDrwNameSemi = Split(newDrwNameRaw, ".CATP")
	newDrwNameFin = newDrwNameSemi(0) & ".CATDrawing"

	SemiPart.Activate
	Set oPart = CATIA.ActiveDocument
	CATIA.ActiveDocument.Save
	oPart.Close

	SemiDrawing.Activate
	Set oDraw = CATIA.ActiveDocument
	CATIA.ActiveDocument.SaveAs (newDrwNameFin)

'**********************************temporaere Zeichung loeschen**********************************

	Dim oFileSys As FileSystem
	Set oFileSys = CATIA.FileSystem

	If (oFileSys.FileExist(nDrawing)) Then
		oFileSys.DeleteFile nDrawing
	End If

'**********************************Ausgabe des Speicherortes**********************************

	Ml1 = "Die Zeichnung wurde unter folgendem Pfad gespeichert:"
	Ml_ZU_1 = "==> "
	Ml_ZU_2 = " <=="
	Ml2 = "Das Part wurde unter folgendem Pfad gespeichert:"
	Ml3 = "Das Product wurde unter folgendem Pfad gespeichert:"
	Ml4 = "Wollen Sie in den Pfad nun oeffnen?"
	Titel = "Speicherdaten"
	Skin = vbInformation + vbYesNo

	Select Case DocumentSeperator
    	Case 1
        	Abfrage = MsgBox(Ml1 + Chr(10) + Ml_ZU_1 + newDrwNameFin + Ml_ZU_2 + Chr(10) + Chr(10) + Ml2 + Chr(10) + Ml_ZU_1 + newDrwNameRaw + Ml_ZU_2 + Chr(10) + Chr(10) + Ml4, Skin, Titel)
    	Case 2
        	Abfrage = MsgBox(Ml1 + Chr(10) + Ml_ZU_1 + newDrwNameFin + Ml_ZU_2 + Chr(10) + Chr(10) + Ml3 + Chr(10) + Ml_ZU_1 + newDrwNameRaw + Ml_ZU_2 + Chr(10) + Chr(10) + Ml4, Skin, Titel)
	End Select

	os = UCase(Left(CATIA.SystemConfiguration.OperatingSystem, 3))
	If Abfrage = vbYes Then
		 If (os = "WIN") Or (os = "INT") Then
			Pfad = Dateipfad 
    		ExplorerPath = "C:\WINDOWS\explorer.exe"
			Explorer = CATIA.SystemService.ExecuteProcessus (ExplorerPath & " " & Pfad)
		Else
			'ExplorerPath = "C:\WINDOWS\explorer.exe"																		Pfad fuer UNIX Exploerer eingeben
			'Explorer = CATIA.SystemService.ExecuteProcessus (ExplorerPath & " " & Pfad)
		End If
	End If

End Sub

