' A snippet for calculating the max and min values from
' an autocircle using two-points method.
' Requirements:
' A circle with all probehits on the same level, preferably an autocircle
' (otherwise calculation might be wrong)
' There must be an even amount of hits used to measure the circle
' (otherwise calculation WILL be wrong)
' Two already created elements for storing the values
' (preferable two generic points)
'
' Call it by inserting a call to a basic script
' ARG1 must be the featurename of the circle you want to calculate
' ARG2 must be the featurename of the generic point that will hold the MAX value
' ARG3 must be the featurename of the generic point that will hold the MIN value
'
' Note: ARG2 and ARG3 are optional, if they are left blank, you will need to
' tweak the script to suit your needs. I.e code your own method to pass the results
' to PC-DMIS.
'
' (c) vpt.se in 2011
'
Option Base 1
Sub Main(inFeature As String, featnamemax As String, featnamemin As String)
Dim PCDApp, PCDPartPrograms, PCDPartProgram, PCDCommands, PCDCommand, PCDFeatCmd, prbhit1, prbhit2
Dim nhits, half As Long
Dim ardim(), x, y, z, dist, distmin, distmax As Double
Dim i, minidx, maxidx, minidx2, maxidx2 As Integer
'Initialization
Set PCDApp = CreateObject("PCDLRN.Application")
Set PCDPartPrograms = PCDApp.PartPrograms
Set PCDPartProgram = PCDApp.ActivePartProgram
Set PCDCommands = PCDPartProgram.Commands
Set prbhit = CreateObject("PCDLRN.PointData")
'Check the Type of inFeature - must be DCC autocircle, otherwise abort
Set PCDCommand = PCDCommands.Item(inFeature)
Set PCDFeatCmd = PCDCommand.FeatureCommand
If Not PCDCommand.IsDCCFeature Or PCDCommand.TypeDescription = AUTO_CIRCLE Then
MsgBox "Source feature is wrong type!"
Else ' Get the number of hits - must be an even number Or the algorithm will fail!
nhits = PCDFeatCmd.NumHits
half = nhits / 2
ReDim ardim(half)
For i = 1 To half ' Enumerate through the hits
Set prbhit1 = PCDFeatCmd.GetHit(i, FHITDATA_CENTROID, FDATA_MEAS, FDATA_PART, AlignID, PLANE_TOP)
Set prbhit2 = PCDFeatCmd.GetHit(i+half, FHITDATA_CENTROID, FDATA_MEAS, FDATA_PART, AlignID, PLANE_TOP)
x = prbhit2.x - prbhit1.x
y = prbhit2.y - prbhit1.y
z = prbhit2.z - prbhit1.z
x = abs(x * x)
y = abs(y * y)
z = abs(z * z)
dist = x+y+z
dist = sqr(dist) ' Calculate the distance between them
ardim(i) = dist ' Save it To the array
Next i
distmin = ardim(1)
distmax = ardim(1)
minidx = 1
maxidx = 1
For i = 1 To half ' Find the max And min
If distmin < ardim(i) Then
distmin = distmin
Else
distmin = ardim(i)
minidx = i ' save hit number
End If
If distmax > ardim(i) Then
distmax = distmax
Else
distmax = ardim(i)
maxidx = i ' save hit number
End If
Next i
maxidx2 = maxidx + half ' Get the opposing hits
minidx2 = minidx + half
End If
' distmax contains the largest distance
' maxidx contains the first hit of distmax
' maxidx2 contains the second hit (the opposing point)
' distmin contains the smallest distance
' minidx contains the first hit of distmin
' minidx2 contains the second hit (the opposing point)
' If destination featurenames were provided, Put the values into them
' For the max values
If featnamemax <> "" Then
Set PCDCommand = PCDCommands.Item(featnamemax)
PCDCommand.Marked = True
retval = PCDCommand.PutText (distmax, MEAS_X, 0)
retval = PCDCommand.PutText (maxidx, MEAS_Y, 0)
retval = PCDCommand.PutText (maxidx2, MEAS_Z, 0)
End If
' For the min values
If featnamemin <> "" Then
Set PCDCommand = PCDCommands.Item(featnamemin)
PCDCommand.Marked = True
retval = PCDCommand.PutText (distmin, MEAS_X, 0)
retval = PCDCommand.PutText (minidx, MEAS_Y, 0)
retval = PCDCommand.PutText (minidx2, MEAS_Z, 0)
End If
'Cleanup
Set prbhit1 = Nothing
Set prbhit2 = Nothing
Set PCDFeatCmd = Nothing
Set PCDCommands = Nothing
Set PCDPartProgram = Nothing
Set PCDPartPrograms = Nothing
Set PCDApp = Nothing
End Sub
