Const QuellVersion As String = "6.0.1"

' Stand 14.06.2009

Global AllClasses As ClassCollection
Global AAAClasses As ClassCollection
Global AllPackages As CategoryCollection
Global SeqNo As Integer

Sub SetRelProperty( cn As String, an As String, pn As String, v As String )
	Dim cl As Class
	Dim at As Role
	i% = AllClasses.FindFirst (cn)
	If i% > 0 Then
		Set cl = AllClasses.GetAt(i%)
		j% = cl.GetAssociateRoles().FindFirst (an)
		If j% > 0 Then
			Set at = cl.GetAssociateRoles().GetAt(j%)
			IsOverridden = at.OverrideProperty ("UGAS", pn, v)
		Else
			Print "***** Fehler! Rolle nicht gefunden: ", cn, an
		End If
	Else
		Print "***** Fehler! Klasse nicht gefunden: ", cn
	End If

End Sub

Sub DeletePackage( pn As String )
	Dim p As Category
	Dim pa As Category
	Dim b As Boolean
	i% = AllPackages.FindFirst (pn)
	If i% > 0 Then
		Set p = AllPackages.GetAt(i%)
		Set pa = p.parentcategory
		b= pa.DeleteCategory(p)
	Else
		Print "***** Fehler! Paket nicht gefunden: ", pn
	End If
End Sub

Sub DeleteClass( cn As String )
	Dim cl As Class
	Dim pa As Category
	Dim b As Boolean
	i% = AllClasses.FindFirst (cn)
	If i% > 0 Then
		Set cl = AllClasses.GetAt(i%)
		Set pa = cl.parentcategory
		b= pa.DeleteClass(cl)
	Else
		Print "***** Fehler! Klasse nicht gefunden: ", cn
	End If
End Sub

Sub DeleteAttribute( cn As String, an As String )
	Dim cl As Class
	Dim at As Attribute
	Dim b As Boolean
	i% = AllClasses.FindFirst (cn)
	If i% > 0 Then
		Set cl = AllClasses.GetAt(i%)
		j% = cl.Attributes.FindFirst (an)
		If j% > 0 Then
			Set at = cl.Attributes.GetAt(j%)
			b = cl.DeleteAttribute(at)
		Else
			Print "***** Fehler! Attribut nicht gefunden: ", cn, an
		End If
	Else
		Print "***** Fehler! Klasse nicht gefunden: ", cn
	End If
End Sub

Sub DeleteRole( cn As String, an As String )
	Dim cl As Class
	Dim at As Role
	Dim b As Boolean
	i% = AllClasses.FindFirst (cn)
	If i% > 0 Then
		Set cl = AllClasses.GetAt(i%)
		j% = cl.GetAssociateRoles().FindFirst (an)
		If j% > 0 Then
			Set at = cl.GetAssociateRoles().GetAt(j%)
			b = cl.DeleteAssociation(at.association)
		Else
			Print "***** Fehler! Rolle nicht gefunden: ", cn, an
		End If
	Else
		Print "***** Fehler! Klasse nicht gefunden: ", cn
	End If
End Sub

Sub ChangeType( cn As String, an As String, tn As String )
	Dim cl As Class
	Dim at As Attribute
	Dim b As Boolean
	i% = AllClasses.FindFirst (cn)
	If i% > 0 Then
		Set cl = AllClasses.GetAt(i%)
		j% = cl.Attributes.FindFirst (an)
		If j% > 0 Then
			Set at = cl.Attributes.GetAt(j%)
			at.type = tn
		Else
			Print "***** Fehler! Attribut nicht gefunden: ", cn, an
		End If
	Else
		Print "***** Fehler! Klasse nicht gefunden: ", cn
	End If
End Sub

Sub ChangeAttname( cn As String, an As String, nan As String )
	Dim cl As Class
	Dim at As Attribute
	Dim b As Boolean
	i% = AllClasses.FindFirst (cn)
	If i% > 0 Then
		Set cl = AllClasses.GetAt(i%)
		j% = cl.Attributes.FindFirst (an)
		If j% > 0 Then
			Set at = cl.Attributes.GetAt(j%)
			at.name = nan
		Else
			Print "***** Fehler! Attribut nicht gefunden: ", cn, an
		End If
	Else
		Print "***** Fehler! Klasse nicht gefunden: ", cn
	End If
