Language="VBSCRIPT"

public DokAnzahl
public DokumentArray()
public strDokumentArray()

'http://www.tech-ecke.de/index_quereinstieg.htm?/catscript/selection.htm

'Catia Baum in Array
'http://www.tech-ecke.de/index_quereinstieg.htm?/catscript/visualbasicscript.htm

'ParameterPrüfen
'http://ww3.cad.de/foren/ubb/Forum137/HTML/002377.shtml
Sub CATMain()
   CatiaBaumInArray
   DoppeltArrayRaus
end Sub


Sub CatiaBaumInArray()
  Call GetElements(1)   ' 1 = Parts und Products
    for n = 1 to DokAnzahl
        Dokument = DokumentArray(n)
       'MsgBox Dokument.Name 
    next
End Sub

Sub GetElements(SearchMode)
   ' Benötigt !!! Variable: public DokAnzahl: public DokumentArray()
   ' Eingabewerte: 1 = Parts und Products; 2 = nur Parts; 3 = nur Products
   if SearchMode = 1 then SuchString = "Type=Product,all"
   if SearchMode = 2 then SuchString = "(CATProductSearch.Part),all"
   if SearchMode = 3 then SuchString = "(CATProductSearch.Assembly),all"
   set Selection1 = CATIA.ActiveDocument.Selection
   selection1.Search SuchString
   DokAnzahl = selection1.Count
   
     for n = 1 to DokAnzahl
        ReDim Preserve DokumentArray(n)
         'DokumentArray(n) = selection1.Item(n).Value ' gibt den Instanznamen aus
          PartNumber = selection1.Item(n).Value.ReferenceProduct.Name
          DateiName  = selection1.Item(n).Value.ReferenceProduct.Parent.Name
          
         DokumentArray(n) = DateiName
     next
   selection1.Clear
End Sub


Sub DoppeltArrayRaus()
		For Count1 = 1 To UBound(DokumentArray)
			Varic = DokumentArray(Count1)
				If InStr(VariN, Varic) > 0 Then
				Else
					VariN = CStr(VariN) & "," & CStr(Varic)
					VariNAnz = VariNAnz + 1
					If Left(VariN, 1) = "," Then
					VariN = Right(VariN, Len(VariN) - 1)
					End If
				End If
		Next
		
		ReDim Preserve strDokumentArray(VariNAnz - 1)
  

		For Count2 = 0 To VariNAnz - 1
			If InStr(VariN, ",") > 0 Then
				strDokumentArray(Count2) = Left(VariN, InStr(VariN, ",") - 1)
				VariN = Right(VariN, Len(VariN) - InStr(VariN, ","))
			Else
				strDokumentArray(Count2) = VariN
			End If
		Next
  
  ParameterPruefen(VariNAnz)
  
end Sub
  
Function ParameterPruefen(AnzGesamt)
 '	DateiName = selection1.Item(n).Value.ReferenceProduct.Parent.Name
 msgbox AnzGesamt
 
   For i = 0 to AnzGesamt - 1
      
      'msgbox strDokumentArray(i)

       DateiName = strDokumentArray(i)
       WennPart = split(strDokumentArray(i),".CAT")
       
       StrPartNumber = WennPart(0)
      
      'msgbox WennPart(0) & " _ " & WennPart(1)
      
      If WennPart(1) = "Part" Then
       
       Dim documents1 As Documents
       Set documents1 = CATIA.Documents
       Dim partDocument1 As Document
       Set partDocument1 = documents1.Item(DateiName)
       Dim part1 As Part
       Set part1 = partDocument1.Part
       Dim parameters1 As Parameters
       Set parameters1 = part1.Parameters
       Dim strParam1 As Parameter
       
       '--- ParameterPruefen -------
		     
       '---ZSB_Pos
       on Error Resume Next
        ParaName = "ZSB_Pos"
       Set strParam1 = parameters1.Item(ParaName)  
          If Err = 0 Then
             'Parameter existiert
          else 
             Set strParam1 = parameters1.CreateString(ParaName, "")
                ParaInSet DateiName, StrPartNumber, ParaName
              on Error GoTo 0
          end if
        '---ZSB_Pos
       
        '---Hersteller
        on Error Resume Next
        ParaName = "Hersteller"
       Set strParam1 = parameters1.Item(ParaName)  
          If Err = 0 Then
             'Parameter existiert
          else 
             Set strParam1 = parameters1.CreateString(ParaName, "")
                ParaInSet DateiName, StrPartNumber, ParaName
              on Error GoTo 0
          end if
        '---Hersteller
      '--- ParameterPruefen -------
      end if         
    
   next
end Function
 
 
Function ParaInSet(DateiNameInSet, StrPartNumberInSet, ParaNameInSet)



       Dim productDocument1 As Document
       Set productDocument1 = CATIA.ActiveDocument
       Dim selection1 As Selection
       Set selection1 = productDocument1.Selection
       selection1.Clear 
       Dim documents1 As Documents
       Set documents1 = CATIA.Documents
       Dim partDocument1 As Document
       Set partDocument1 = documents1.Item(DateiNameInSet)
       Dim part1 As Part
       Set part1 = partDocument1.Part
       Dim parameters1 As Parameters
       Set parameters1 = part1.Parameters
       Dim strParam1 As Parameter
       Set strParam1 = parameters1.Item(StrPartNumberInSet &"\" & ParaNameInSet)

       selection1.Add strParam1
       selection1.Cut 

       Set productDocument1 = CATIA.ActiveDocument
       Dim selection2 As Selection
       Set selection2 = productDocument1.Selection
       selection2.Clear 
       Dim parameters2 As Parameters
       Set parameters2 = part1.Parameters
       Dim parameterSet1 As ParameterSet
       Set parameterSet1 = parameters2.RootParameterSet
       Dim parameterSets1 As ParameterSets
       Set parameterSets1 = parameterSet1.ParameterSets
       Dim parameterSet2 As CATBaseDispatch
       Set parameterSet2 = parameterSets1.GetItem("Stückliste")

       selection2.Add parameterSet2
       selection2.Paste   
End Function