Rivet - Assembly

[martinhoos]

Hi Forum, at first, i am a noob about ilogic, i always stick together differnet code and hope that it works.

I put day by day many rivets in parts (that is boring), my idea is: i call a code, that code ask me about a part (rivet that is place in) and about a area. After that the code checks the area and find all the holes that are equal with the hole where the rivet is stored in. The code place at all the same holes other rivets. That will save me a lot of time.

Is there anybody who has similar code for that?  Btw i work with Inventor 2015.

Thanks a lot and i appreciate any help.

Regards Martin

[Owner2229]

Hi, are you ussing rivets form Content Center? If yes, you can use the AutoDrop function, here is how:

Place components using AutoDrop

Here is where you can find it in Content Center:

[martinhoos]

Hi Mike,

thank you very much for the reply. To my knowledge, Autodrop will not work with rivets?! Did Autodesk fixed that problem? We are working with Inventor 2015.

Therefore i ask for that code....

Regards Martin

[adam.nagy]

Hi,

According to the help file, even Inventor 2017 does not include that:
https://knowledge.autodesk.com/support/inventor-products/learn-explore/caas/CloudHelp/cloudhelp/2017...

The following components can be placed with AutoDrop: Bolts (except Bolts Other), 
nuts, washers (except ball washers), clevis pins, bearings, and circlips.

I think you should be able to place multiple instances of the same CC component and then constrain them programmatically. 

Cheers, 

[adam.nagy]

Also wanted to provide this link which might be useful:
http://adndevblog.typepad.com/manufacturing/2013/06/insert-content-center-part.html

[martinhoos]

Thanks for reply, bad news to hear that it´s not include with 2017!  I do not have an idea to start with that code that will fix my problem...  😞

[adam.nagy]

Hi,

Maybe this could be of help?

http://adndevblog.typepad.com/manufacturing/2016/05/insert-copies-of-content-center-parts.html

Cheers,

[martinhoos]

Hi Adam,

thanks for reply and for your code. I tried the code but i do not get the code runs!?

I placed a rivet with constraints in a hole and select the rivet and two other holes. Than i start your code. It quits with a run time messege 13  and a yellos row in the code: For Each h In fs

What did i wrong? Did your code only works with content center parts?

Thank you for your help.

Regards

Martin

[adam.nagy]

First you have to select the current rivet instance (ComponentOccurrence object), then add to the selection the faces of the holes (Face objects).

Based on the error you are getting the SelectSet(2..n) objects are not faces.

[martinhoos]

Hi Adam,

your code:

http://adndevblog.typepad.com/manufacturing/2016/05/insert-copies-of-content-center-parts.html

works fine - but with your own words: "I think based on this someone could create a nice Inventor App Store plugin - hint, hint ;)"

There are two points that i like to change:

First - I have to put the constraints from the lower side - otherwise it will not work?!

Second - It is a lot of work to select the holes - better if i can select the area where the holes are in.

Maybe there is one, who can modify the code.

Thank you very much Adam.

Regards Martin

[dg2405 · Accepted solution]

Here is the Code:

Public Sub Sonstige_Teile_setzen()
    
    On Error GoTo Ende
    
    'Auf Bg zugreifen
    Dim oApp As Inventor.Application
    Set oApp = ThisApplication
    Dim oAsmDoc As AssemblyDocument
    Set oAsmDoc = oApp.ActiveDocument
    Dim oAsmCompDef As AssemblyComponentDefinition
    Set oAsmCompDef = oAsmDoc.ComponentDefinition
    
    'Linie greifen
    Dim oNormteilKreis As EdgeProxy
    Set oNormteilKreis = ThisApplication.CommandManager.Pick(kPartEdgeCircularFilter, "Kreis von Normteil auswählen")
    'Occurrence ermitteln
    Dim oNormteilOcc As Inventor.ComponentOccurrence
    Set oNormteilOcc = oNormteilKreis.Parent.Parent
    
       
    'Kreis von Fläche greifen
    Dim oFlächenKreisProxy As EdgeProxy
    Set oFlächenKreisProxy = ThisApplication.CommandManager.Pick(kPartEdgeCircularFilter, "Kreis von Fläche auswählen")
    'Fläche von Kreis ermitteln
    Dim oFaceProxy As FaceProxy
    For Each oFaceProxy In oFlächenKreisProxy.Faces
        If oFaceProxy.SurfaceType = kPlaneSurface Then Exit For
    Next
    'Bohrungsdurchmesser von Kreis
    Dim Bohrungsdurchmesser As Double
    Bohrungsdurchmesser = Round(oFlächenKreisProxy.Geometry.Radius * 20, 3)
    'Occ von Fläche
    Dim oFlächenOcc As ComponentOccurrence
    Set oFlächenOcc = oFlächenKreisProxy.ContainingOccurrence


    'Check for identisch Faces
    Dim oCircleCollection As ObjectCollection
    Set oCircleCollection = ThisApplication.TransientObjects.CreateObjectCollection
    Dim oOcc As ComponentOccurrence
    For Each oOcc In oAsmCompDef.Occurrences
        If oOcc.Name <> oFlächenOcc.Name And oOcc.Name <> oNormteilOcc.Name Then
            Dim oBodyProxy As SurfaceBodyProxy
            For Each oBodyProxy In oOcc.SurfaceBodies
                Dim oBodyFaceProxy As Face
                For Each oBodyFaceProxy In oBodyProxy.Faces
                    If oBodyFaceProxy.SurfaceType = kPlaneSurface Then
                        On Error Resume Next
                        If oApp.MeasureTools.GetAngle(oBodyFaceProxy, oFaceProxy) = 0 And oApp.MeasureTools.GetMinimumDistance(oBodyFaceProxy, oFaceProxy) = 0 Then
                            On Error GoTo 0
                            Dim oCircleProxy As EdgeProxy
                            For Each oCircleProxy In oBodyFaceProxy.Edges
                                If oCircleProxy.GeometryType = kCircleCurve Then
                                    Call oAsmDoc.SelectSet.Select(oCircleProxy)
                                    If Round(oCircleProxy.Geometry.Radius * 20, 3) = Bohrungsdurchmesser Then
                                        Call oCircleCollection.Add(oCircleProxy)
                                    End If
                                End If
                            Next
                        End If
                        On Error GoTo 0
                    End If
                Next
            Next
        End If
    Next

    
    'Kreise zählen
    Dim oCircleOnFace As Edge
    AnzahlKreise = 0
    For Each oCircleOnFace In oFaceProxy.Edges
        If oCircleOnFace.GeometryType = kCircleCurve Then
            If oCircleOnFace.Geometry.Radius * 20 = Bohrungsdurchmesser Then
                    For i = 1 To oCircleCollection.Count
                        If oApp.MeasureTools.GetMinimumDistance(oCircleCollection(i), oCircleOnFace) = 0 Then GoTo NextCircle
                    Next
                    Dim oFile As String
                    oFile = oNormteilOcc.Definition.Document.FullFileName
                    Dim oTG As TransientGeometry
                    Set oTG = ThisApplication.TransientGeometry
                    Dim oMatrix As Matrix
                    Set oMatrix = oTG.CreateMatrix
                    Set oNormteilOcc = oAsmCompDef.Occurrences.Add(oFile, oMatrix)
                    Dim oNativeExpanderKreis As Edge
                    Set oNativeExpanderKreis = oNormteilKreis.NativeObject
                    Dim oEdge As Edge
                    For Each oEdge In oNormteilOcc.Definition.SurfaceBodies.Item(1).Edges
                        If oEdge Is oNativeExpanderKreis Then
                             Exit For
                        End If
                    Next
                    Dim oEdgeProxy As EdgeProxy
                    Call oNormteilOcc.CreateGeometryProxy(oEdge, oEdgeProxy)
                    Call oAsmCompDef.Constraints.AddInsertConstraint(oEdgeProxy, oCircleOnFace, True, 0)
            End If
        End If