End Sub

Sub AddAttribute( cn As String, an As String, tn As String )
	Dim cl As Class
	Dim at As Attribute
	Dim b As Boolean
	i% = AllClasses.FindFirst (cn)
	If i% > 0 Then
		Set cl = AllClasses.GetAt(i%)
		Set at = cl.AddAttribute (an, tn, "") 
	Else
		Print "***** Fehler! Klasse nicht gefunden: ", cn
	End If
End Sub

Sub UpdateAttributeIM( c As Class, p As Attribute )
End Sub

Sub UpdateRoleIM( c As Class, p As Role )
	Dim s As String
	If p.AssociateItem Is Nothing Then
		b = c.deleteAssociation(p.association)
		Exit Sub
	End If 
	s = p.AssociateItem.stereotype
	If s = "Feature" Or s = "FeatureType" Or s = "" Or s = "Type" Then
		If (Not p.Navigable) Then
			p.Cardinality = "0..*"
			Call SetRelProperty( c.name, p.name, "reverseRoleNAS", "true" )
			p. Navigable = true
			If p.name = "" Then
				If p.Association.Role1.name = "" Then
					p.name = "inversZu_"+p.Association.Role2.name 
				Else
					p.name = "inversZu_"+p.Association.Role1.name 
				End If
				Call SetRelProperty( c.name, p.name, "inlineOrByReference", "byReference" )
			End If 
		End If
	End If
End Sub

Function GetSubclasses( theClass As Class ) As ClassCollection

	Dim SelClasses As ClassCollection
	Dim Subclasses As New ClassCollection

	If theClass.stereotype <> "Type" and theclass.name <> "AA_PMO" and theclass.name <> "AA_Objekt" Then 
		Subclasses.Add theClass
	Else
		Set SelClasses = theClass.GetSubclasses()
		For ClsID = 1 To SelClasses.Count
			Subclasses.AddCollection GetSubclasses( SelClasses.GetAt(ClsID) )
		Next ClsID
	End If 

	Set GetSubclasses = Subclasses

End Function

Function GetNamespace( theClass As Class ) As String

	GetNamespace = "unknown"

	If theClass Is Nothing Then
		Exit Function
	End If

	Dim thePackage As Category
	Set thePackage = theClass.ParentCategory

	While Not thePackage Is Nothing
		If Trim$(thePackage.FindProperty("UGAS","xmlns").Value) <> "" Then
			GetNamespace = Trim$(thePackage.FindProperty("UGAS","xmlns").Value)
			Set thePackage = Nothing
		Else
			Set thePackage = thePackage.ParentCategory
		End If
	Wend

End Function

Sub UpdateClassIM( c As Class )

	Dim ir As InheritRelation
	Select Case c.name
	Case "AD_PunktCoverage"
		Set ir = c.AddInheritRel ("", "CV_DiscreteGridPointCoverage")
	Case "AD_GitterCoverage"
		Set ir = c.AddInheritRel ("", "CV_DiscretePointCoverage")
	End Select 

	If (c.stereotype = "enumeration" Or c.stereotype = "Enumeration") And (Left(c.name,5) = "AX_LI" Or Left(c.name,5) = "AX_DQ") Then
		IsOverridden = c.OverrideProperty ("UGAS", "xsdEncodingRule", "iso19139_2007")
	End If 

	If (c.name="AX_Datenerhebung" Or c.name="AX_Datenerhebung_Punktort") Then
		IsOverridden = c.OverrideProperty ("UGAS", "xsdEncodingRule", "iso19139_2007")
	End If

	Select Case c.stereotype
	Case "FeatureType", "Request", "Response"
		IsOverridden = c.OverrideProperty ("UGAS", "noPropertyType", "true")
		IsOverridden = c.OverrideProperty ("UGAS", "byValuePropertyType", "false")
		IsOverridden = c.OverrideProperty ("UGAS", "isCollection", "false")
	Case "DataType", "Union", ""
		IsOverridden = c.OverrideProperty ("UGAS", "noPropertyType", "false")
		IsOverridden = c.OverrideProperty ("UGAS", "byValuePropertyType", "false")
		IsOverridden = c.OverrideProperty ("UGAS", "isCollection", "false")
	Case "CodeList"
		IsOverridden = c.OverrideProperty ("UGAS", "asDictionary", "true")
	End Select

	Select Case c.stereotype
	Case "FeatureType", "DataType", "Request", "Response", "Type", "Union", ""
		If c.Attributes.Count > 0 Then
			For i% = 1 To c.Attributes.Count
				Call UpdateAttributeIM(c, c.Attributes.GetAt(i%))
			Next i%
		End If
		If c.GetAssociateRoles().Count > 0 Then
			For i% = 1 To c.GetAssociateRoles().Count
				Call UpdateRoleIM(c, c.GetAssociateRoles().GetAt(i%))
			Next i%
		End If
		Dim b As Boolean 
		Do While (c.Operations.Count>0)
			b = c.DeleteOperation(c.Operations.GetAt(1))
		Loop
	End Select

