' 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