Rotated Star Tip

I sometimes use a single rotated star tip to measure 5th axis holes that would otherwise need a separate part setup. Auto Wrist Toggle does a good job for simple probe builds but ignores the adjustable nature of a star hub (rotational). One can nudge the tip around until it looks right but I grew tired of the trial by error method. I wanted to know what probe rotations along with star tip hub rotations might work for a given hole. After fooling around with Cartesian to Spherical conversions I ended up with the attached code. This is programmed in VBA and makes use of an Excel worksheet for output.

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

Parents

GomoFazter over 8 years ago

....have you ever been on an episode of "Big Band Theory" ? ? lol

If you are referring to Penny my dear sir I think a grudge is in the making (but, although not cheap I can be had). Given my disposition at times I would probably be better suited for a commercial having an ointment applied to the dark side.

Spent some time finishing what I had left out of the original posting. The following retrieves the head orientation from the registry and probe rotation limits of current probe from probe.dat.

Sub GetProbeHeadData()
    'get active probe head orientation & rotational paramaters
    'm00, m90180 = head orientation
    'ProbeParams() = rotational aspects

    Dim oApp As PCDLRN.Application
    Dim oPart As PCDLRN.PartProgram
    Dim oProbe As PCDLRN.Probe
    Dim sProbeDatFile As String  'location of probe.dat
    Dim sTmp As String, sHead As String
    Dim i As Integer  'loop counter
    Dim iFile As Integer  'for opening probe.dat file
    Dim vVar As Variant  'for parsing strings
    Dim iPos As Integer  'character location within string
    Dim ProbeParams(5) As Single  'Amin, Amax, Ainc, Bmin, Bmax, Binc
    Dim m00 As String, m90180 As String  'head orientation
    
    Set oApp = CreateObject("PCDLRN.Application")
    Set oPart = oApp.ActivePartProgram
    
    'get head orientation
    'unsure how to verify alternate arms, perhaps CMM2 = Dph9_s, CMM3 = Dph9_Arm3, CMM4 = Dph9_Arm4 ?
    If oPart.ActiveMachine.Name = "OFFLINE" Then
        m00 = oApp.GetRegistryString("Option", "Offline_Dph9_m00", "Null")
        m90180 = oApp.GetRegistryString("Option", "Offline_Dph9_m90180", "Null")
    Else  ' "CMM1"
        m00 = oApp.GetRegistryString("Option", "Dph9_m00", "Null")
        m90180 = oApp.GetRegistryString("Option", "Dph9_m90180", "Null")
    End If
    
    'find item name of head in current active probe build
    Set oProbe = oPart.Probes.Item(oPart.CurrentProbeName)  'current probe
    For i = 0 To oProbe.ConnectionCount - 1
[COLOR="#0000FF"]        sTmp = oProbe.ConnectionDescription(I)  'item name as displayed in drop-down list
        sTmp = Replace(sTmp, Chr(9), "")  'remove possible leading tabs
        sTmp = Replace(sTmp, " NoDraw", "")  'remove hidden display status suffix
        sTmp = Trim(Replace(sTmp, "Connect:", ""))  'remove possible prefix
[/COLOR]        If UCase(Left$(sTmp, 5)) = "JOINT" Then Exit For  'previous connection was head (saved in sHead)
        sHead = sTmp  'save current connection
    Next i
    
    'find head in probe.dat and pull rotational parameters
    sProbeDatFile = oApp.Path & "probe.dat"  'location of probe.dat
    iFile = FreeFile  'next available file number
    Open sProbeDatFile For Input Access Read As #iFile
    Do While Not EOF(iFile)
        Line Input #iFile, sTmp
        sTmp = Trim(sTmp)
        If UCase(Right$(sTmp, 3)) = "ARM" Then  'have a candidate
            If Mid$(sTmp, 6, InStr(7, sTmp, " ", vbTextCompare) - 6) = sHead Then  'have our head
                While UCase(Left$(sTmp, 7)) <> "CONNECT"
                    If UCase(Left$(sTmp, 9)) = "AUTOJOINT" Or UCase(Left$(sTmp, 11)) = "MANUALJOINT" Then
                        vVar = Split(sTmp, " ")
                        i = Asc(UCase(vVar(11))) - 65  'documentation says B angle always comes first
                        ProbeParams(i * 3) = vVar(9)  'min rotation
                        ProbeParams(i * 3 + 1) = vVar(10) 'max rotation
                        ProbeParams(i * 3 + 2) = vVar(8) 'rotation increment
                    End If
                    Line Input #iFile, sTmp
                Wend
                Exit Do
            End If
        End If
    Loop
    Close #iFile
    
    Set oProbe = Nothing
    Set oPart = Nothing
    Set oApp = Nothing
