'-------------------------------------------------------------------
Author:						shoutz000
Macro:						OPENER_CatPart_PAD	
Last Modifikation:				30.10.2014	
Version:					V-3.1
'-------------------------------------------------------------------
'-------------------------------------------------------------------

Language="VBSCRIPT"

'----------------------------------------
Sub CATMain()
	'Fehlerbehandlung / Abfrage des aktiven Dokuments
		If CATIA.Windows.Count = 0 Then
			Box = MsgBox("Es wurde kein aktives Dokument identifiziert!!!"  & vbLF & _
									"---------------------------------------------------------"   & vbLF & _
									"Bitte öffnen Sie zuerst ein Dokument und starten Sie"  & vbLF & _
									"dann OPENER_CatPart_PAD erneut.", 16, "Kein ActiveDocument!!!")
    			Exit Sub
		End If

		Set oDocument = CATIA.ActiveDocument

		If TypeName(oDocument) <> "ProductDocument" Then
			Box = MsgBox("Es wurde kein aktives Product identifiziert!!!" & vbLF & _
									"---------------------------------------------------------"  & vbLF & _
									"OPENER_CatPart_PAD wurde abgebrochen.", 16, "Kein Product!!!")
			Exit Sub
		End If
'----------------------------------------

'----------------------------------------
	'Neuen PartNamen abfragen
		Set product = oDocument.Product
		Set products = product.Products
		Set oSel = oDocument.Selection

			CATIA.StartCommand "Clear History"

	'StartPart in die Struktur laden
		Dim arrayOfVariantOfBSTR(0)
		arrayOfVariantOfBSTR(0) = "J:\Makros\StartParts\XXX_TEIL-PAD_XXX.CATPart"
		products.AddComponentsFromFiles arrayOfVariantOfBSTR, "All"

	'Vergabe der neuen PartNumber + InstanceName / Prüfen ob PartNumber bereits vorhanden

			isSaved = False
			while isSaved = False

			myFunc = InputBox ("Bitte vergeben Sie einen neuen Namen.", "PartName", "XXXXXXXX-Y-CC_PLATTE_XX")
			If myFunc = "" Then
					products.remove(products.count)
				Exit Sub
			End If

			On Error Resume Next
				Set documents = CATIA.Documents
				Set partDocument = documents.Item("XXX_TEIL-PAD_XXX.CATPart")
				strPath = oDocument.Path

					Set oName = products.GetItem("XXX_TEIL-PAD_XXX.1")
						oName.Name = myFunc & ".1"

					Set oNumber = partDocument.GetItem("XXX_TEIL-PAD_XXX")
						oNumber.PartNumber = myFunc

			If Err.Number <> 0 Then

				RetCode = MsgBox("Diese PartNumber existiert bereits in der Struktur." & vbLF & _
											"----------------------------------------------------" & vbLF & _
											"Sie müssen eine neue PartNumber vergeben!", 48 + vbYesNo, "Warnung!!!")
				Select Case RetCode

					Case vbNo
							products.remove(products.count)
						Exit Sub
					End Select

	'Part abspeichern
			Else
				SavePart strPath, myFunc, partDocument, products
				isSaved = True
			End If
		Wend
			On Error GoTo 0
End Sub
'----------------------------------------

'----------------------------------------
Sub SavePart(ByVal strPath As String, ByVal myFunc As String, ByVal partDocument As Document, ByVal products As Products)
	'Geladenes StartPart im Projektordner speichern
		On Error Resume Next
			strFileName = strPath & "\" & myFunc
			partDocument.SaveAs strFileName

		If Err.Number <> 0 Then
					products.remove(products.count)
				Exit Sub
			End If
		On Error GoTo 0
End Sub
'----------------------------------------