NextCircle:
    Next
Ende:
End Sub

[martinhoos]

Well done! Thanks a lot.

Regards Martin

[GeorgK]

Great. Is saves a lot of time! Is it possible to get a preview for the direction and change it if it does not fit?

[dg2405 · Accepted solution]

Here is a another Version:

-Support for placing all dependent parts

-Allready constraint holes will be not considerd

Public oAllOccsCollection As ObjectCollection
Public oAllCOnstraintsCollection As ObjectCollection
Public Sub Teile_platzieren()
    
    On Error GoTo Ende
    
    'Auf Bg zugreifen
    Dim oApp As Inventor.Application
    Set oApp = ThisApplication
    Dim oAsmDoc As AssemblyDocument
    Set oAsmDoc = oApp.ActiveDocument
    Dim oAsmCompDef As AssemblyComponentDefinition
    Set oAsmCompDef = oAsmDoc.ComponentDefinition
    
    'Kreis greifen
    Dim oNormteilKreis As EdgeProxy
    Set oNormteilKreis = ThisApplication.CommandManager.Pick(kPartEdgeCircularFilter, "Kreis von Normteil auswählen")
    'Occurrence ermitteln
    Dim oNormteilOcc As Inventor.ComponentOccurrence
    Set oNormteilOcc = oNormteilKreis.Parent.Parent
    
    'Maximale Kreisfläche ermitteln
    Dim oMaxCircFace As Face
    Dim myList As Object
    Set myList = CreateObject("System.Collections.ArrayList")
    For Each oMaxCircFace In oNormteilOcc.SurfaceBodies.Item(1).Faces
        If oMaxCircFace.SurfaceType = kCylinderSurface Then
            myList.Add (oMaxCircFace.Geometry.Radius)
        End If
    Next
    myList.Sort
    For Each oMaxCircFace In oNormteilOcc.SurfaceBodies.Item(1).Faces
        If oMaxCircFace.SurfaceType = kCylinderSurface Then
            If oMaxCircFace.Geometry.Radius = myList.Item(myList.Count - 1) Then
                Exit For
            End If
        End If
    Next
    Dim Durchmesser As Double
    Durchmesser = Round(oMaxCircFace.Geometry.Radius * 20, 3)
    
    'Alle Zusammenhängenden Occs in Collection
    Set oAllCOnstraintsCollection = ThisApplication.TransientObjects.CreateObjectCollection
    Set oAllOccsCollection = ThisApplication.TransientObjects.CreateObjectCollection
    Call oAllOccsCollection.Add(oNormteilOcc)
    Call SearchAllOccsInOcc(oNormteilOcc, 1)
        
    'Kreis von Fläche greifen
    Dim oFlächenKreisProxy As EdgeProxy
    Set oFlächenKreisProxy = ThisApplication.CommandManager.Pick(kPartEdgeCircularFilter, "Kreis von Fläche auswählen")
    'Fläche von Kreis ermitteln
    Dim oFaceProxy As FaceProxy
    For Each oFaceProxy In oFlächenKreisProxy.Faces
        If oFaceProxy.SurfaceType = kPlaneSurface Then Exit For
    Next
    If oFaceProxy Is Nothing Then Exit Sub
    'Bohrungsdurchmesser von Kreis
    Dim Bohrungsdurchmesser As Double
    Bohrungsdurchmesser = Round(oFlächenKreisProxy.Geometry.Radius * 20, 3)
    'Occ von Fläche
    Dim oFlächenOcc As ComponentOccurrence
    Set oFlächenOcc = oFlächenKreisProxy.ContainingOccurrence
    
    'Alle Edges der Constraints in Collection schreiben
    Dim oConstraintEdgesColection As ObjectCollection
    Set oConstraintEdgesColection = ThisApplication.TransientObjects.CreateObjectCollection
    For Each oConstraint In oFlächenOcc.Constraints
        If oConstraint.Type = kInsertConstraintObject Then
            If Round(oConstraint.EntityOne.Geometry.Radius * 20, 3) = Bohrungsdurchmesser _
            Or Round(oConstraint.EntityTwo.Geometry.Radius * 20, 3) = Bohrungsdurchmesser Then
                Call oConstraintEdgesColection.Add(oConstraint.EntityOne)
                Call oConstraintEdgesColection.Add(oConstraint.EntityTwo)
            End If
        End If
    Next
    
    'Kreise zählen
    Dim oCircleOnFaceProxy As EdgeProxy
    AnzahlKreise = 0
    For Each oCircleOnFaceProxy In oFaceProxy.Edges
        For i = 1 To oConstraintEdgesColection.Count
            If oConstraintEdgesColection(i) Is oCircleOnFaceProxy Then
                GoTo NextCircle
            End If
        Next
        ' Occurrence count originally
        Dim occCount As Integer
        occCount = oAsmCompDef.Occurrences.Count
        If oCircleOnFaceProxy.GeometryType = kCircleCurve Then
            If Round(oCircleOnFaceProxy.Geometry.Radius * 20, 3) = Bohrungsdurchmesser Then
                Call oAsmDoc.SelectSet.SelectMultiple(oAllOccsCollection)
                ThisApplication.CommandManager.ControlDefinitions.Item("AppCopyCmd").Execute
                ThisApplication.CommandManager.ControlDefinitions.Item("AppPasteCmd").Execute
                
                'New originOcc ermitteln
                Dim found As Boolean
                found = False
                For i = occCount + 1 To oAsmCompDef.Occurrences.Count
                    If oAsmCompDef.Occurrences(i).Definition.Document.PropertySets("Design Tracking Properties").Item("Part Number").value _
                    = oNormteilOcc.Definition.Document.PropertySets("Design Tracking Properties").Item("Part Number").value Then
                        Dim oNewNormteilOcc As ComponentOccurrence
                        Set oNewNormteilOcc = oAsmCompDef.Occurrences(i)
                    End If
                Next
                
                Dim oNativeExpanderKreis As Edge
                Set oNativeExpanderKreis = oNormteilKreis.NativeObject
                For Each oEdge In oNewNormteilOcc.Definition.SurfaceBodies.Item(1).Edges
                    If oEdge Is oNativeExpanderKreis Then
                         Exit For
                    End If
                Next
                Dim oEdgeProxy As EdgeProxy
                Call oNewNormteilOcc.CreateGeometryProxy(oEdge, oEdgeProxy)
                If Durchmesser <= Round(oCircleOnFaceProxy.Geometry.Radius * 20, 3) Then
                    Call oAsmCompDef.Constraints.AddInsertConstraint(oEdgeProxy, oCircleOnFaceProxy, False, 0)
                Else
                    Call oAsmCompDef.Constraints.AddInsertConstraint(oEdgeProxy, oCircleOnFaceProxy, True, 0)
                End If
            End If
        End If
