Change UCS to length, width

[DominiqueBernardi5116]

Good Evening everyone,

I request your help once more.

I trying to apply a new ucs to a parts according the length, width and thickness of the part.

The longest dimensions must be in the X direction , the smalest in the Y direction, and the face with the highest area must be on xy plan. (just look  the part link)

To explain why : I got assembly of sometimes more then 150 pieces, I have to convert then to igs, to use in my 5 axis cnc machine. I used to do it "by hand" .... now it's over, take me too long, even I'm confined due to covid, i do not want to waste more time on this.

some guideline would be very appreciate

BR

[JelteDeJong · Accepted solution]

hi the following rue is not perfect. it expects that the biggest plane is parallel to on of the normal planes and that the biggest side is parallel to one of the normal axes. 

(If your parts don't comply with that it would also be possible to do this wit the longest edge and an other point but that origin would not be on a corner of your part but at the start or end of the longest edge. )

Dim doc As PartDocument = ThisDoc.Document
Dim body As SurfaceBody = doc.ComponentDefinition.SurfaceBodies.Item(1)

Dim maxArea As Double = 0
Dim face As Face = Nothing
For Each selectedFace As face In body.Faces
    Dim area As Double = selectedFace.Evaluator.Area
    If (maxArea < area) Then
        maxArea = area
        face = selectedFace
    End If
Next

Dim oCompDef As PartComponentDefinition = doc.ComponentDefinition
Dim oTG As TransientGeometry = ThisApplication.TransientGeometry

Dim orign As Point = face.Evaluator.RangeBox.MinPoint
Dim maxPoint As Point = face.Evaluator.RangeBox.MaxPoint

Dim diffX = maxPoint.X - orign.X
Dim diffY = maxPoint.Y - orign.Y
Dim diffZ = maxPoint.Z - orign.Z

' find max direction (= x direction)
Dim point2 As Point
If (diffX > diffY And diffX > diffZ) Then
    point2 = oTG.CreatePoint(orign.X + diffX, orign.Y, orign.Z)
ElseIf (diffY > diffX And diffY > diffZ) Then
    point2 = oTG.CreatePoint(orign.X, orign.Y + diffY, orign.Z)
Else
    point2 = oTG.CreatePoint(orign.X, orign.Y, orign.Z + diffZ)
End If

' find small direction (= Z direction)
Dim point3 As Point
If (diffX < diffY And diffX < diffZ) Then
    point3 = oTG.CreatePoint(orign.X, orign.Y + diffY, orign.Z + diffZ)
ElseIf (diffY < diffX And diffY < diffZ) Then
    point3 = oTG.CreatePoint(orign.X + diffX, orign.Y, orign.Z + diffZ)
Else
    point3 = oTG.CreatePoint(orign.X + diffX, orign.Y + diffY, orign.Z)
End If

Dim oWorkPoint1 As WorkPoint = oCompDef.WorkPoints.AddFixed(orign)
Dim oWorkPoint2 As WorkPoint = oCompDef.WorkPoints.AddFixed(point2)
Dim oWorkPoint3 As WorkPoint = oCompDef.WorkPoints.AddFixed(point3)

Dim oUCSDef As UserCoordinateSystemDefinition = oCompDef.UserCoordinateSystems.CreateDefinition
oUCSDef.SetByThreePoints(oWorkPoint1, oWorkPoint2, oWorkPoint3)

Dim oUCS As UserCoordinateSystem = oCompDef.UserCoordinateSystems.Add(oUCSDef)

[DominiqueBernardi5116]

You guys are realy amazing !!!!

realy !!!

thx a lot, best regards, be safe.

[JelteDeJong · Accepted solution]

Just an other solution that will always work. (Also if the biggest plane and longest edge are not parallel to a normal plane and axis.) The origin will always be on the start of the longest edge. That is not always a corner like the corner of a bounding box. But maybe that is not an problem for you. (If you want to find the bounding box in the new ucs and moving the unc to a corner of the bounding box, have a look at this post from @JamieVJohnson2 )

Dim doc As PartDocument = ThisDoc.Document
Dim body As SurfaceBody = doc.ComponentDefinition.SurfaceBodies.Item(1)
Dim oCompDef As PartComponentDefinition = doc.ComponentDefinition
Dim oTG As TransientGeometry = ThisApplication.TransientGeometry

Dim maxArea As Double = 0
Dim face As Face = Nothing
For Each selectedFace As face In body.Faces
    If selectedFace.SurfaceType <> SurfaceTypeEnum.kPlaneSurface Then
        Continue For
    End If
    Dim area As Double = selectedFace.Evaluator.Area
    If (maxArea < area) Then
        maxArea = area
        face = selectedFace
    End If
Next

Dim maxLength As Double = 0
Dim edge As Edge = Nothing
Dim anOtherPoint As Point = Nothing
For Each selectedEdge As edge In face.Edges
    Dim length As Double =
        Math.Pow(selectedEdge.StartVertex.Point.X - selectedEdge.StopVertex.Point.X, 2) +
        Math.Pow(selectedEdge.StartVertex.Point.Y - selectedEdge.StopVertex.Point.Y, 2) +
        Math.Pow(selectedEdge.StartVertex.Point.Z - selectedEdge.StopVertex.Point.Z, 2)
    If (maxLength < length) Then
        maxLength = length
        edge = selectedEdge
    End If
Next

Dim orign As Point = edge.StartVertex.Point
Dim point2 As Point = edge.StopVertex.Point


Dim params(1) As Double
params(0) = Math.Abs(face.Evaluator.ParamRangeRect.MaxPoint.X -
    face.Evaluator.ParamRangeRect.MinPoint.X) / 2 + face.Evaluator.ParamRangeRect.MinPoint.X
params(1) = Math.Abs(face.Evaluator.ParamRangeRect.MaxPoint.Y -
    face.Evaluator.ParamRangeRect.MinPoint.Y) / 2 + face.Evaluator.ParamRangeRect.MinPoint.Y

Dim points(2) As Double
face.Evaluator.GetPointAtParam(params, points)


Dim point3 As Point = oTG.CreatePoint(points(0), points(1), points(2))


Dim oWorkPoint1 As WorkPoint = oCompDef.WorkPoints.AddFixed(orign)
Dim oWorkPoint2 As WorkPoint = oCompDef.WorkPoints.AddFixed(point2)
Dim oWorkPoint3 As WorkPoint = oCompDef.WorkPoints.AddFixed(point3)

Dim oUCSDef As UserCoordinateSystemDefinition = oCompDef.UserCoordinateSystems.CreateDefinition
oUCSDef.SetByThreePoints(oWorkPoint1, oWorkPoint2, oWorkPoint3)

Dim ucs As UserCoordinateSystem = oCompDef.UserCoordinateSystems.Add(oUCSDef)

[DominiqueBernardi5116]

Definetly works great, also this last one.

Thx a lot.

regards