End Sub

Sub UpdateClassIM2( c As Class )

	If c.stereotype = "Type" Then
		Dim Targetclasses As ClassCollection
		Set Targetclasses = GetSubclasses(c)
		If Targetclasses.Count > 0 Then
		 	For ClsID = 1 To Targetclasses.Count
		 		Dim sc As Class
		 		Set sc = Targetclasses.GetAt(ClsID)
				If c.Attributes.Count > 0 Then
					For i% = 1 To c.Attributes.Count
						Call CloneAttribute(c.Attributes.GetAt(i%),sc)
					Next i%
				End If
				If c.GetAssociateRoles().Count > 0 Then
					For i% = 1 To c.GetAssociateRoles().Count
						Call CloneAssociation(c.GetAssociateRoles().GetAt(i%),sc)
					Next i%
				End If
			Next ClsID
		End If
	End If

End Sub

Sub CloneTaggedValues( e1 as Element, e2 as Element, t As String )
	Dim p As Property
	Dim b As Boolean
	For i% = 1 To e1.GetToolProperties(t).Count
		Set p = e1.GetToolProperties(t).GetAt(i%)
		If Not p Is Nothing Then
			If e1.IsOverriddenProperty (t, p.Name) Then 
				b = e2.OverrideProperty (t, p.Name, p.value)
			End If
		End If
	Next i%
End sub

Sub CloneInfo( e1 As RoseItem, e2 As RoseItem)
	e2.documentation = e1.documentation 
	e2.stereotype = e1.stereotype
	Call CloneTaggedValues( e1, e2, "AAA" )
	Call CloneTaggedValues( e1, e2, "UGAS" )
End sub

Sub CloneAttribute( att As Attribute, cl as Class)
	Dim natt As Attribute
	Set natt = cl.AddAttribute (att.name, att.type, att.initvalue)
	Call CloneInfo( att, natt )
End Sub

Sub CloneAssociation( r1 As Role, cl As Class)
	Dim nass As Association
	Dim r2 As Role
	Dim nr1 As Role
	Dim nr2 As Role
	If r1.association.role1.suppliername = r1.suppliername Then
		Set r2 = r1.association.role2
	else
		Set r2 = r1.association.role1
	end if
	Set nass = cl.AddAssociation (r1.name, r1.Class.name)
	Set nr1 = nass.GetOtherRole(cl)
	Set nr2 = nass.GetCorrespondingRole(cl)
	nr1.Navigable = r1.Navigable
	nr2.Navigable = r2.Navigable
	nr1.Cardinality = r1.Cardinality
	nr2.Cardinality = r2.Cardinality
	If r2.Cardinality = "1" Then
		nr2.Cardinality = "0..1"
	ElseIf r2.Cardinality = "1..2" Then
		nr2.Cardinality = "0..2"
	ElseIf r2.Cardinality = "1..*" Then
		nr2.Cardinality = "0..*"
	End If
	nr2.name = r2.name + "_" + cl.name
	Call CloneInfo( r1, nr1 )
	Call CloneInfo( r2, nr2 )
	Call SetRelProperty( cl.name, nr1.name, "sequenceNumber", Cstr(SeqNo) )
	SeqNo = SeqNo + 1
	Call SetRelProperty( nr1.Class.name, nr2.name, "sequenceNumber", Cstr(SeqNo) )
	SeqNo = SeqNo + 1