NextCircle:
    Next
Ende:
End Sub
Public Function SearchAllOccsInOcc(Occurrence As ComponentOccurrence, Level As Integer)
    Dim oConstraint As AssemblyConstraint
    For Each oConstraint In Occurrence.Constraints
        Dim ConstraintVorhanden As Boolean
        ConstraintVorhanden = False
        For i = 1 To oAllCOnstraintsCollection.Count
            If oConstraint Is oAllCOnstraintsCollection(i) Then
                ConstraintVorhanden = True
                Exit For
            End If
        Next
        Call oAllCOnstraintsCollection.Add(oConstraint)
        Dim oOcc As ComponentOccurrence
        Set oOcc = oConstraint.AffectedOccurrenceOne
        Call oAllOccsCollection.Add(oConstraint.AffectedOccurrenceOne)
        If ConstraintVorhanden = False Then Call SearchAllOccsInOcc(oOcc, 1)
        '------------------------------------------------
        Set oOcc = oConstraint.AffectedOccurrenceTwo
        Call oAllOccsCollection.Add(oConstraint.AffectedOccurrenceTwo)
        If ConstraintVorhanden = False Then Call SearchAllOccsInOcc(oOcc, 1)
    Next
End Function

[GeorgK]

Great! 🙂

[martinhoos]

Daniel again, great work!  Thank you...

[Andrew.M.Brodsky]

Is there any guidance no how to use this VBA Code?  When I run the macro I am prompted to select a circle and then the VBA code seems to just end and nothing happens.

[dg2405]

Here is a code for iLogic with several improvements, please try and give me respond if it work.

Imports System
AddReference "System.Drawing.dll"
Imports System.Windows.Forms
Class Teile_platzieren

Dim oAllOccsCollection As ObjectCollection
Dim oAllCOnstraintsCollection As ObjectCollection
Private ExitSub As Boolean = False
Private IsMateConst As Boolean = True
Dim oCurrentTopOcc As ComponentOccurrence

Sub Main()

'Auf Bg zugreifen
Dim oApp As Inventor.Application = ThisApplication
Dim oAsmDoc As AssemblyDocument = oApp.ActiveDocument
Dim oAsmCompDef As AssemblyComponentDefinition = oAsmDoc.ComponentDefinition
Dim oMasterAsmCompDef As AssemblyComponentDefinition = oAsmCompDef
'Wenn unterbaugruppe in Bearbeitung ist, dann Fokus auf aktive Occurrence legen
If Not oAsmCompDef.ActiveOccurrence Is Nothing Then
    oAsmCompDef = oAsmCompDef.ActiveOccurrence.Definition
    oAsmDoc = oAsmCompDef.Document
End If

'Pos. 1 aktivieren wenn nicht Aktiv
If oAsmCompDef.RepresentationsManager.ActivePositionalRepresentation.Master=False Then oAsmCompDef.RepresentationsManager.PositionalRepresentations(1).Activate

'Kreis von Normteil/Fläche greifen
Dim oNormteilKreisProxy As EdgeProxy = oApp.CommandManager.Pick(kPartEdgeCircularFilter, "Kreis von Normteil auswaehlen")
If oNormteilKreisProxy Is Nothing Then Exit Sub
'If oNormteilKreisProxy.GeometryType <> CurveTypeEnum.kCircleCurve Or Then Exit Sub
Dim oFlaechenKreisProxy As EdgeProxy = oApp.CommandManager.Pick(kPartEdgeCircularFilter, "Kreis von Flaeche auswaehlen")
If oFlaechenKreisProxy Is Nothing Then Exit Sub
'If oFlaechenKreisProxy.GeometryType <> CurveTypeEnum.kCircleCurve Then Exit Sub

'Form einblenden
CreateForm("Teile platzieren (Abbrechen mit Esc)")
MyForm.ShowDialog()
If ExitSub = True Then Exit Sub

'Dim Msg As Integer = MsgBox("Flächennormale identisch?", vbYesNoCancel, "Einfügerichtung")
'If Msg = vbCancel Then Exit Sub
'Dim Offset As String = InputBox("Distanz", "Eingabe", 0)
Dim Offset As String
Dim Winkel As String
Try 'Wenn Fehleingaben gemacht wurden
	Offset = TextBox(0).Text
	Offset = StrToDbl(Offset) 'Konvertieren, damit mm u. co egal ist
	Winkel = TextBox(1).Text
	Winkel = StrToDbl(Winkel) 'Konvertieren, damit mm u. co egal ist
Catch
	Exit Sub
End Try

