Language="VBSCRIPT"

'----------------------------------------

'----------------------------------------
Sub CATMain()
	'Fehlerbehandlung / Abfrage des aktiven Dokuments
		If CATIA.Windows.Count = 0 Then
			Box = MsgBox("Kein aktives Dokument.", 16, "Warning")
    			Exit Sub
		End If

		Set oDoc = CATIA.ActiveDocument

		If TypeName(oDoc) <> "ProductDocument" Then
			Box = MsgBox("Kein aktives Product.", 16, "Warning")
			Exit Sub
		End If

'----------------------------------------

'----------------------------------------
	'Struktur durchgehen
		Set oDoc = CATIA.ActiveDocument
		Set oProd = oDoc.Product

			ScanProductStructure oProd

				RetCode = MsgBox("Es wurden erfolgreich alle BMW-Relations erstellt." & vbLF & _
						"-------------------------------------------------------------------"  & vbLF & _
						"Führen Sie SaveAll aus."  ,64, "Note")
End Sub

'----------------------------------------
Sub ScanProductStructure(oProd2 As Product)
	'Parameter prüfen / erstellen und Formeln erstellen
		On Error Resume Next
			For i = 1 To oProd2.Products.Count
				Set CurrentProd = oProd2.Products.Item(i)

			If CurrentProd.Products.Count = 0 Then
				Err.Clear

				Set oPosition1 = CurrentProd.Parameters.Item("Stueckliste\Position")
				oPosition1.Value = ""
			If Err.Number = 0 Then
				If Mid(CurrentProd.PartNumber, 1, 2)<>"__" AND Mid(CurrentProd.PartNumber, 14, 1)<>"." Then
					Set relations1 = CurrentProd.Relations
					Set formula1 = relations1.CreateFormula("formula1", "", oPosition1, "`Part Number` ->Extract(9,4) ")
				End If
				If Mid(CurrentProd.PartNumber, 1, 2)<>"__" AND Mid(CurrentProd.PartNumber, 14, 1)="." Then
					Set relations1 = CurrentProd.Relations
					Set formula1 = relations1.CreateFormula("formula1", "", oPosition1, "`Part Number` ->Extract(9,9) ")
				End If
				If Mid(CurrentProd.PartNumber, 1, 2)="__" AND Mid(CurrentProd.PartNumber, 14, 1)<>"." Then
					Set relations1 = CurrentProd.Relations
					Set formula1 = relations1.CreateFormula("formula1", "", oPosition1, "`Part Number` ->Extract(2,4) ")
				End If
			End If
				Err.Clear

				Set oPosition2 = CurrentProd.Parameters.Item("Position")
				oPosition2.Value = ""
			If Err.Number = 0 Then
				If Mid(CurrentProd.PartNumber, 1, 2)<>"__" AND Mid(CurrentProd.PartNumber, 14, 1)<>"." Then
					Set relations1 = CurrentProd.Relations
					Set formula1 = relations1.CreateFormula("formula1", "", oPosition2, "`Part Number` ->Extract(9,4) ")
				End If
				If Mid(CurrentProd.PartNumber, 1, 2)<>"__" AND Mid(CurrentProd.PartNumber, 14, 1)="." Then
					Set relations1 = CurrentProd.Relations
					Set formula1 = relations1.CreateFormula("formula1", "", oPosition2, "`Part Number` ->Extract(9,9) ")
				End If
				If Mid(CurrentProd.PartNumber, 1, 2)="__" AND Mid(CurrentProd.PartNumber, 14, 1)<>"." Then
					Set relations1 = CurrentProd.Relations
					Set formula1 = relations1.CreateFormula("formula1", "", oPosition2, "`Part Number` ->Extract(2,4) ")
				End If
			End If
				Err.Clear

				Set oName1 = CurrentProd.Parameters.Item("Stueckliste\Name")
				oName1.Value = ""
			If Err.Number = 0 Then
				If Mid(CurrentProd.PartNumber, 1, 2)<>"__" AND Mid(CurrentProd.PartNumber, 14, 1)<>"." Then
					Set relations2 = CurrentProd.Relations
					Set formula2 = relations2.CreateFormula("formula2", "", oName1, "`Part Number` ->Extract(15,`Part Number`->Length()-15)")
				End If
				If Mid(CurrentProd.PartNumber, 1, 2)<>"__" AND Mid(CurrentProd.PartNumber, 14, 1)="." Then
					Set relations2 = CurrentProd.Relations
					Set formula2 = relations2.CreateFormula("formula2", "", oName1, "`Part Number` ->Extract(20,`Part Number`->Length()-20)")
				End If
				If Mid(CurrentProd.PartNumber, 1, 2)="__" AND Mid(CurrentProd.PartNumber, 14, 1)<>"." Then
					Set relations2 = CurrentProd.Relations
					Set formula2 = relations2.CreateFormula("formula2", "", oName1, "`Part Number` ->Extract(8,`Part Number`->Length()-8)")
				End If
			End If
				Err.Clear

				Set oName2 = CurrentProd.Parameters.Item("Stueckliste\Benennung")
				oName2.Value = ""
			If Err.Number = 0 Then
				If Mid(CurrentProd.PartNumber, 1, 2)<>"__" AND Mid(CurrentProd.PartNumber, 14, 1)<>"." Then
					Set relations2 = CurrentProd.Relations
					Set formula2 = relations2.CreateFormula("formula2", "", oName2, "`Part Number` ->Extract(15,`Part Number`->Length()-15)")
				End If
				If Mid(CurrentProd.PartNumber, 1, 2)<>"__" AND Mid(CurrentProd.PartNumber, 14, 1)="." Then
					Set relations2 = CurrentProd.Relations
					Set formula2 = relations2.CreateFormula("formula2", "", oName2, "`Part Number` ->Extract(20,`Part Number`->Length()-20)")
				End If
				If Mid(CurrentProd.PartNumber, 1, 2)="__" AND Mid(CurrentProd.PartNumber, 14, 1)<>"." Then
					Set relations2 = CurrentProd.Relations
					Set formula2 = relations2.CreateFormula("formula2", "", oName2, "`Part Number` ->Extract(8,`Part Number`->Length()-8)")
				End If
			End If
				Err.Clear

				Set oName3 = CurrentProd.Parameters.Item("Name")
				oName3.Value = ""
			If Err.Number = 0 Then
				If Mid(CurrentProd.PartNumber, 1, 2)<>"__" AND Mid(CurrentProd.PartNumber, 14, 1)<>"." Then
					Set relations2 = CurrentProd.Relations
					Set formula2 = relations2.CreateFormula("formula2", "", oName3, "`Part Number` ->Extract(15,`Part Number`->Length()-15)")
				End If
				If Mid(CurrentProd.PartNumber, 1, 2)<>"__" AND Mid(CurrentProd.PartNumber, 14, 1)="." Then
					Set relations2 = CurrentProd.Relations
					Set formula2 = relations2.CreateFormula("formula2", "", oName3, "`Part Number` ->Extract(20,`Part Number`->Length()-20)")
				End If
				If Mid(CurrentProd.PartNumber, 1, 2)="__" AND Mid(CurrentProd.PartNumber, 14, 1)<>"." Then
					Set relations2 = CurrentProd.Relations
					Set formula2 = relations2.CreateFormula("formula2", "", oName3, "`Part Number` ->Extract(8,`Part Number`->Length()-8)")
				End If
			End If
				Err.Clear

				Set oName4 = CurrentProd.Parameters.Item("Benennung")
				oName4.Value = ""
			If Err.Number = 0 Then
				If Mid(CurrentProd.PartNumber, 1, 2)<>"__" AND Mid(CurrentProd.PartNumber, 14, 1)<>"." Then
					Set relations2 = CurrentProd.Relations
					Set formula2 = relations2.CreateFormula("formula2", "", oName4, "`Part Number` ->Extract(15,`Part Number`->Length()-15)")
				End If
				If Mid(CurrentProd.PartNumber, 1, 2)<>"__" AND Mid(CurrentProd.PartNumber, 14, 1)="." Then
					Set relations2 = CurrentProd.Relations
					Set formula2 = relations2.CreateFormula("formula2", "", oName4, "`Part Number` ->Extract(20,`Part Number`->Length()-20)")
				End If
				If Mid(CurrentProd.PartNumber, 1, 2)="__" AND Mid(CurrentProd.PartNumber, 14, 1)<>"." Then
					Set relations2 = CurrentProd.Relations
					Set formula2 = relations2.CreateFormula("formula2", "", oName4, "`Part Number` ->Extract(8,`Part Number`->Length()-8)")
				End If
			End If
				Err.Clear
			Else

		ScanProductStructure CurrentProd.ReferenceProduct
			End If
				Next
			On Error GoTo 0

End Sub
'----------------------------------------