End Sub

Sub SwitchRole( r As Role, s as string )
	Dim rx as Role
	if r.association.role1.suppliername = r.suppliername then
		set rx = r.association.role2
	else
		set rx = r.association.role1
	end if
	r.suppliername = "AA_Objekt"
	call SetRelProperty( rx.suppliername, r.name, "allowedTypesNAS", s )
End Sub

Sub MovePackage( cn As String, cn2 As String )
	Dim pa As Category
	Dim pa2 As Category
	i% = AllPackages.FindFirst (cn)
	If i% > 0 Then
		Set pa = AllPackages.GetAt(i%)
		i% = AllPackages.FindFirst (cn2)
		If i% > 0 Then
			Set pa2 = AllPackages.GetAt(i%)
			pa2.relocateCategory pa
		Else
			Print "***** Fehler! Paket nicht gefunden: ", cn2
		End If
	Else
		Print "***** Fehler! Paket nicht gefunden: ", cn
	End If
End Sub

Sub MoveClass( cn As String, pn As String )
	Dim c As Class
	Dim pa As Category
	i% = AllClasses.FindFirst (cn)
	If i% > 0 Then
		Set c = AllClasses.GetAt(i%)
		i% = AllPackages.FindFirst (pn)
		If i% > 0 Then
			Set pa = AllPackages.GetAt(i%)
			pa.relocateClass c
		Else
			Print "***** Fehler! Paket nicht gefunden: ", pn
		End If
	Else
		Print "***** Fehler! Klasse nicht gefunden: ", cn
	End If
End Sub

Sub UpdatePackageIM( c As Category )
	b = c.Uncontrol()
	While c.ScenarioDiagrams.Count > 0
		b = c.DeleteScenarioDiagram(c.ScenarioDiagrams.GetAt(1))
	Wend
End Sub