End Sub

Reply

GomoFazter over 8 years ago

....have you ever been on an episode of "Big Band Theory" ? ? lol

Sub GetProbeHeadData()
    'get active probe head orientation & rotational paramaters
    'm00, m90180 = head orientation
    'ProbeParams() = rotational aspects

    Dim oApp As PCDLRN.Application
    Dim oPart As PCDLRN.PartProgram
    Dim oProbe As PCDLRN.Probe
    Dim sProbeDatFile As String  'location of probe.dat
    Dim sTmp As String, sHead As String
    Dim i As Integer  'loop counter
    Dim iFile As Integer  'for opening probe.dat file
    Dim vVar As Variant  'for parsing strings
    Dim iPos As Integer  'character location within string
    Dim ProbeParams(5) As Single  'Amin, Amax, Ainc, Bmin, Bmax, Binc
    Dim m00 As String, m90180 As String  'head orientation
    
    Set oApp = CreateObject("PCDLRN.Application")
    Set oPart = oApp.ActivePartProgram
    
    'get head orientation
    'unsure how to verify alternate arms, perhaps CMM2 = Dph9_s, CMM3 = Dph9_Arm3, CMM4 = Dph9_Arm4 ?
    If oPart.ActiveMachine.Name = "OFFLINE" Then
        m00 = oApp.GetRegistryString("Option", "Offline_Dph9_m00", "Null")
        m90180 = oApp.GetRegistryString("Option", "Offline_Dph9_m90180", "Null")
    Else  ' "CMM1"
        m00 = oApp.GetRegistryString("Option", "Dph9_m00", "Null")
        m90180 = oApp.GetRegistryString("Option", "Dph9_m90180", "Null")
    End If
    
    'find item name of head in current active probe build
    Set oProbe = oPart.Probes.Item(oPart.CurrentProbeName)  'current probe
    For i = 0 To oProbe.ConnectionCount - 1
[COLOR="#0000FF"]        sTmp = oProbe.ConnectionDescription(I)  'item name as displayed in drop-down list
        sTmp = Replace(sTmp, Chr(9), "")  'remove possible leading tabs
        sTmp = Replace(sTmp, " NoDraw", "")  'remove hidden display status suffix
        sTmp = Trim(Replace(sTmp, "Connect:", ""))  'remove possible prefix
[/COLOR]        If UCase(Left$(sTmp, 5)) = "JOINT" Then Exit For  'previous connection was head (saved in sHead)
        sHead = sTmp  'save current connection
    Next i
    
    'find head in probe.dat and pull rotational parameters
    sProbeDatFile = oApp.Path & "probe.dat"  'location of probe.dat
    iFile = FreeFile  'next available file number
    Open sProbeDatFile For Input Access Read As #iFile
    Do While Not EOF(iFile)
        Line Input #iFile, sTmp
        sTmp = Trim(sTmp)
        If UCase(Right$(sTmp, 3)) = "ARM" Then  'have a candidate
            If Mid$(sTmp, 6, InStr(7, sTmp, " ", vbTextCompare) - 6) = sHead Then  'have our head
                While UCase(Left$(sTmp, 7)) <> "CONNECT"
                    If UCase(Left$(sTmp, 9)) = "AUTOJOINT" Or UCase(Left$(sTmp, 11)) = "MANUALJOINT" Then
                        vVar = Split(sTmp, " ")
                        i = Asc(UCase(vVar(11))) - 65  'documentation says B angle always comes first
                        ProbeParams(i * 3) = vVar(9)  'min rotation
                        ProbeParams(i * 3 + 1) = vVar(10) 'max rotation
                        ProbeParams(i * 3 + 2) = vVar(8) 'rotation increment
                    End If
                    Line Input #iFile, sTmp
                Wend
                Exit Do
            End If
        End If
    Loop
    Close #iFile
    
    Set oProbe = Nothing
    Set oPart = Nothing
    Set oApp = Nothing
End Sub

Children

No Data