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