'Occurrences bestimmen
Dim oNormteilOcc As ComponentOccurrence = oNormteilKreisProxy.ContainingOccurrence
Dim oFlächenOcc As ComponentOccurrence = oFlaechenKreisProxy.ContainingOccurrence

'Rausspringen wenn gleiche Occ angewählt wurde
If oNormteilOcc Is oLanglochOcc Then Exit Sub

'Suchen ob oNormteilOcc auf aktuellem Bauteillevel liegt
SearchForTopOccFinal(oNormteilOcc, oMasterAsmCompDef)
Dim oTopNormteilOcc As ComponentOccurrence = oCurrentTopOcc
oCurrentTopOcc = Nothing
Dim NormOccIstInBG As Boolean = False
If Not oTopNormteilOcc Is oNormteilOcc Then NormOccIstInBG = True
'Nach Itemnumber In Leafoccurrences schauen, wichtig für die Identifizierung der NewNormteilOcc nach dem Kopieren
Dim TopNormteilOccItem As Integer
Dim oOccProxy As ComponentOccurrenceProxy
If TypeOf oTopNormteilOcc.Definition.Document Is AssemblyDocument Then
    For TopNormteilOccItem = 1 To oTopNormteilOcc.Definition.Occurrences.AllLeafOccurrences.Count
        oTopNormteilOcc.CreateGeometryProxy(oTopNormteilOcc.Definition.Occurrences.AllLeafOccurrences.Item(TopNormteilOccItem), oOccProxy)
        If oOccProxy Is oNormteilOcc Then Exit For
    Next
End If

'Prüfen ob einzufügendes Teil ein Normteil ist, dann ist LockRot ist True außer es ist eine Außnahme definiert
Dim LockRot As Boolean = False
If TypeOf oNormteilOcc.Definition.Document Is PartDocument Then
    If oNormteilOcc.Definition.IsContentMember = True _
    Or InStr(UCase(oNormteilOcc.Definition.Document.PropertySets("Design Tracking Properties")("Description").value), "LINSEN-FLANSCH") Then
		LockRot = True
		If CheckBox(0).Checked = True Then LockRot = False
	End If
End If
If CheckBox(1).Checked = False Then LockRot = True

'Senkrechte Ebenen zu NormteilKreis ermitteln
'RichungunsVektor
Dim oNormteilKreisNormal As UnitVector = oNormteilKreisProxy.Geometry.Normal
'Proxies
Dim oNormteilPerpendWorkPlaneProxy As WorkPlaneProxy
Dim oNormteilPerpendWorkAxisProxy As WorkAxisProxy
'WorkplaneProxies
Dim oWorkPlaneProxy1 As WorkPlaneProxy
Dim oWorkPlaneProxy2 As WorkPlaneProxy
Dim oWorkPlaneProxy3 As WorkPlaneProxy
oNormteilOcc.CreateGeometryProxy(oNormteilOcc.Definition.WorkPlanes(1), oWorkPlaneProxy1)
oNormteilOcc.CreateGeometryProxy(oNormteilOcc.Definition.WorkPlanes(2), oWorkPlaneProxy2)
oNormteilOcc.CreateGeometryProxy(oNormteilOcc.Definition.WorkPlanes(3), oWorkPlaneProxy3)
'WorkaxisProxies
Dim oWorkAxisProxy1 As WorkAxisProxy
Dim oWorkAxisProxy2 As WorkAxisProxy
Dim oWorkAxisProxy3 As WorkAxisProxy
oNormteilOcc.CreateGeometryProxy(oNormteilOcc.Definition.WorkAxes(1), oWorkAxisProxy1)
oNormteilOcc.CreateGeometryProxy(oNormteilOcc.Definition.WorkAxes(2), oWorkAxisProxy2) 
oNormteilOcc.CreateGeometryProxy(oNormteilOcc.Definition.WorkAxes(3), oWorkAxisProxy3)
'über parallele Einheitsvektoren die Ebenen bestimmen
If oNormteilKreisNormal.IsParallelTo(oWorkPlaneProxy1.Plane.Normal, 0.00001) Then
    oNormteilPerpendWorkPlaneProxy = oWorkPlaneProxy2
   	oNormteilPerpendWorkAxisProxy = oWorkAxisProxy1
End If
If oNormteilKreisNormal.IsParallelTo(oWorkPlaneProxy2.Plane.Normal, 0.00001) Then
    oNormteilPerpendWorkPlaneProxy = oWorkPlaneProxy3
    oNormteilPerpendWorkAxisProxy = oWorkAxisProxy2
End If
If oNormteilKreisNormal.IsParallelTo(oWorkPlaneProxy3.Plane.Normal, 0.00001) Then
    oNormteilPerpendWorkPlaneProxy = oWorkPlaneProxy1
    oNormteilPerpendWorkAxisProxy = oWorkAxisProxy3
End If
'Wenn Bohrung schräg liegt nochmals über die Ebenen versuchen
If oNormteilPerpendWorkPlaneProxy Is Nothing Then
	If oNormteilKreisNormal.IsPerpendicularTo(oWorkPlaneProxy1.Plane.Normal, 0.00001) Then
	    oNormteilPerpendWorkPlaneProxy = oWorkPlaneProxy1
	   	oNormteilPerpendWorkAxisProxy = oWorkAxisProxy2
	End If
	If oNormteilKreisNormal.IsPerpendicularTo(oWorkPlaneProxy2.Plane.Normal, 0.00001) Then
	    oNormteilPerpendWorkPlaneProxy = oWorkPlaneProxy2
	    oNormteilPerpendWorkAxisProxy = oWorkAxisProxy3
	End If
	If oNormteilKreisNormal.IsPerpendicularTo(oWorkPlaneProxy3.Plane.Normal, 0.00001) Then
	    oNormteilPerpendWorkPlaneProxy = oWorkPlaneProxy3
	    oNormteilPerpendWorkAxisProxy = oWorkAxisProxy1
	End If
End If
If oNormteilPerpendWorkPlaneProxy Is Nothing Then
	LockRot = True
End If