Sub Main

	If RoseApp.CurrentModel.FindProperty("AAA","Version").Value <> QuellVersion Then
		MsgBox "Die Version dieses Skripts passt nicht zu der Version des AFIS-ALKIS-ATKIS-Modells. " + _
		       "Erwartet wurde Version " + QuellVersion + _
			   ", gefunden wurde Version " + RoseApp.CurrentModel.FindProperty("AAA","Version").Value + _
			   ". Die Ausführung des Skripts wird abgebrochen."
		Exit Sub
	End If

	Set AllClasses = New ClassCollection
	For i% = 1 To RoseApp.CurrentModel.GetAllCategories.Count
		AllClasses.AddCollection RoseApp.CurrentModel.GetAllCategories.GetAt(i%).Classes 
	Next i%

	Set AllPackages = New CategoryCollection
	AllPackages.AddCollection RoseApp.CurrentModel.GetAllCategories

	Set AAAClasses = New ClassCollection
	Dim pa As Category
	i% = AllPackages.FindFirst ("AFIS-ALKIS-ATKIS Anwendungsschema")
	If i% > 0 Then
		Set pa = AllPackages.GetAt(i%)
		For i% = 1 To pa.GetAllCategories.Count
			AAAClasses.AddCollection pa.GetAllCategories.GetAt(i%).Classes 
		Next i%
	Else
		Print "***** Fehler! Paket nicht gefunden: AFIS-ALKIS-ATKIS Anwendungsschema"
	End If

	Viewport.Open

	SeqNo = 25000

	For i% = 1 To AllPackages.Count
		Call UpdatePackageIM( AllPackages.GetAt(i%) )
	Next i%

	Call MoveClass( "CharacterString", "ISO19100" )
	Call MoveClass( "Measure", "ISO19100" )
	Call MoveClass( "CV_DiscretePointCoverage", "ISO19100" ) 
	i% = AllClasses.FindFirst ("CV_DiscretePointCoverage")
	If i% > 0 Then
		AllClasses.GetAt(i%).stereotype = "FeatureType"
	Else
		Print "***** Fehler! Klasse nicht gefunden: CV_DiscretePointCoverage"
	End If
	Call MoveClass( "CV_DiscreteGridPointCoverage", "ISO19100" ) 
	i% = AllClasses.FindFirst ("CV_DiscreteGridPointCoverage")
	If i% > 0 Then
		AllClasses.GetAt(i%).stereotype = "FeatureType"
	Else
		Print "***** Fehler! Klasse nicht gefunden: CV_DiscreteGridPointCoverage"
	End If

	Call DeletePackage("AAA_Katalog")
	Call DeletePackage("AAA Versionierungsschema")
	Call DeletePackage("ISO 19103 Conceptual Schema Language")
	Call DeletePackage("ISO 19107 Spatial Schema")
	Call DeletePackage("ISO 19108 Temporal")
	Call DeletePackage("ISO 19109 Rules for Application Schema")
	Call DeletePackage("ISO 19110 Feature Cataloging")
	Call DeletePackage("ISO 19111 Spatial Referencing by Coordinates")
	Call DeletePackage("ISO 19115 Metadata")
	Call DeletePackage("ISO 19123 Coverages")
	Call DeletePackage("ISO 19136 GML")
	Call DeletePackage("Spatial Examples from ISO 19107")

	Call DeleteClass("AA_ObjektOhneRaumbezug")

	Call DeleteClass("AA_Liniengeometrie")
	Call DeleteClass("AA_Flaechengeometrie")
	Call DeleteClass("AU_Geometrie")
	Call DeleteClass("AG_Geometrie")
	Call DeleteClass("AA_Punktgeometrie")
	Call DeleteClass("AU_Geometrie_3D")
	Call DeleteClass("AA_Punktgeometrie_3D")
	Call DeleteClass("AA_MehrfachLinienGeometrie_3D")
	Call DeleteClass("AA_MehrfachFlaechenGeometrie_3D")
	Call DeleteClass("AA_PunktLinienThema")
	Call DeleteClass("TA_TopologieThema_3D")
	'Call DeleteClass("TS_PointComponent")
	Call AddAttribute("TA_PointComponent","position","GM_Point")
	Call AddAttribute("TA_PointComponent_3D","position","GM_Point")
	'Call DeleteClass("TS_CurveComponent")
	Call AddAttribute("TA_CurveComponent","position","GM_Curve")
	Call AddAttribute("TA_CurveComponent_3D","position","GM_Curve")
	'Call DeleteClass("TS_SurfaceComponent")
	Call AddAttribute("TA_SurfaceComponent","position","GM_Surface")
	Call AddAttribute("TA_SurfaceComponent_3D","position","GM_Surface")
	'Call DeleteClass("TS_Feature")
	Call AddAttribute("TA_MultiSurfaceComponent","position","GM_Object") ' Constraint: Surface oder MultiSurface
	Call AddAttribute("TA_CompositeSolidComponent_3D","position","GM_CompositeSolid")

	Call DeleteAttribute("AA_Objekt","identifikator")

	Call ChangeType( "AU_Punkthaufenobjekt", "position", "GM_MultiPoint" )
	Call ChangeType( "AU_KontinuierlichesLinienobjekt", "position", "GM_Curve" )
	Call ChangeType( "AU_Flaechenobjekt", "position", "GM_Object" ) ' Constraint: Surface oder MultiSurface
	Call ChangeType( "AG_Flaechenobjekt", "position", "GM_Object" ) ' Constraint: Surface oder MultiSurface

	Call ChangeType( "AG_Punktobjekt", "position", "GM_Point" )

	Call ChangeType( "AU_Objekt", "position", "GM_Object" ) ' Constraint: Nicht alle Subtypen sind erlaubt
	Call ChangeType( "AG_Objekt", "position", "GM_Object" ) ' Constraint: Nicht alle Subtypen sind erlaubt
	Call ChangeType( "AU_GeometrieObjekt_3D", "position", "GM_Object" ) ' Constraint: Nicht alle Subtypen sind erlaubt
	Call ChangeType( "AU_MehrfachLinienObjekt_3D", "position", "GM_Object" ) ' Constraint: Nicht alle Subtypen sind erlaubt
	Call ChangeType( "AU_MehrfachFlaechenObjekt_3D", "position", "GM_Object" ) ' Constraint: Nicht alle Subtypen sind erlaubt
	Call ChangeType( "AU_UmringObjekt_3D", "position", "GM_MultiCurve" ) 
	Call ChangeType( "AU_PunkthaufenObjekt_3D", "position", "GM_MultiPoint" )

	Call ChangeType( "AA_Objekt", "modellart", "AA_Modellart" )
	Call ChangeAttname( "AA_Objekt", "modellart", "modellart [1..*]" )
	Call ChangeType( "AA_Objekt", "anlass [0..1]", "AA_Anlassart" )
	Call ChangeAttname( "AA_Objekt", "anlass [0..1]", "anlass [0..2]" )
	Call ChangeType( "AA_Objekt", "zeigtAufExternes [0..1]", "AA_Fachdatenverbindung" )
	Call ChangeAttname( "AA_Objekt", "zeigtAufExternes [0..1]", "zeigtAufExternes [0..*]" )

	Call DeleteClass( "AX_LI_Lineage_OhneDatenerhebung" )
	Call DeleteClass( "AX_LI_Lineage_MitDatenerhebung" )
	Call DeleteClass( "AX_LI_Lineage_Punktort" )

	Call DeleteClass( "AX_LI_ProcessStep_OhneDatenerhebung" )
	Call DeleteClass( "AX_LI_ProcessStep_MitDatenerhebung" )
	Call DeleteClass( "AX_LI_ProcessStep_Punktort" )

