Public Sub InstantiateIntersections(iIndexLayer As Integer, strIndexContour As String, iNumberState As Integer, iNumberTarget As Integer)

        Set CATIA = GetObject(, "CATIA.Application") 'Einbinden des Objekts CATIA als Applikation - Schnittstelle CAD zu MS Excel
        CATIA.StartCommand "Clear History" 'Zwischenspeicher löschen

        Set documentsModul = CATIA.Documents
        Set Lagen = documentsModul.Item("Lage_Index_" & iIndexLayer & ".CATPart") 'Definiere Ziel Instanziierung
        Set Lagen_Part = Lagen.Part
        Set HSFactory = Lagen_Part.HybridShapeFactory
        Set Lagen_HB = Lagen_Part.HybridBodies
            Set Lagen_GeoSetBoundCond = Lagen_HB.Item("Instanz_Randwerte_Lage_Index_" & iIndexLayer)
            Set Lagen_GeoSetBoundCond_HS = Lagen_GeoSetBoundCond.HybridShapes
            Set Lagen_GeoSetExtRef = Lagen_HB.Item("External References")
            Set Lagen_GeoSetExtRef_HS = Lagen_GeoSetExtRef.HybridShapes
            Set LagenGeoSetIntRef = Lagen_HB.Item("Referenzen_Schnittpunkte_Lage_Index_" & iIndexLayer)
            Set LagenGeoSetIntRef_HS = LagenGeoSetIntRef.HybridShapes
            Set LagenGeoSetDestination = Lagen_HB.Item("Baender_Lage_Index_" & iIndexLayer)
            Set LagenGeoSetDestination_HB = LagenGeoSetDestination.HybridBodies
            Set LagenGeoSetDestination_HS = LagenGeoSetDestination.HybridShapes
        Set Lagen_Parameters = Lagen_Part.Parameters
        Set Lagen_Relations = Lagen_Part.Relations
        Set Lagen_Sel = Lagen.Selection
        Lagen_Sel.Clear
        
        
        
        If iNumberState < iNumberTarget Then
        
            Set GeoSet4Instance = LagenGeoSetDestination_HB.Add()
            GeoSet4Instance.Name = "Referenz_Position_Baender_Lage_Index_" & iIndexLayer
            Lagen_Part.InWorkObject = GeoSet4Instance
            
            For i = iNumberState + 1 To iNumberTarget

           '***************Es folgt: Instanziierung Powercopy Orientierung***************
                    Set PartDest = Lagen.Part
                    Set Factory = PartDest.GetCustomerFactory("InstanceFactory")
                    Factory.BeginInstanceFactory "PC_Schnittpunkte", strRefVerzeichnis & "\Referenz\Template_PC_Schnittpunkte.CATPart"
                    Factory.BeginInstantiate
                        Set Item_to_set1 = PartDest.FindObjectByName("Referenzpunkt_" & i) 'Definiere Referenzgeometrie Zieldatei der PC (ZUWEISEN ZU...)
                        Factory.PutInputData "Referenzpunkt_Schnittpunkt", Item_to_set1 'Definiere Geometrie der PC (ERSETZEN VON...)
                        Set Item_to_set2 = PartDest.FindObjectByName("Orientierung_Lage_Index_" & iIndexLayer)
                        Factory.PutInputData "Orientierung", Item_to_set2
                        
                        If strIndexContour = "Main" Then
                            Set Item_to_set3 = PartDest.FindObjectByName("Hauptkontur")
                            Factory.PutInputData "Kontur", Item_to_set3
                        ElseIf strIndexContour = "Special" Then
                            Set Item_to_set3 = PartDest.FindObjectByName("Sonderkontur_" & Range("Tabelle_Lagen").Cells(iIndexLayer, 6).Value)
                            Factory.PutInputData "Kontur", Item_to_set3
                        End If
                            
                    Set Instance = Factory.Instantiate
                    Factory.EndInstantiate
                    Factory.EndInstanceFactory
                    
                    Set Line2Rename = GeoSet4Instance.HybridShapes.Item("Orientierung_Band_XY_Lage_Index_XY") 'Rename Geometrie
                    Line2Rename.Name = "Orientierung_Referenzpunkt_" & i & "_Lage_Index_" & iIndexLayer
                    Set Intersection2Rename = GeoSet4Instance.HybridShapes.Item("Schnittmenge_Kontur_Orientierung_Lage_Index_XY") 'Rename Geometrie
                    Intersection2Rename.Name = "Schnittmenge_" & i & "_Kontur_Orientierung_Lage_Index_" & iIndexLayer
                    
                    Lagen_Part.Update
                    
       '********************Mulitsection Befehl in einzelne Punkte separieren********************************
                    Dim reference1 As Reference
                    Dim IntersectionExtract1 As HybridShapeExtract
                    
                    Set GeoSet4Instance_HS = GeoSet4Instance.HybridShapes
                    Set IntersectionAssembly = GeoSet4Instance_HS.Item("Schnittmenge_" & i & "_Kontur_Orientierung_Lage_Index_" & iIndexLayer)
                    
                    Lagen_Sel.Clear
                    Lagen_Sel.Add IntersectionAssembly
                    
                    Lagen_Sel.Search "Topology.CGMVertex,sel"
                    MsgBox Lagen_Sel.Count
                    
                    If Lagen_Sel.Count <> 0 Then
                    
                        For z = 1 To Lagen_Sel.Count
                        
                            Set reference1 = Lagen_Sel.Item2(z).Reference
                            Set IntersectionExtract1 = HSFactory.AddNewExtract(reference1)
                    
                            IntersectionExtract1.PropagationType = 3
                            IntersectionExtract1.ComplementaryExtract = False
                            IntersectionExtract1.IsFederated = False
                            GeoSet4Instance.AppendHybridShape IntersectionExtract1
                            Lagen_Part.InWorkObject = IntersectionExtract1
                            
                            IntersectionExtract1.Name = "Schnittpunkt_" & iIndexLayer & "." & i & "." & z
                            
                        Next
                    
                        Lagen_Part.Update
                    
                    End If
                    
                    
            Next
            
            
        ElseIf iNumberState > iNumberTarget Then
            
        End If
        
End Sub