'Senkrecht Ebenen zu FlächenKreis ermitteln
Dim oFlächenPerpendWorkPlaneProxy As WorkPlaneProxy
Dim oFlächenKreisNormal As UnitVector = oFlaechenKreisProxy.Geometry.Normal
'Bohrungsdurchmesser von Kreis
Dim Bohrungsdurchmesser As Double = Round(oFlaechenKreisProxy.Geometry.Radius * 20, 3)
oFlächenOcc.CreateGeometryProxy(oFlächenOcc.Definition.WorkPlanes.Item(1), oWorkPlaneProxy1)
oFlächenOcc.CreateGeometryProxy(oFlächenOcc.Definition.WorkPlanes.Item(2), oWorkPlaneProxy2)
oFlächenOcc.CreateGeometryProxy(oFlächenOcc.Definition.WorkPlanes.Item(3), oWorkPlaneProxy3)
If oWorkPlaneProxy1.Plane.Normal.IsParallelTo(oFlächenKreisNormal, 0.00001) Then oFlächenPerpendWorkPlaneProxy = oWorkPlaneProxy2
If oWorkPlaneProxy2.Plane.Normal.IsParallelTo(oFlächenKreisNormal, 0.00001) And oFlächenPerpendWorkPlaneProxy Is Nothing Then oFlächenPerpendWorkPlaneProxy = oWorkPlaneProxy3
If oWorkPlaneProxy3.Plane.Normal.IsParallelTo(oFlächenKreisNormal, 0.00001) And oFlächenPerpendWorkPlaneProxy Is Nothing Then oFlächenPerpendWorkPlaneProxy = oWorkPlaneProxy1

'ErsatzAchsen:
Dim oFlächenPerpendWorkAxisProxy As WorkAxisProxy
Dim FlächenKreisNormalAngle As Double = 0
If oFlächenPerpendWorkPlaneProxy Is Nothing Then
	oFlächenOcc.CreateGeometryProxy(oFlächenOcc.Definition.WorkAxes.Item(1), oWorkAxisProxy1)
	oFlächenOcc.CreateGeometryProxy(oFlächenOcc.Definition.WorkAxes.Item(2), oWorkAxisProxy2)
	oFlächenOcc.CreateGeometryProxy(oFlächenOcc.Definition.WorkAxes.Item(3), oWorkAxisProxy3)
	If oWorkAxisProxy1.Line.Direction.IsPerpendicularTo(oFlächenKreisNormal, 0.00001) Then oFlächenPerpendWorkAxisProxy = oWorkAxisProxy1
	If oWorkAxisProxy2.Line.Direction.IsPerpendicularTo(oFlächenKreisNormal, 0.00001) And oFlächenPerpendWorkAxisProxy Is Nothing Then oFlächenPerpendWorkAxisProxy = oWorkAxisProxy2
	If oWorkAxisProxy3.Line.Direction.IsPerpendicularTo(oFlächenKreisNormal, 0.00001) And oFlächenPerpendWorkAxisProxy Is Nothing Then oFlächenPerpendWorkAxisProxy = oWorkAxisProxy3
	If oFlächenPerpendWorkAxisProxy Is Nothing Then oFlächenPerpendWorkAxisProxy = oWorkAxisProxy1
End If

'Identische Kreise suchen und in Collection schreiben
Dim oCircleCollection As ObjectCollection = oApp.TransientObjects.CreateObjectCollection
oCircleCollection.Add(oFlaechenKreisProxy)
Dim oFlaechenFacePlane As Plane = oApp.TransientGeometry.CreatePlane(oFlaechenKreisProxy.Geometry.Center, oFlächenKreisNormal.AsVector)
Dim oCircCenterPoint As Point
Dim IsAlreadyCenter As Boolean = False
For Each oBodyproxy As SurfaceBodyProxy In oFlächenOcc.SurfaceBodies
    For Each oCircleProxy As EdgeProxy In oBodyproxy.Edges
        If oCircleProxy.GeometryType = CurveTypeEnum.kCircleCurve _
		Or oFlaechenKreisProxy.GeometryType = CurveTypeEnum.kCircularArcCurve _
		And oCircleProxy.GeometryType = CurveTypeEnum.kCircularArcCurve Then
        	If Round(oCircleProxy.Geometry.Radius * 20, 3) = Bohrungsdurchmesser _
            And Round(oFlaechenFacePlane.DistanceTo(oCircleProxy.Geometry.Center), 5) = 0 _
			And Round(oFlaechenFacePlane.DistanceTo(oCircleProxy.PointOnEdge), 5) = 0 Then
                For Each oCircleProxy2 As EdgeProxy In oCircleCollection
					oCircCenterPoint = oCircleProxy2.Geometry.Center
					If oCircCenterPoint.IsEqualTo(oCircleProxy.Geometry.Center, 0.00001) Then
						IsAlreadyCenter = True
						Exit For
					End If
				Next
				If IsAlreadyCenter = False Then
					oCircleCollection.Add(oCircleProxy)
					Continue For
				End If
				IsAlreadyCenter = False
            End If
        End If
    Next
Next

'Weitere Kreise hinzufügen fall Kreis von Schweißteil ist und nicht auf gleicher Fläche
SearchForTopOccFinal(oFlächenOcc, oAsmCompDef) 'Wenn oOcc in Unterbaugruppe ist, dann Rekursiv hochgehen bis Baugruppe gefunden ist
Dim oTopFlächenOcc As ComponentOccurrence = oCurrentTopOcc
If TypeOf oTopFlächenOcc.Definition.Document Is AssemblyDocument Then
	Dim oTopFlächenDoc As AssemblyDocument = oTopFlächenOcc.Definition.Document
	If oTopFlächenDoc.SubType = "{28EC8354-9024-440F-A8A2-0E0E55D635B0}" Then
		For Each oOcc As ComponentOccurrence In oTopFlächenOcc.SubOccurrences
			For Each oBodyproxy As SurfaceBodyProxy In oOcc.SurfaceBodies
			    For Each oCircleProxy As EdgeProxy In oBodyproxy.Edges
			        If oCircleProxy.GeometryType = CurveTypeEnum.kCircleCurve _
					Or oFlaechenKreisProxy.GeometryType = CurveTypeEnum.kCircularArcCurve _
					And oCircleProxy.GeometryType = CurveTypeEnum.kCircularArcCurve Then
			        	If Round(oCircleProxy.Geometry.Radius * 20, 3) = Bohrungsdurchmesser _
			            And Round(oFlaechenFacePlane.DistanceTo(oCircleProxy.Geometry.Center), 5) = 0 _
						And Round(oFlaechenFacePlane.DistanceTo(oCircleProxy.PointOnEdge), 5) = 0 Then
			                For Each oCircleProxy2 As EdgeProxy In oCircleCollection
								oCircCenterPoint = oCircleProxy2.Geometry.Center
								If oCircCenterPoint.IsEqualTo(oCircleProxy.Geometry.Center, 0.00001) Then
									IsAlreadyCenter = True
									Exit For
								End If
							Next
							If IsAlreadyCenter = False Then
								oCircleCollection.Add(oCircleProxy)
								Continue For
							End If
							IsAlreadyCenter = False
			            End If
			        End If
			    Next
			Next
		Next
	End If