'	Call DeleteClass( "AX_LI_ProcessStep_OhneDatenerhebung_Description" )
'	Call DeleteClass( "AX_LI_ProcessStep_MitDatenerhebung_Description" )
'	Call DeleteClass( "AX_LI_ProcessStep_Punktort_Description" )

	Call DeleteClass( "AX_LI_Source_MitDatenerhebung" )
	Call DeleteClass( "AX_LI_Source_Punktort" )

	Call ChangeType( "AX_DQOhneDatenerhebung", "herkunft [0..1]", "LI_Lineage" )
	Call ChangeType( "AX_DQMitDatenerhebung", "herkunft [0..1]", "LI_Lineage" )
	Call ChangeType( "AX_DQPunktort", "herkunft [0..1]", "LI_Lineage" )

	Call DeleteClass( "AX_Fortfuehrung" )
	Call DeleteClass( "AX_Datenbank" )
	Call DeleteClass( "AX_Operation_Datenbank" )
	Call DeleteClass( "AX_TemporaererBereich" )
	Call DeleteClass( "AX_NeuesObjekt" )
	Call DeleteClass( "AX_GeloeschtesObjekt" )
	Call DeleteClass( "AX_AktualisiertesObjekt" )
	Call DeleteClass( "AX_Fortfuehrungsobjekt" )

	Call DeleteRole("AA_Objekt","antrag")
	Call DeleteRole("TA_MultiSurfaceComponent","masche")
	Call DeleteRole("TA_CompositeSolidComponent_3D","koerper")

	Call AddAttribute("AA_Antrag","art","GenericName")
	Call AddAttribute("AA_Projektsteuerung","art","GenericName")
	Call AddAttribute("AA_Vorgang","art","GenericName")
	Call AddAttribute("AA_Aktivitaet","art","GenericName")
	Call DeleteClass( "AA_Antragsart" )
	Call DeleteClass( "AA_Projektsteuerungsart" )
	Call DeleteClass( "AA_Vorgangsart" )
	Call DeleteClass( "AA_Aktivitaetsart" )
	Call DeleteClass( "AA_Projektsteuerungskatalog" )
	Call DeleteClass( "AA_AktivitaetInVorgang" )
	Call DeleteClass( "AA_VorgangInProzess" )
	Call DeleteClass( "AA_Dokumentationsbedarf" )
	Call DeleteClass( "AA_DurchfuehrungAktivitaet" )
	Call DeleteClass( "AA_ProzesszuordnungAktivitaet" )
	
	Call DeleteAttribute("AA_PMO","ausdehnung")
	Call DeleteAttribute("AD_PunktCoverage","geometrie")
	Call DeleteAttribute("AD_PunktCoverage","werte")
	Call DeleteClass( "AD_ReferenzierbaresGitter" )
	Call DeleteClass( "AD_Wertematrix" )
	
	Call ChangeType( "DCP", "HTTP", "URI" )
	Call ChangeType( "DCP", "email", "URI" )
	Call ChangeType( "AX_Schwereanomalie_Schwere", "wert", "Measure" )
	Call DeleteClass( "Acceleration" )

	Call DeleteClass( "AA_UUID" )
	Call ChangeType( "ExceptionFortfuehrung", "bereitsGesperrteObjekte [0..*]", "URI" )
	Call ChangeType( "ExceptionFortfuehrung", "nichtMehrAktuelleObjekte [0..*]", "URI" )
	Call ChangeType( "AX_Sperrauftrag", "uuidListe [1..*]", "URI" )
	Call ChangeType( "AX_Entsperrauftrag", "uuidListe [1..*]", "URI" )
	Call ChangeType( "ExceptionAAAEntsperren", "uuidListe [0..*]", "URI" )
	Call ChangeType( "ExceptionAAAFortfuehrungOderSperrung", "bereitsGesperrteObjekte [0..*]", "URI" )
	Call ChangeType( "ExceptionAAAFortfuehrungOderSperrung", "nichtMehrAktuelleObjekte [0..*]", "URI" )

	For i% = 1 To AAAClasses.Count
		Call UpdateClassIM( AAAClasses.GetAt(i%) )
	Next i%

	For i% = 1 To AAAClasses.Count
		Call UpdateClassIM2( AAAClasses.GetAt(i%) )
	Next i%

	Call DeleteClass("AP_GPO")
	Call DeleteClass("AP_TPO")
	Call DeleteClass("AX_Katalogeintrag")
	Call DeleteClass("AX_BauwerkeEinrichtungenUndSonstigeAngaben")
	Call DeleteClass("AX_Punktort")
	Call DeleteClass("AX_Flurstueck_Kerndaten")
	Call DeleteClass("AA_Objektliste")
	Call DeleteClass("AX_Auftrag")
	Call DeleteClass("AX_Ergebnis")
	Call DeleteClass("AX_AuftragEinrichtungOderFortfuerung")

	Dim cl1 As Class
	Dim cl2 As Class
	Dim cl3 As Class
	Dim cl4 As Class
	i% = AllClasses.FindFirst ("AA_Objekt")
	If i% > 0 Then
		Set cl1 = AllClasses.GetAt(i%)
	Else
		Print "***** Fehler! Klasse nicht gefunden: AA_Objekt"
	End If
	i% = AllClasses.FindFirst ("AA_PMO")
	If i% > 0 Then
		Set cl2 = AllClasses.GetAt(i%)
	Else
		Print "***** Fehler! Klasse nicht gefunden: AA_PMO"
	End If
	i% = AllClasses.FindFirst ("AD_PunktCoverage")
	If i% > 0 Then
		Set cl3 = AllClasses.GetAt(i%)
	Else
		Print "***** Fehler! Klasse nicht gefunden: AD_PunktCoverage"
	End If
	i% = AllClasses.FindFirst ("AD_GitterCoverage")
	If i% > 0 Then
		Set cl4 = AllClasses.GetAt(i%)
	Else
		Print "***** Fehler! Klasse nicht gefunden: AD_GitterCoverage"
	End If

	For i% = 1 To cl1.Attributes.Count
		Call CloneAttribute(cl1.Attributes.GetAt(i%),cl3)
		Call CloneAttribute(cl1.Attributes.GetAt(i%),cl4)
	Next i%
	For i% = 1 To cl2.Attributes.Count
		Call CloneAttribute(cl2.Attributes.GetAt(i%),cl3)
		Call CloneAttribute(cl2.Attributes.GetAt(i%),cl4)
	Next i%

	Call DeleteClass("AA_PMO")

	Call ChangeType( "AX_Phasenzentrumsvariation_Referenzstationspunkt", "zeile [72..72]", "doubleList" )
	Call DeleteClass("AX_Phasenzentrumsvariation_Referenzstationspunkt_Zeile")

	'ShapeChange Konfigurationsdatei wurde um AAA-spezifische Einträge erweitert

End Sub