Your Products have been synced, click here to refresh
Here is the Features to Points edited to create Vector and Generic Points from Auto Circle and Cylinder Sample Hits.
'=========================================================================== ' To Points ' ' Extracts hits from features And creates vectorpoints With ' the hits THEO's. ' ' The names are created from the source feature Name And a number that ' represents the hit index. ' ' Idea taken from 'to_points.exe' from the Wilcox Script Repository ' which sadly doesn't work As expected. ' ' (c) vpt.se 2010-06-15 ' Updated davehocum 20150311 ' 20150406 Added To Vector Sample Points, To Generic Sample Points, To Read Point And AndersI Live Gen. Points. ' Added Palor Check Box. Polar will remove the .HIT[ ] from the NOM And MEAS For the Live Gen. Points. ' Not all Auto Feature will work With the To Vector Sample Points And To Generic Sample Points. '=========================================================================== Sub Main() Dim PCDApp, PCDPartPrograms, PCDPartProgram, PCDCommands, PCDCommand Dim PCDFeatCmd Dim prbhit Dim numhits As Integer Set PCDApp = CreateObject("PCDLRN.Application") Set PCDPartPrograms = PCDApp.PartPrograms Set PCDPartProgram = PCDApp.ActivePartProgram Set PCDCommands = PCDPartProgram.Commands Dim cmd As Object Dim Fcntr As Integer Dim FeatureList$(9999) Dim hX As Double, hY As Double, hZ As Double, hI As Double, hJ As Double, hK As Double Dim tX, tY, tZ, mX, mY, mZ As String '***** Predialog START Fcntr = 0 ' Enumerate commands For Each cmd In PCDCommands '----- Measured (learned) feature 'If cmd.IsMeasuredFeature Then 'FeatureList(Fcntr) = cmd.ID 'Fcntr = Fcntr + 1 'End If '----- Autofeature (flagged As DCC feature) 'If cmd.IsDCCFeature Then 'FeatureList(Fcntr) = cmd.ID 'Fcntr = Fcntr + 1 'End If '----- Constructed feature 'If cmd.IsConstructedFeature Then 'FeatureList(Fcntr) = cmd.ID 'Fcntr = Fcntr + 1 'End If '----- All Features If cmd.IsFeature Then FeatureList(Fcntr) = cmd.ID Fcntr = Fcntr + 1 End If Next cmd '***** '***** Dialog START Begin Dialog DIALOG_1 31,48, 245, 280, "Feature to Points v2.0" ListBox 88,8,150,250, FeatureList$(), .ListBox PushButton 8,72,62,12, "To Vector S Pnts", .VsPointsBtn PushButton 8,93,62,12, "To Generic S Pnts", .GsPointsBtn PushButton 8,255,52,12, "Cancel", .CancelBtn End Dialog Dim Dlg1 As DIALOG_1 button = Dialog(Dlg1) ' button 0 = Cancel, button 1 = To Vector points, button 2 = To Cast Points, button 3 = To Generic Points, ' button 4 = To Vector S Pnts, button 5 = To Generic S Pnts, button 6 = To Read Point, button 7 = Live Gen. Points, button 8 = Random Error, '***** '***** Vector Point Generation Sample Hits Fcntr = 0 If button = 1 Then Set PCDCommand = PCDCommands.Item(FeatureList(Dlg1.Listbox)) Set PCDFeatCmd = PCDCommand.FeatureCommand numhits = PCDFeatCmd.PermHits Set prbhit = CreateObject("PCDLRN.PointData") For Fcntr = 1 To numhits ' Get the probehits - XYZ Set prbhit = PCDFeatCmd.GetSampleHit(Fcntr, FHITDATA_CENTROID, FDATA_THEO, FDATA_PART, AlignID, PLANE_TOP) vX = CDbl(prbhit.X) vY = CDbl(prbhit.Y) vZ = CDbl(prbhit.Z) ' Get the probehits - IJK Set prbhit = PCDFeatCmd.GetSampleHit(Fcntr, FHITDATA_VECTOR, FDATA_THEO, FDATA_PART, AlignID, PLANE_TOP) vI = CDbl(prbhit.X) vJ = CDbl(prbhit.Y) vK = CDbl(prbhit.Z) ' Create Vector points feature "AUTO__VECTOR_HIT" (COMMAND INFORMATION CODE edit screen) 602 ' Create Cast points feature "CONST__CAST_POINT" (COMMAND INFORMATION CODE edit screen) 517 ' Create Generic points feature "GENERIC_CONSTUCTION" (COMMAND INFORMATION CODE edit screen) 597 ' Create Constructed Feature Set "CONST__SET" (COMMAND INFORMATION CODE edit screen) 596 Set cmd = PCDCommands.Add(602, True) cmd.Marked = True 'Featurename is "sourcefeaturename-hitnumber" -> PLANE1-1 retval = cmd.PutText (PCDCommand.ID & "_S" & Fcntr, ID, 0) 'Result = cmd.SetExpression (PCDCommand.ID & "." & "HIT" & "[" & Fcntr & "]" , REF_ID, 0) ' Theo's retval = cmd.PutText (vX, THEO_X, 0) retval = cmd.PutText (vY, THEO_Y, 0) retval = cmd.PutText (vZ, THEO_Z, 0) retval = cmd.PutText (vI, THEO_I, 0) retval = cmd.PutText (vJ, THEO_J, 0) retval = cmd.PutText (vK, THEO_K, 0) ' Actl's retval = cmd.PutText (vX, MEAS_X, 0) retval = cmd.PutText (vY, MEAS_Y, 0) retval = cmd.PutText (vZ, MEAS_Z, 0) retval = cmd.PutText (vI, MEAS_I, 0) retval = cmd.PutText (vJ, MEAS_J, 0) retval = cmd.PutText (vK, MEAS_K, 0) ' Targ's retval = cmd.PutText (vX, TARG_X, 0) retval = cmd.PutText (vY, TARG_Y, 0) retval = cmd.PutText (vZ, TARG_Z, 0) retval = cmd.PutText (vI, TARG_I, 0) retval = cmd.PutText (vJ, TARG_J, 0) retval = cmd.PutText (vK, TARG_K, 0) PCDPartProgram.RefreshPart cmd.ReDraw Next MsgBox "Vector Point Generation Sample Hits Complete" End If '***** Generic Point Generation Sample Hits Fcntr = 0 If button = 2 Then Set PCDCommand = PCDCommands.Item(FeatureList(Dlg1.Listbox)) Set PCDFeatCmd = PCDCommand.FeatureCommand numhits = PCDFeatCmd.PermHits Set prbhit = CreateObject("PCDLRN.PointData") For Fcntr = 1 To numhits ' Get the probehits - XYZ Set prbhit = PCDFeatCmd.GetSampleHit(Fcntr, FHITDATA_CENTROID, FDATA_THEO, FDATA_PART, AlignID, PLANE_TOP) gX = CDbl(prbhit.X) gY = CDbl(prbhit.Y) gZ = CDbl(prbhit.Z) ' Get the probehits - IJK Set prbhit = PCDFeatCmd.GetSampleHit(Fcntr, FHITDATA_VECTOR, FDATA_THEO, FDATA_PART, AlignID, PLANE_TOP) gI = CDbl(prbhit.X) gJ = CDbl(prbhit.Y) gK = CDbl(prbhit.Z) ' Create Vector points feature "AUTO__VECTOR_HIT" (COMMAND INFORMATION CODE edit screen) 602 ' Create Cast points feature "CONST__CAST_POINT" (COMMAND INFORMATION CODE edit screen) 517 ' Create Generic points feature "GENERIC_CONSTUCTION" (COMMAND INFORMATION CODE edit screen) 597 ' Create Constructed Feature Set "CONST__SET" (COMMAND INFORMATION CODE edit screen) 596 Set cmd = PCDCommands.Add(597, True) cmd.Marked = True 'Featurename is "sourcefeaturename-hitnumber" -> PLANE1-1 retval = cmd.PutText (PCDCommand.ID & "_SG" & Fcntr, ID, 0) 'Result = cmd.SetExpression (PCDCommand.ID & "." & "HIT" & "[" & Fcntr & "]" , REF_ID, 0) ' Theo's retval = cmd.PutText (gX, THEO_X, 0) retval = cmd.PutText (gY, THEO_Y, 0) retval = cmd.PutText (gZ, THEO_Z, 0) retval = cmd.PutText (gI, THEO_I, 0) retval = cmd.PutText (gJ, THEO_J, 0) retval = cmd.PutText (gK, THEO_K, 0) ' Actl's retval = cmd.PutText (gX, MEAS_X, 0) retval = cmd.PutText (gY, MEAS_Y, 0) retval = cmd.PutText (gZ, MEAS_Z, 0) retval = cmd.PutText (gI, MEAS_I, 0) retval = cmd.PutText (gJ, MEAS_J, 0) retval = cmd.PutText (gK, MEAS_K, 0) ' Targ's retval = cmd.PutText (gX, TARG_X, 0) retval = cmd.PutText (gY, TARG_Y, 0) retval = cmd.PutText (gZ, TARG_Z, 0) retval = cmd.PutText (gI, TARG_I, 0) retval = cmd.PutText (gJ, TARG_J, 0) retval = cmd.PutText (gK, TARG_K, 0) PCDPartProgram.RefreshPart cmd.ReDraw Next MsgBox "Generic Point Generation Sample Hits Complete" End If '***** '***** '***** Cleanup Set PCDApp = Nothing Set PCDPartPrograms = Nothing Set PCDPartProgram = Nothing Set PCDCommands = Nothing Set prbhit = Nothing '***** End Sub
Here is the Features to Points edited to create Vector and Generic Points from Auto Circle and Cylinder Sample Hits.
'=========================================================================== ' To Points ' ' Extracts hits from features And creates vectorpoints With ' the hits THEO's. ' ' The names are created from the source feature Name And a number that ' represents the hit index. ' ' Idea taken from 'to_points.exe' from the Wilcox Script Repository ' which sadly doesn't work As expected. ' ' (c) vpt.se 2010-06-15 ' Updated davehocum 20150311 ' 20150406 Added To Vector Sample Points, To Generic Sample Points, To Read Point And AndersI Live Gen. Points. ' Added Palor Check Box. Polar will remove the .HIT[ ] from the NOM And MEAS For the Live Gen. Points. ' Not all Auto Feature will work With the To Vector Sample Points And To Generic Sample Points. '=========================================================================== Sub Main() Dim PCDApp, PCDPartPrograms, PCDPartProgram, PCDCommands, PCDCommand Dim PCDFeatCmd Dim prbhit Dim numhits As Integer Set PCDApp = CreateObject("PCDLRN.Application") Set PCDPartPrograms = PCDApp.PartPrograms Set PCDPartProgram = PCDApp.ActivePartProgram Set PCDCommands = PCDPartProgram.Commands Dim cmd As Object Dim Fcntr As Integer Dim FeatureList$(9999) Dim hX As Double, hY As Double, hZ As Double, hI As Double, hJ As Double, hK As Double Dim tX, tY, tZ, mX, mY, mZ As String '***** Predialog START Fcntr = 0 ' Enumerate commands For Each cmd In PCDCommands '----- Measured (learned) feature 'If cmd.IsMeasuredFeature Then 'FeatureList(Fcntr) = cmd.ID 'Fcntr = Fcntr + 1 'End If '----- Autofeature (flagged As DCC feature) 'If cmd.IsDCCFeature Then 'FeatureList(Fcntr) = cmd.ID 'Fcntr = Fcntr + 1 'End If '----- Constructed feature 'If cmd.IsConstructedFeature Then 'FeatureList(Fcntr) = cmd.ID 'Fcntr = Fcntr + 1 'End If '----- All Features If cmd.IsFeature Then FeatureList(Fcntr) = cmd.ID Fcntr = Fcntr + 1 End If Next cmd '***** '***** Dialog START Begin Dialog DIALOG_1 31,48, 245, 280, "Feature to Points v2.0" ListBox 88,8,150,250, FeatureList$(), .ListBox PushButton 8,72,62,12, "To Vector S Pnts", .VsPointsBtn PushButton 8,93,62,12, "To Generic S Pnts", .GsPointsBtn PushButton 8,255,52,12, "Cancel", .CancelBtn End Dialog Dim Dlg1 As DIALOG_1 button = Dialog(Dlg1) ' button 0 = Cancel, button 1 = To Vector points, button 2 = To Cast Points, button 3 = To Generic Points, ' button 4 = To Vector S Pnts, button 5 = To Generic S Pnts, button 6 = To Read Point, button 7 = Live Gen. Points, button 8 = Random Error, '***** '***** Vector Point Generation Sample Hits Fcntr = 0 If button = 1 Then Set PCDCommand = PCDCommands.Item(FeatureList(Dlg1.Listbox)) Set PCDFeatCmd = PCDCommand.FeatureCommand numhits = PCDFeatCmd.PermHits Set prbhit = CreateObject("PCDLRN.PointData") For Fcntr = 1 To numhits ' Get the probehits - XYZ Set prbhit = PCDFeatCmd.GetSampleHit(Fcntr, FHITDATA_CENTROID, FDATA_THEO, FDATA_PART, AlignID, PLANE_TOP) vX = CDbl(prbhit.X) vY = CDbl(prbhit.Y) vZ = CDbl(prbhit.Z) ' Get the probehits - IJK Set prbhit = PCDFeatCmd.GetSampleHit(Fcntr, FHITDATA_VECTOR, FDATA_THEO, FDATA_PART, AlignID, PLANE_TOP) vI = CDbl(prbhit.X) vJ = CDbl(prbhit.Y) vK = CDbl(prbhit.Z) ' Create Vector points feature "AUTO__VECTOR_HIT" (COMMAND INFORMATION CODE edit screen) 602 ' Create Cast points feature "CONST__CAST_POINT" (COMMAND INFORMATION CODE edit screen) 517 ' Create Generic points feature "GENERIC_CONSTUCTION" (COMMAND INFORMATION CODE edit screen) 597 ' Create Constructed Feature Set "CONST__SET" (COMMAND INFORMATION CODE edit screen) 596 Set cmd = PCDCommands.Add(602, True) cmd.Marked = True 'Featurename is "sourcefeaturename-hitnumber" -> PLANE1-1 retval = cmd.PutText (PCDCommand.ID & "_S" & Fcntr, ID, 0) 'Result = cmd.SetExpression (PCDCommand.ID & "." & "HIT" & "[" & Fcntr & "]" , REF_ID, 0) ' Theo's retval = cmd.PutText (vX, THEO_X, 0) retval = cmd.PutText (vY, THEO_Y, 0) retval = cmd.PutText (vZ, THEO_Z, 0) retval = cmd.PutText (vI, THEO_I, 0) retval = cmd.PutText (vJ, THEO_J, 0) retval = cmd.PutText (vK, THEO_K, 0) ' Actl's retval = cmd.PutText (vX, MEAS_X, 0) retval = cmd.PutText (vY, MEAS_Y, 0) retval = cmd.PutText (vZ, MEAS_Z, 0) retval = cmd.PutText (vI, MEAS_I, 0) retval = cmd.PutText (vJ, MEAS_J, 0) retval = cmd.PutText (vK, MEAS_K, 0) ' Targ's retval = cmd.PutText (vX, TARG_X, 0) retval = cmd.PutText (vY, TARG_Y, 0) retval = cmd.PutText (vZ, TARG_Z, 0) retval = cmd.PutText (vI, TARG_I, 0) retval = cmd.PutText (vJ, TARG_J, 0) retval = cmd.PutText (vK, TARG_K, 0) PCDPartProgram.RefreshPart cmd.ReDraw Next MsgBox "Vector Point Generation Sample Hits Complete" End If '***** Generic Point Generation Sample Hits Fcntr = 0 If button = 2 Then Set PCDCommand = PCDCommands.Item(FeatureList(Dlg1.Listbox)) Set PCDFeatCmd = PCDCommand.FeatureCommand numhits = PCDFeatCmd.PermHits Set prbhit = CreateObject("PCDLRN.PointData") For Fcntr = 1 To numhits ' Get the probehits - XYZ Set prbhit = PCDFeatCmd.GetSampleHit(Fcntr, FHITDATA_CENTROID, FDATA_THEO, FDATA_PART, AlignID, PLANE_TOP) gX = CDbl(prbhit.X) gY = CDbl(prbhit.Y) gZ = CDbl(prbhit.Z) ' Get the probehits - IJK Set prbhit = PCDFeatCmd.GetSampleHit(Fcntr, FHITDATA_VECTOR, FDATA_THEO, FDATA_PART, AlignID, PLANE_TOP) gI = CDbl(prbhit.X) gJ = CDbl(prbhit.Y) gK = CDbl(prbhit.Z) ' Create Vector points feature "AUTO__VECTOR_HIT" (COMMAND INFORMATION CODE edit screen) 602 ' Create Cast points feature "CONST__CAST_POINT" (COMMAND INFORMATION CODE edit screen) 517 ' Create Generic points feature "GENERIC_CONSTUCTION" (COMMAND INFORMATION CODE edit screen) 597 ' Create Constructed Feature Set "CONST__SET" (COMMAND INFORMATION CODE edit screen) 596 Set cmd = PCDCommands.Add(597, True) cmd.Marked = True 'Featurename is "sourcefeaturename-hitnumber" -> PLANE1-1 retval = cmd.PutText (PCDCommand.ID & "_SG" & Fcntr, ID, 0) 'Result = cmd.SetExpression (PCDCommand.ID & "." & "HIT" & "[" & Fcntr & "]" , REF_ID, 0) ' Theo's retval = cmd.PutText (gX, THEO_X, 0) retval = cmd.PutText (gY, THEO_Y, 0) retval = cmd.PutText (gZ, THEO_Z, 0) retval = cmd.PutText (gI, THEO_I, 0) retval = cmd.PutText (gJ, THEO_J, 0) retval = cmd.PutText (gK, THEO_K, 0) ' Actl's retval = cmd.PutText (gX, MEAS_X, 0) retval = cmd.PutText (gY, MEAS_Y, 0) retval = cmd.PutText (gZ, MEAS_Z, 0) retval = cmd.PutText (gI, MEAS_I, 0) retval = cmd.PutText (gJ, MEAS_J, 0) retval = cmd.PutText (gK, MEAS_K, 0) ' Targ's retval = cmd.PutText (gX, TARG_X, 0) retval = cmd.PutText (gY, TARG_Y, 0) retval = cmd.PutText (gZ, TARG_Z, 0) retval = cmd.PutText (gI, TARG_I, 0) retval = cmd.PutText (gJ, TARG_J, 0) retval = cmd.PutText (gK, TARG_K, 0) PCDPartProgram.RefreshPart cmd.ReDraw Next MsgBox "Generic Point Generation Sample Hits Complete" End If '***** '***** '***** Cleanup Set PCDApp = Nothing Set PCDPartPrograms = Nothing Set PCDPartProgram = Nothing Set PCDCommands = Nothing Set prbhit = Nothing '***** End Sub
© 2024 Hexagon AB and/or its subsidiaries. | Privacy Policy | Cloud Services Agreement |