End If

'Bereits abhängige Kreise aus Collection entfernen
Dim oConstraint As Object
If oCircleCollection.Count>1 Then
	For Each oConstraint In oTopFlächenOcc.Constraints
	    If oConstraint.Suppressed = False And oConstraint.HealthStatus = HealthStatusEnum.kUpToDateHealth Then
	        If oConstraint.Type <> ObjectTypeEnum.kInsertConstraintObject Then Continue For
	        If oConstraint.EntityOne Is Nothing Or oConstraint.EntityTwo Is Nothing Then Continue For 'War nötig weil in Baugruppe 82720.020.51.00.iam fehler kommt. Bei Einfügen:18 Fehlt die Entity, warum unbekannt!
	        For Each oCircleProxy As EdgeProxy In oCircleCollection
				oCircCenterPoint = oCircleProxy.Geometry.Center
				If Round(oCircCenterPoint.DistanceTo(oConstraint.EntityOne.Geometry.Center), 5) = 0 _
				Or Round(oCircCenterPoint.DistanceTo(oConstraint.EntityTwo.Geometry.Center), 5) = 0 Then
					If Round(oCircCenterPoint.DistanceTo(oFlaechenKreisProxy.Geometry.Center), 5) = 0 Then Continue For 'Außnahme dass immer auf den ersten Kreis eine Abhängigkeit platziert wird
					oCircleCollection.RemoveByObject(oCircleProxy)
				End If
			Next
	    End If
	Next
End If

'Alle Zusammenhägenden Occs in Collection
oAllCOnstraintsCollection = oApp.TransientObjects.CreateObjectCollection
oAllOccsCollection = oApp.TransientObjects.CreateObjectCollection
oAllOccsCollection.Add(oTopNormteilOcc)
SearchAllOccsInOcc(oTopNormteilOcc)

'Bildschirmaktualisierung aus 'Bringt starke Zeitersparnis
oApp.AssemblyOptions.DeferUpdate = True
'oApp.ScreenUpdating = False

'Auf allen Kreisen ein Teil/Teileverbund platzieren
For Each oCircleOnFaceProxy As EdgeProxy In oCircleCollection
    'Occurrence count originally
    Dim occCount As Integer = oAsmCompDef.Occurrences.Count
    Dim oNewNormteilOcc As ComponentOccurrence
    'New originOcc ermitteln
    If Not oCircleOnFaceProxy Is oCircleCollection(1) Then
        oApp.ActiveDocument.SelectSet.SelectMultiple(oAllOccsCollection)
        oApp.CommandManager.ControlDefinitions.Item("AppCopyCmd").Execute2(True)
        oApp.CommandManager.ControlDefinitions.Item("AppPasteCmd").Execute2(True)
        For i = occCount + 1 To oAsmCompDef.Occurrences.Count
			If oAsmCompDef.Occurrences(i).Definition.Document Is oTopNormteilOcc.Definition.Document Then
                oNewNormteilOcc = oAsmCompDef.Occurrences(i)
                Exit For
            End If
        Next
        If NormOccIstInBG = True Then
            Dim oNewNormteilOccProxy As ComponentOccurrenceProxy
            oNewNormteilOcc.CreateGeometryProxy(oNewNormteilOcc.Definition.Occurrences.AllLeafOccurrences.Item(TopNormteilOccItem), oNewNormteilOccProxy)
            oNewNormteilOcc = oNewNormteilOccProxy
        End If
    Else
        oNewNormteilOcc = oNormteilOcc	
    End If
    
    'Neue Proxies definieren
	Dim oNewNormteilPerpendWorkPlaneProxy1 As WorkPlaneProxy
	Dim oNewNormteilPerpendWorkAxisProxy1 As WorkAxisProxy
	If Not oNormteilPerpendWorkPlaneProxy Is Nothing 'Wenn Bohrung im Raum liegt
	    oNewNormteilOcc.CreateGeometryProxy(oNormteilPerpendWorkPlaneProxy.NativeObject, oNewNormteilPerpendWorkPlaneProxy1)
	    oNewNormteilOcc.CreateGeometryProxy(oNormteilPerpendWorkAxisProxy.NativeObject, oNewNormteilPerpendWorkAxisProxy1)
	End If
    Dim oNewNormteilKreisProxy As EdgeProxy
    oNewNormteilOcc.CreateGeometryProxy(oNormteilKreisProxy.NativeObject, oNewNormteilKreisProxy)
	
    'Insert Abhaengigkeit vergeben
    Dim Insert_Param_Expression As String
    If IsMateConst = True Then
        If Insert_Param_Expression = "" Then oConstraint = oAsmCompDef.Constraints.AddInsertConstraint2(oNewNormteilKreisProxy, oCircleOnFaceProxy, True, Offset / 10,LockRot)
        If Insert_Param_Expression <> "" Then oConstraint = oAsmCompDef.Constraints.AddInsertConstraint2(oNewNormteilKreisProxy, oCircleOnFaceProxy, True, Insert_Param_Expression,LockRot)
    Else
        If Insert_Param_Expression = "" Then oConstraint = oAsmCompDef.Constraints.AddInsertConstraint2(oNewNormteilKreisProxy, oCircleOnFaceProxy, False, Offset / 10,LockRot)
        If Insert_Param_Expression <> "" Then oConstraint = oAsmCompDef.Constraints.AddInsertConstraint2(oNewNormteilKreisProxy, oCircleOnFaceProxy, False, Insert_Param_Expression,LockRot)
    End If
	Dim X As Integer
	Dim Z As Integer
    If Insert_Param_Expression = "" Then
        Insert_Param_Expression = oConstraint.Distance.Name
        For X = 1 To 10000
            Try
            	oConstraint.Name = "Abstand:" & X & "-0-Master"
				Exit For
			Catch
			End Try
        Next
    Else
        For Z = 1 To 10000
            Try
            	oConstraint.Name = "Abstand:" & X & "-" & Z
				Exit For
			Catch
			End Try
        Next
	End If
    If LockRot = True Then Continue For
	
    'Angle Abhaengigkeit vergeben
    Dim oAngleConstraint As AngleConstraint
    Dim Angle_Param_Expression As String
    If oFlächenPerpendWorkPlaneProxy Is Nothing Then
		If Angle_Param_Expression = "" Then oAngleConstraint = oAsmCompDef.Constraints.AddAngleConstraint(oNewNormteilPerpendWorkPlaneProxy1, oFlächenPerpendWorkAxisProxy, Winkel, kReferenceVectorSolution, oNewNormteilPerpendWorkAxisProxy1)
        If Angle_Param_Expression <> "" Then oAsmCompDef.Constraints.AddAngleConstraint(oNewNormteilPerpendWorkPlaneProxy1, oFlächenPerpendWorkAxisProxy, Angle_Param_Expression, kReferenceVectorSolution, oNewNormteilPerpendWorkAxisProxy1)
    Else
		If Angle_Param_Expression = "" Then oAngleConstraint = oAsmCompDef.Constraints.AddAngleConstraint(oNewNormteilPerpendWorkPlaneProxy1, oFlächenPerpendWorkPlaneProxy, Winkel, kReferenceVectorSolution, oNewNormteilPerpendWorkAxisProxy1)
        If Angle_Param_Expression <> "" Then oAngleConstraint = oAsmCompDef.Constraints.AddAngleConstraint(oNewNormteilPerpendWorkPlaneProxy1, oFlächenPerpendWorkPlaneProxy, Angle_Param_Expression, kReferenceVectorSolution, oNewNormteilPerpendWorkAxisProxy1)
    End If
    If Angle_Param_Expression = "" Then
        Angle_Param_Expression = oAngleConstraint.Angle.Name
        For X = 1 To 10000
            Try
            	oAngleConstraint.Name = "Drehung:" & X & "-0-Master"
				Exit For
			Catch
			End Try
        Next
    Else
        For Z = 1 To 10000
            Try
            	oAngleConstraint.Name = "Drehung:" & X & "-" & Z
				Exit For
			Catch
			End Try
        Next
	End If
