Private Sub Form_Load()
    Dim objApp As SolidEdgeFramework.Application
    Dim objDoc As SolidEdgeAssembly.AssemblyDocument
    Dim objFirstPart As SolidEdgeAssembly.Occurrence
    Dim objFace1 As SolidEdgeGeometry.Face
    Dim objRef1 As Object
    Dim objSecondPart As SolidEdgeAssembly.Occurrence
    Dim objFace2 As SolidEdgeGeometry.Face
    Dim objRef2 As Object
    Dim objPlanar As SolidEdgeAssembly.PlanarRelation3d
    Dim objEdge1 As SolidEdgeGeometry.Edge
    Dim objEdge2 As SolidEdgeGeometry.Edge
    Dim objPoint As SolidEdgeAssembly.PointRelation3d
    Dim UVMinRange(1 To 2) As Double
    Dim UVMaxRange(1 To 2) As Double
    Dim UVPoints(1 To 4) As Double
    Dim XYZPoints1(1 To 6) As Double
    Dim XYZPoints2(1 To 6) As Double
    Const TESTFILE1 = "T:\vbtests\testcases\chead.par"
    Const TESTFILE2 = "T:\vbtests\testcases\chead.par"
    Dim i As Integer
    ' Used for temporary storage of datadump return string
    Dim sDumpStatus As String
    ' Report errors
    Const PI = 3.14159265358979
    ' Create/get the application with specific settings
    On Error Resume Next
    Set objApp = GetObject(, "SolidEdge.Application")
    If Err Then
        Err.Clear
        Set objApp = CreateObject("SolidEdge.Application")
        Set objDoc = objApp.Documents.Add("SolidEdge.AssemblyDocument")
        objApp.Visible = True
    Else
        Set objDoc = objApp.ActiveDocument
    End If
    ' Place a Part on the Assembly Document
    Set objFirstPart = objDoc.Occurrences.AddByFilename(TESTFILE1)
    ' Get the BottomCap on the ExtrudedProtrusion of the Part and a point on it
    Set objFace1 = objFirstPart.PartDocument.Models(1).ExtrudedProtrusions(1).BottomCap
    Call objFace1.GetParamRange(UVMinRange, UVMaxRange)
    For i = 1 To 2
        UVPoints(i) = (UVMinRange(i) + UVMaxRange(i)) / 2
    Next i
    Call objFace1.GetPointAtParam(1, UVPoints, XYZPoints1)
    ' Create Reference Object to the above BottomCap
    Set objRef1 = objDoc.CreateReference(objFirstPart, objFace1)
    ' Place another Part on the Assembly Document
    Set objSecondPart = objDoc.Occurrences.AddByFilename(TESTFILE2)
    ' Delete the Ground relation on the Second Part of the Assembly
    Call objSecondPart.Relations3d(1).Delete
    ' Get the TopCap on the ExtrudedProtrusion of the Part and a point on it
    Set objFace2 = objSecondPart.PartDocument.Models(1).ExtrudedProtrusions(1).TopCap
    Call objFace2.GetParamRange(UVMinRange, UVMaxRange)
    For i = 1 To 2
        UVPoints(i) = (UVMinRange(i) + UVMaxRange(i)) / 2
    Next i
    Call objFace2.GetPointAtParam(1, UVPoints, XYZPoints2)
    ' Create Reference Object to the above BottomCap
    Set objRef2 = objDoc.CreateReference(objSecondPart, objFace2)
    ' Create the Relation - This automatically invokes the Solver
    Set objPlanar = objDoc.Relations3d.AddPlanar(Plane1:=objRef1, Plane2:=objRef2, _
                                                 NormalsAligned:=False, ConstrainingPoint1:=XYZPoints1, ConstrainingPoint2:=XYZPoints2)
    ' Check if the Planar relation has been properly placed
    If (objDoc.Relations3d(2).Type <> igPlanarRelation3d) Then
        MsgBox "AddPlanar method of the Relations3d object fails"
    End If
    ' Add a point relation between the two parts
    Set objEdge1 = objFace1.Edges(3)
    Set objEdge2 = objFace2.Edges(3)
    Set objRef1 = objDoc.CreateReference(objFirstPart, objEdge1)
    Set objRef2 = objDoc.CreateReference(objSecondPart, objEdge2)
    Set objPoint = objDoc.Relations3d.AddPoint(PointGeometry:=objRef1, _
                                               PointKeyPoint:=igRelation3dEndPoint, ConnectGeometry:=objRef2, _
                                               ConnectKeyPoint:=igRelation3dEndPoint)
    ' USER DISPLAY
    ' Release objects
    Set objApp = Nothing
    Set objDoc = Nothing
    Set objFirstPart = Nothing
    Set objFace1 = Nothing
    Set objRef1 = Nothing
    Set objSecondPart = Nothing
    Set objFace2 = Nothing
    Set objRef2 = Nothing
    Set objPlanar = Nothing
    Set objEdge1 = Nothing
    Set objEdge2 = Nothing
    Set objPoint = Nothing
End Sub