[Function] Demonstrate that two planes are equal
[Function] Demonstrate that two planes are equal
(OP)
Hi everyone,
I struggle to create a function that allow to determine whether or not two planes are parallel and on the same level. Bellow I managed to get the angle between the two planes and the idea is to return true or false in fonction of the angle between them. However, I don't know how to handle the case when the two planes are paralalel but not on the same level. Any idea ?
Function AngleBetweenPlanes(oFirstPlane, oSecondPlane)
Dim reference1 As Reference
Set reference1 = oPart.CreateReferenceFromObject(oFirstPlane)
Dim reference2 As Reference
Set reference2 = oPart.CreateReferenceFromObject(oSecondPlane)
Dim TheSPAWorkbench As Workbench
Set TheSPAWorkbench = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench")
Dim TheMeasurable As Measurable
Set TheMeasurable = TheSPAWorkbench.GetMeasurable(reference1)
Dim MinimumDistance As Double
MinimumDistance = TheMeasurable.GetAngleBetween(reference2)
MsgBox ("Angle=" & CStr(MinimumDistance))
End Function
I struggle to create a function that allow to determine whether or not two planes are parallel and on the same level. Bellow I managed to get the angle between the two planes and the idea is to return true or false in fonction of the angle between them. However, I don't know how to handle the case when the two planes are paralalel but not on the same level. Any idea ?
Function AngleBetweenPlanes(oFirstPlane, oSecondPlane)
Dim reference1 As Reference
Set reference1 = oPart.CreateReferenceFromObject(oFirstPlane)
Dim reference2 As Reference
Set reference2 = oPart.CreateReferenceFromObject(oSecondPlane)
Dim TheSPAWorkbench As Workbench
Set TheSPAWorkbench = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench")
Dim TheMeasurable As Measurable
Set TheMeasurable = TheSPAWorkbench.GetMeasurable(reference1)
Dim MinimumDistance As Double
MinimumDistance = TheMeasurable.GetAngleBetween(reference2)
MsgBox ("Angle=" & CStr(MinimumDistance))
End Function