Next

'Bildschirmaktualisierung ein + update
oApp.AssemblyOptions.DeferUpdate = False
oApp.ScreenUpdating = True
oMasterAsmCompDef.Document.Update

End Sub

Function SearchAllOccsInOcc(oOcc As ComponentOccurrence)
    For Each oConstraint As AssemblyConstraint In oOcc.Constraints
        Dim ConstraintVorhanden As Boolean = False
        For Each oConstInCol As Object In oAllCOnstraintsCollection
            If Not oConstraint Is oConstInCol Then Continue For
            ConstraintVorhanden = True
            Exit For
        Next
        oAllCOnstraintsCollection.Add(oConstraint)
        oAllOccsCollection.Add(oConstraint.AffectedOccurrenceOne)
        If ConstraintVorhanden = False Then SearchAllOccsInOcc(oConstraint.AffectedOccurrenceOne)
        oAllOccsCollection.Add(oConstraint.AffectedOccurrenceTwo)
        If ConstraintVorhanden = False Then SearchAllOccsInOcc(oConstraint.AffectedOccurrenceTwo)
    Next
    For Each oJoint As AssemblyJoint In oOcc.Joints
        Dim JointVorhanden As Boolean = False
        For Each oJointInCol As Object In oAllCOnstraintsCollection
            If Not oJoint Is oJointInCol Then Continue For
            JointVorhanden = True
            Exit For
        Next
        oAllCOnstraintsCollection.Add(oJoint)
        oAllOccsCollection.Add(oJoint.AffectedOccurrenceOne)
        If JointVorhanden = False Then SearchAllOccsInOcc(oJoint.AffectedOccurrenceOne)
        oAllOccsCollection.Add(oJoint.AffectedOccurrenceTwo)
        If JointVorhanden = False Then SearchAllOccsInOcc(oJoint.AffectedOccurrenceTwo)
    Next
End Function

Function SearchForTopOccFinal(oOcc As ComponentOccurrence, oMasterAsmCompDef As AssemblyComponentDefinition) As ComponentOccurrence
    If oCurrentTopOcc Is Nothing Then oCurrentTopOcc = oOcc
	If Not oOcc.ParentOccurrence Is oMasterAsmCompDef.ActiveOccurrence Then
        oCurrentTopOcc = oOcc.ParentOccurrence
        SearchForTopOccFinal(oOcc.ParentOccurrence, oMasterAsmCompDef)
		Return oCurrentTopOcc
    End If
End Function

Function StrToDbl(str As String) As Double
	For i = 1 To Len(str)
		Dim CurrentCharacter As String = Mid(str, i, 1)
		If i=1 And CurrentCharacter="-" Then Continue For
		If IsNumeric(CurrentCharacter) = False _
		And CurrentCharacter <> "," _
		And CurrentCharacter <> "." Then
			str = Replace(str, CurrentCharacter, "")
		End If
		If CurrentCharacter = "." Then str = Replace(str, CurrentCharacter, ",")
	Next
	StrToDbl = str
End Function

Private WithEvents MyForm As System.Windows.Forms.Form
Private Button0 As System.Windows.Forms.Button
Private Button1 As System.Windows.Forms.Button
Private ComboBox(0) As System.Windows.Forms.ComboBox
Private Label(0) As System.Windows.Forms.Label
Private PicBox(0) As System.Windows.Forms.PictureBox
Private TextBox(0) As System.Windows.Forms.TextBox
Private CheckBox(0) As System.Windows.Forms.CheckBox
Private RadioButton(0) As System.Windows.Forms.RadioButton
Private GroupBox As System.Windows.Forms.GroupBox
Private Label0 As System.Windows.Forms.Label
Private Label1 As System.Windows.Forms.Label
Private RadioButton0 As System.Windows.Forms.RadioButton
Private RadioButton1 As System.Windows.Forms.RadioButton

