The probe head is assumed to be similar to a PH-10 having A & B rotations in the same manner.
The stylus is attached to the hub that coincides with a probe rotation of A90B90 (hub #2). This is the C axis 0° position.
---How to Use---
Modify the values in the USER DEFINED DATA section of the AllStarAngles procedure
PcDmis must be open with the active part program having a circle or cylinder auto feature selected in the Edit Window (cursor must be located within the feature).
Run the StartHere procedure.
Pick a resulting A-B-C combination that suits.
Open Probe Utilities and add the A-B angles. Double-click on the connection having the 5-way star cluster hub ("EXTEN5WAY" in my case). This displays the "Edit Probe Component" dialog where the "Default rotation angle about connection" can be edited. Enter the "C" angle.
With the newly defined tip selected in the program edit (F9) the hole feature. Use the View Normal Toggle to line things up. Turning off display of all but stylus will help.
The routine takes the vector of the selected feature and transforms it from the current alignment to the machine axis (Part Setup transforms are OK). Orientation of head mounting provides a rotation matrix (in machine axis). Orientation of sensor after A-B rotations provides another rotation matrix in a local system (the left-handedness is accommodated). The hole axis transformation is done using the PcDmis Object Library. The remaining math uses traditional methods.
The default values for head orientation and rotational limits reflect the setup I use for a bridge having a Tesastar-M with the LED facing Yminus.
I'm sure there are more efficient ways to cover this ground. I just picked a method that made sense to me. Error handling is minimal but I did document the code as best I could.
Code part 1 of 2
Option Explicit
Public Const PI As Double = 3.14159265358979
Sub StartHere()
Call AllStarAngles
End Sub
Sub AllStarAngles()
Dim Hole(2) As Double 'hole IJK outward axis direction
Dim HoleInv(2) As Double 'hole axis inverted
Dim HeadMat(2, 2) As Double 'probe head matrix in machine system
Dim SensMat(2, 2) As Double 'probe sensor matrix in head system
Dim Amin As Single, Amax As Single, Ainc As Single 'probe A rotations
Dim Bmin As Single, Bmax As Single, Binc As Single 'probe B rotations
Dim BallDia As Single, StemDia As Single 'stylus
Dim a0b0 As String, a90b180 As String 'probe head orientations
Dim A As Double, B As Double 'loop counters doubling as probe rotation angles
Dim C As Double 'star tip 5-way rotation
Dim StarErr As Double 'misalignment of star tip with hole in decimal degrees
Dim CurRow As Integer 'Excel row
Dim TipClr As Single 'stylus clearance between ball & stem
Dim ShankDepth As Single
On Error GoTo ErrCatcher
Call GetPcDmisHole(Hole)
If Hole(0) = -9 Then
MsgBox ("Need a hole feature selected in Edit Window")
GoTo ExitSub
End If
HoleInv(0) = -Hole(0): HoleInv(1) = -Hole(1): HoleInv(2) = -Hole(2)
'_____USER DEFINED DATA_____
'this block of 10 assignments should come from form
a0b0 = "ZMINUS"
a90b180 = "YPLUS"
Amin = -115
Amax = 90
Ainc = 5
Bmin = -180
Bmax = 180
Binc = 5
BallDia = 0.1181
StemDia = 0.0787
TipClr = (BallDia - StemDia) / 2
Call GetProbeHeadMatrix(a0b0, a90b180, HeadMat)
'following 3 lines for Excel output
ActiveWorkbook.Sheets("Scratch").Activate
Sheets("Scratch").Rows("2:" & Rows.Count).ClearContents
CurRow = 2
For A = Amin To Amax Step Ainc
For B = Bmin To Bmax Step Binc
Call GetSensorMatrix(B, A, HeadMat, SensMat)
StarErr = StarAngle(HoleInv, SensMat, C) 'StarErr = [COLOR="#0000FF"]angular misalignment[/COLOR]
ShankDepth = TipClr / Sin(Radians(StarErr))
Cells(CurRow, 1) = A 'probe A rotation
Cells(CurRow, 2) = B 'probe B rotation
Cells(CurRow, 3) = C 'star hub rotation
Cells(CurRow, 4) = StarErr 'mis-alignment of tip & hole in decimal degrees
Cells(CurRow, 5) = ShankDepth 'max probing depth based on StarErr mis-alignment & stylus data given
CurRow = CurRow + 1 'increment worksheet row
Next B
Next A
Columns("A:E").Sort key1:=Range("D2"), order1:=xlAscending, Header:=xlYes
ExitSub:
Exit Sub
ErrCatcher:
MsgBox ("Error: " & Err.Number & vbCrLf & "Description: " & Err.Description)
On Error GoTo 0
Resume ExitSub
End Sub
Private Sub GetPcDmisHole(H() As Double)
'extract vector of currently selected hole or cylinder in Edit Window and convert to machine axis
Dim oApp As PCDLRN.Application
Dim oPart As PCDLRN.PartProgram
Dim oCmds As PCDLRN.Commands
Dim oCmd As PCDLRN.Command
Dim oFeatCmd As PCDLRN.FeatCmd
Dim oAlign As PCDLRN.AlignCmnd
Dim oMatrix As PCDLRN.DmisMatrix
Dim oPnt As PCDLRN.PointData
Dim CmdType As Long
Dim i As Double, j As Double, k As Double
Dim bRet As Boolean
Dim A(2, 2) As Double
Set oApp = CreateObject("PCDLRN.Application")
Set oPart = oApp.ActivePartProgram
Set oCmds = oPart.Commands
Set oCmd = oCmds.CurrentCommand
CmdType = oCmd.Type
If CmdType = 612 Or CmdType = 616 Then
Set oFeatCmd = oCmd.FeatureCommand
Set oCmd = oCmds.CurrentAlignment
Set oAlign = oCmd.AlignmentCommand
Set oMatrix = oAlign.MachineToPartMatrix
Set oPnt = oMatrix.PrimaryAxis 'used to initialize PointData object - primary axis not used
' .GetVector does not take a PointData object
bRet = oFeatCmd.GetVector(FVECTOR_SURFACE_VECTOR, FDATA_THEO, i, j, k)
oPnt.i = i: oPnt.j = j: oPnt.k = k
' .TransformDataBack takes only a PointData object
oMatrix.TransformDataBack oPnt, ROTATE_ONLY, PLANE_TOP
H(0) = oPnt.i: H(1) = oPnt.j: H(2) = oPnt.k
Else
H(0) = -9 'current command in Edit Window not valid feature - flag error
End If
Set oPnt = Nothing
Set oMatrix = Nothing
Set oAlign = Nothing
Set oFeatCmd = Nothing
Set oCmd = Nothing
Set oCmds = Nothing
Set oPart = Nothing
Set oApp = Nothing
End Sub
Private Function StarAngle(H() As Double, S() As Double, C As Double) As Double
'H(2) = inward hole axis IJK
'S(2,2) = sensor matrix
'C = returned star tip rotation
'StarAng returns smallest DD angular error using C rotation
Dim V(2) As Double 'vector corresponding to star tip 0 angle
Dim W(2) As Double 'vector upwards along sensor axis
Dim HP(2) As Double 'hole axis projected
Dim R(2) As Double 'rotated star tip vector (outward)
Dim T(2) As Double 'temp vec
Call PullMatRow(S, 1, V) '5-way hub #2 - stylus default location
Call PullMatRow(S, 2, W) ' "Z" sensor axis running from sensor towards head
Call ProjectVecOntoPlane(H, W, HP) 'project hole axis onto star hub rotational plane
C = vDotAng(V, HP) 'angle to rotate star hub
'determine if C is CW or CCW
Call vCross(V, HP, T)
If vDotAng(W, T) > 90 Then C = 360 - C
Call RotVecAxis(V, W, C, R) 'R = vector of star tip rotated by C (pointing outward)
StarAngle = vDotAng(R, H) '3D angle between hole and rotated tip
End Function
Private Sub GetSensorMatrix(dZ As Double, dY As Double, Head() As Double, M() As Double)
'populate M 3x3 matrix from probe head rotations given in decimal degrees
'rotations in order Z-Y-X
'dZ = RotB = about Z in XY plane
'dY = RotA = about Y in ZX plane
'Head(2,2) = probe head orientation for how mounted to CMM
Dim sinZ As Double, sinY As Double, cosZ As Double, cosY As Double
Dim T(2, 2) As Double
'perform 1 time evaluation of trig functions
sinZ = Sin(Radians(dZ)): sinY = Sin(Radians(dY))
cosZ = Cos(Radians(dZ)): cosY = Cos(Radians(dY))
T(0, 0) = cosZ * cosY
T(0, 1) = sinZ * cosY
T(0, 2) = sinY
T(1, 0) = -sinZ
T(1, 1) = cosZ
T(1, 2) = 0
T(2, 0) = -cosZ * sinY
T(2, 1) = -sinZ * sinY
T(2, 2) = cosY
Call MatMult(T, Head, M) 'put in machine axis
End Sub