RE: [Function] Demonstrate that two planes are equal
indocti discant et ament meminisse periti
RE: [Function] Demonstrate that two planes are equal
RE: [Function] Demonstrate that two planes are equal
I believe what Eric was trying to say is after checking if the planes are parallel, check if distance between them is 0.
Regards
Fernando
https://picasaweb.google.com/102257836106335725208 - Romania
https://picasaweb.google.com/103462806772634246699... - EU
RE: [Function] Demonstrate that two planes are equal
indocti discant et ament meminisse periti
RE: [Function] Demonstrate that two planes are equal
RE: [Function] Demonstrate that two planes are equal
Calculate and compare the A,B,C,D coefficients of both planes. (Ax + By + Cz + D = 0)
RE: [Function] Demonstrate that two planes are equal
It is really frustrating, my angle function doesn't work anymore. @itsmyjob I can't even try to get the distance to (0,0,0)...
@jackk I am really new to VBA, I don't really know from where to start to get the planes equations and then compare coefficients...
So here is my code.
What the code do : During a loop, you have to select a circle edge of a body part and then it create a reference plane based on this circular edge.
What I need to do : create a new reference plane if the next circular edge is not on the "same plane". For that I need my function that allow me to compare planes...
Any ideas ?
CODE -->
Option Explicit Sub CATMain() '--------------------------------------------- ' Variables declarations '--------------------------------------------- Dim oPartDoc As PartDocument Set oPartDoc = CATIA.ActiveDocument Dim oSelection Set oSelection = oPartDoc.Selection oSelection.Clear Dim oPart As Part Set oPart = oPartDoc.Part Dim oBodies As HybridBodies Set oBodies = oPart.HybridBodies Dim oParams As Parameters Set oParams = oPart.Parameters Dim oHybridShapeFactory As HybridShapeFactory Set oHybridShapeFactory = oPart.HybridShapeFactory Dim oProduct As Product Set oProduct = oPartDoc.GetItem(oPart.Name) Dim oPublications Set oPublications = oProduct.Publications Dim InputObjectType(0) InputObjectType(0) = "Edge" Dim j As Integer Dim i As Integer Dim m As Integer '--------------------------------------------- ' Circular holes prerequisite '--------------------------------------------- Dim oHolePublicationData As HybridBody Dim strHybridBodyName As String strHybridBodyName = "HolePublicationData" Dim oReferencePlane Dim ReferencePlaneForObject As Reference Dim oLine Dim oClearanceCircle Dim oDiamRelation As Formula Dim oExtractPointParam Dim oClearanceDiamParam As Dimension Dim dFootThickness 'As Double Dim oLineParams As Parameters Dim oFootThickParam As Dimension Dim dCircleRadius As Double Dim dInsertHoleDiamParam Dim bInsertHolesParamExistence As Boolean bInsertHolesParamExistence = False oPart.Update 'Creation of HolePublicationData geometrical set and parameters if previous checks ran well. Ask the user to enter the FootThickness as well. Set oHolePublicationData = oBodies.Add() oHolePublicationData.Name = strHybridBodyName oPart.Update '--------------------------------------------- ' "Circular holes interface" '--------------------------------------------- MsgBox "Circular holes interface starting; press escape when you have finished." '--------------------------------------------- ' Declaration of variables needed for the "Circle interface" below '--------------------------------------------- Dim CircularHolesStatus CircularHolesStatus = "Normal" Dim oSelectedCircle Dim iHoleNumber As Integer Dim strHoleNumber As String iHoleNumber = 1 Dim oCircleCenter Dim ReferenceCircleCenterForObject As Reference '--------------------------------------------- ' Circular holes selection '--------------------------------------------- While CircularHolesStatus = "Normal" '--------------------------------------------- 'Error-handling '--------------------------------------------- On Error Resume Next If Err.Number <> 0 Then Err.Clear MsgBox "Unable to proceed.", vbCritical, "Critical error" Exit Sub End If '--------------------------------------------- ' Selection of the circle edge '--------------------------------------------- ' Line from where it resume if an other edge than a circular is selected SelectionResumption: oSelection.Clear CircularHolesStatus = oSelection.SelectElement2(InputObjectType, "Select a circular hole edge ", False) If CircularHolesStatus = "Normal" Then Set oSelectedCircle = oSelection.Item(1).Value oSelection.Clear If Not TypeName(oSelectedCircle) = "TriDimFeatEdge" Then MsgBox ("The selected object is not a slotted edge, please start again.") GoTo SelectionResumption: End If '--------------------------------------------- 'Create the reference plane and publish it. '--------------------------------------------- Dim FirstOne, SecondOne Set oReferencePlane = oHybridShapeFactory.AddNewPlane1Curve(oSelectedCircle) oHolePublicationData.AppendHybridShape oReferencePlane oPart.Update oReferencePlane.Name = "Ref.Plane" & CStr(iHoleNumber) Call Publication(oReferencePlane, oProduct) oPart.Update oSelection.Clear oSelection.Add oReferencePlane oSelection.VisProperties.SetRealColor 128, 0, 128, 0 oPart.Update oSelection.Clear Set ReferencePlaneForObject = oPart.CreateReferenceFromObject(oReferencePlane) oPart.Update 'This is to number every points, lines and clearance circle iHoleNumber = iHoleNumber + 1 strHoleNumber = CStr(iHoleNumber)'Here is the test I want to do If iHoleNumber = 3 Then
FirstOne = oHolePublicationData.Item("Ref.Plane1")
SecondOne = oHolePublicationData.Item("Ref.Plane2")
Dim reference1 As Reference
Set reference1 = oPart.CreateReferenceFromObject(FirstOne)
Dim reference2 As Reference
Set reference2 = oPart.CreateReferenceFromObject(SecondOne)
Dim TheSPAWorkbench As Workbench
Set TheSPAWorkbench = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench")
Dim TheMeasurable As Measurable
Set TheMeasurable = TheSPAWorkbench.GetMeasurable(reference1)
Dim Angle As Double
Angle = TheMeasurable.GetAngleBetween(reference2)
MsgBox ("Angle=" & CStr(MinimumDistance))
End If
Else
If MsgBox("Have you finished to prepare all the circular insert holes ?", vbYesNo) = vbNo Then
CircularHolesStatus = "Normal"
Else
MsgBox ("Circular holes interface completed")
GoTo CircularWhileExit:
End If
End If
On Error GoTo 0
Wend
CircularWhileExit:
End Sub RE: [Function] Demonstrate that two planes are equal
RE: [Function] Demonstrate that two planes are equal
CODE -->
Function IsTheSamePlane(oFirstPlane, oSecondPlane) As Boolean '-------------------------------------------------- ' ABSTRACT: ' Check if two planes are identical. ' DEPENDANCIES: ' IsInThePlane '-------------------------------------------------- Dim i As Integer Dim arrFirstPlaneOrigin(2) Dim arrFirstPlaneFirstAxis(2) Dim arrFirstPlaneSecondAxis(2) oFirstPlane.GetOrigin arrFirstPlaneOrigin oFirstPlane.GetFirstAxis arrFirstPlaneFirstAxis oFirstPlane.GetSecondAxis arrFirstPlaneSecondAxis IsTheSamePlane = False Dim arrPoint1(2) Dim arrPoint2(2) 'Creation of two points having key coordinates for the test, more precisely Point1 (resp. Point2) on the first plane first axis (resp. second axis). For i = 0 To 2 arrPoint1(i) = arrFirstPlaneOrigin(i) + arrFirstPlaneFirstAxis(i) arrPoint2(i) = arrFirstPlaneOrigin(i) + arrFirstPlaneSecondAxis(i) Next 'Test if the first plane origin and the two previous points are in the second plane If IsInThePlane(arrFirstPlaneOrigin, oSecondPlane) Then If IsInThePlane(arrPoint1, oSecondPlane) Then If IsInThePlane(arrPoint2, oSecondPlane) Then IsTheSamePlane = True End If End If End If End Function Function IsInThePlane(oPoint, oPlane) As Boolean '-------------------------------------------------- ' ABSTRACT: ' Check if a point is in plane. '-------------------------------------------------- Dim arrPlaneOrigin(2) Dim arrPlaneFirstAxis(2) Dim arrPlaneSecondAxis(2) Dim arrPlaneNormal(2) Dim Value As Double oPlane.GetOrigin arrPlaneOrigin oPlane.GetFirstAxis arrPlaneFirstAxis oPlane.GetSecondAxis arrPlaneSecondAxis arrPlaneNormal(0) = arrPlaneFirstAxis(1) * arrPlaneSecondAxis(2) - arrPlaneFirstAxis(2) * arrPlaneSecondAxis(1) arrPlaneNormal(1) = -arrPlaneFirstAxis(0) * arrPlaneSecondAxis(2) + arrPlaneFirstAxis(2) * arrPlaneSecondAxis(0) arrPlaneNorm0al(2) = arrPlaneFirstAxis(0) * arrPlaneSecondAxis(1) - arrPlaneFirstAxis(1) * arrPlaneSecondAxis(0) Value = arrPlaneNormal(0) * (oPoint(0) - arrPlaneOrigin(0)) + arrPlaneNormal(1) * (oPoint(1) - arrPlaneOrigin(1)) + arrPlaneNormal(2) * (oPoint(2) - arrPlaneOrigin(2)) If Value < 0.001 And Value > -0.001 Then IsInThePlane = True Else IsInThePlane = False End If End FunctionHope I will share again with all of us.
Pharys