Private Sub CreateForm(Optional Name As String = vbNullString)
	MyForm = New System.Windows.Forms.Form
	MyForm.Text = Name
	MyForm.AutoScaleMode = AutoScaleMode.Dpi
	MyForm.Size = New Drawing.Size(375*2, 150*2) 'Width, Heigth
	MyForm.MinimumSize = MyForm.Size
	MyForm.MaximumSize = MyForm.Size
	MyForm.Font = New Drawing.Font(MyForm.Font.FontFamily, 10)
	MyForm.MaximizeBox = False
	MyForm.MinimizeBox = False
	MyForm.ShowIcon = False
	MyForm.SizeGripStyle = SizeGripStyle.Hide
	MyForm.StartPosition = FormStartPosition.CenterScreen
	MyForm.KeyPreview = True
	
	AddLabel(5*2, (128+20-140)*2, "Offset")
	AddTextBox(55*2, (125+20-140)*2, "0", 100*2)
	AddLabel(155*2, (128+20-140)*2, "mm")
	
	AddLabel(5*2, (153+20-140)*2, "Winkel")
	AddTextBox(55*2, (150+20-140)*2, "0", 100*2)
	AddLabel(155*2, (153+20-140)*2, "°")
	
	AddLabel(5*2, (195+20-140)*2, "Winkelabhängigkeit bei Normteilen erstellen?")
	AddLabel(5*2, (220+20-140)*2, "Winkelabhängigkeit bei ""Nicht-Normteilen"" erstellen?")
	
	AddCheckBox(335*2, 75*2,False)
	AddCheckBox(335*2, 100*2, True)

	AddMateButton()
	AddFlushButton()
	
	TextBox(0).TabIndex = 0
	TextBox(1).TabIndex = 1
	Button0.TabIndex = 2
	Button1.TabIndex = 3

	MyForm.AutoScaleDimensions = New System.Drawing.SizeF(184F, 184F)
	'MyForm.Font = New System.Drawing.Font("Tahoma", 10F)
	MyForm.AcceptButton = Button0
	MyForm.AutoScaleMode = AutoScaleMode.Dpi
	MyForm.PerformAutoScale()
End Sub

'Private Sub MyForm_FormClosing(ByVal sender As Object, ByVal E As System.Windows.Forms.FormClosedEventArgs) Handles MyForm.FormClosed
'	If sender.Name = "CloseButton" Then
'		MessageBox.Show(sender.Name)
'	End If
'End Sub

Private Sub MyForm_KeyDown(ByVal sender As System.Object, ByVal E As System.Windows.Forms.KeyEventArgs) Handles MyForm.KeyDown
	If E.KeyCode = Keys.Escape Then
        MyForm.Close
		ExitSub = True
    End If
End Sub

'Private Sub Button_Click(ByVal sender As System.Object, ByVal E As System.Windows.Forms.FormClosingEventArgs) Handles Button.FormClosing
'	MessageBox.Show(sender.ToString, "Title")
'	
'	MyForm.Close
'	ExitSub = True
'End Sub

Private Function AddLabel(PosX As Integer, PosY As Integer, Optional Caption As String = vbNullString, Optional Width As Integer = 100) As System.Windows.Forms.Label
	Dim LC As Integer = Label.Length - 1
	If Not Label(LC) Is Nothing Then
		LC = LC + 1
		ReDim Preserve Label(LC)
	End If
	Label(LC) = New System.Windows.Forms.Label
	Label(LC).Name = "L" & LC
	Label(LC).Location = New Drawing.Point(PosX, PosY)
	Label(LC).Text = Caption
	Label(LC).AutoSize = True
	Label(LC).Width = Width
	MyForm.Controls.Add(Label(LC))
	Return Label(LC)
End Function

Private Function AddCheckBox(PosX As Integer, PosY As Integer, Checked As Boolean,Optional Caption As String = vbNullString, Optional Width As Integer = 100) As System.Windows.Forms.CheckBox
	Dim LC As Integer = CheckBox.Length - 1
	If Not CheckBox(LC) Is Nothing Then
		LC = LC + 1
		ReDim Preserve CheckBox(LC)
	End If
	CheckBox(LC) = New System.Windows.Forms.CheckBox
	CheckBox(LC).Location = New Drawing.Point(PosX, PosY)
	CheckBox(LC).Name = "CheckBox" & LC
	CheckBox(LC).Text = Caption
	CheckBox(LC).Width = Width
	CheckBox(LC).Checked = Checked
	CheckBox(LC).TabStop = False
	MyForm.Controls.Add(CheckBox(LC))
	Return CheckBox(LC)
End Function

Private Function AddTextBox(PosX As Integer, PosY As Integer, Optional Caption As String = vbNullString, Optional Width As Integer = 100) As System.Windows.Forms.TextBox
	Dim LC As Integer = TextBox.Length - 1
	If Not TextBox(LC) Is Nothing Then
		LC = LC + 1
		ReDim Preserve TextBox(LC)
	End If
	TextBox(LC) = New System.Windows.Forms.TextBox
	TextBox(LC).Location = New Drawing.Point(PosX, PosY)
	TextBox(LC).Name = "TextBox" & LC
	TextBox(LC).Text = Caption
	TextBox(LC).Width = Width
	MyForm.Controls.Add(TextBox(LC))
	Return TextBox(LC)
End Function

Private Function AddMateButton() As System.Windows.Forms.Button
	Button0 = New System.Windows.Forms.Button
	Button0.Name = "Button0"
	Button0.Image = Drawing.Image.FromFile("C:\Vault-Workspace\Preferences\ilogic Regeln\Buttons\Mate.png")
	Button0.Location = New Drawing.Point(190*2, 5*2)
	Button0.Text = ""
	Button0.Width = Button0.Image.Width*2
	Button0.Height = Button0.Image.Height*2
	MyForm.Controls.Add(Button0)
	AddHandler Button0.Click, AddressOf OnMateClick
	Return Button0
End Function

Private Function AddFlushButton() As System.Windows.Forms.Button
	Button1 = New System.Windows.Forms.Button
	Button1.Name = "Button1"
	Button1.Image = Drawing.Image.FromFile("C:\Vault-Workspace\Preferences\ilogic Regeln\Buttons\Flush.png")
	Button1.Location = New Drawing.Point(275*2, 5*2)
	Button1.Text = ""
	Button1.Width = Button1.Image.Width*2
	Button1.Height = Button1.Image.Height*2
	MyForm.Controls.Add(Button1)
	AddHandler Button1.Click, AddressOf OnFlushClick
	Return Button1
End Function

Private Sub OnMateClick()
	MyForm.Close
	IsMateConst = True
End Sub

Private Sub OnFlushClick()
	MyForm.Close
	IsMateConst = False
End Sub

End Class

[Andrew.M.Brodsky]

Thanks for this.  I am not able to get it to work, it just suddenly stops after the first two prompts.  Some of the problem may be that the prompts are in German and I do not understand German.

Would you be able to do a screencast recording showing how to use the ilogic you have written and then I can try to follow it based on that and go from there?