I'm trying to measure a bunch of radii from scanned data. They have all varying arc lengths. Some much less that the suggested 90°. So, I was going to create offset points from the nominal center of all the constructed arcs. Then use the nominal center points and a point from the arc (ex: CIR1.HIT[CIR1.NUMHITS/2]) and create a best fit line then measure the length of the line to get the size of the radius. I've got approximate 350 constructed circles from scan segment. So I'm trying to write a code to construct the points and the lines. For the record, I have no idea what I'm doing. I've just cobbled together a few things I've seen on here. I get the code to run without error but nothing happens. No features get created. What am I doing wrong?
Sub Main()
Dim PCDApp As Object
Dim PCDPartPrograms As Object
Dim PCDPartProgram As Object
Dim PCDCommands As Object
Dim PCDCommand As Object
Dim cmd As Object
Set PCDApp = CreateObject("PCDLRN.Application")
Set PCDPartPrograms = PCDApp.PartPrograms
Set PCDPartProgram = PCDApp.ActivePartProgram
Set PCDCommands = PCDPartProgram.Commands
Dim NumFeat As Integer
Dim NumSelect As Integer
Dim I As Integer
Dim MidHit As Integer
Dim nX as Double
Dim nY as Double
Dim nZ as Double
Dim CircName As String
Dim CenterPtName As String
Dim RadLineName As String
Dim CircCenter
Dim PCDFeatCmd
NumFeat = 0
NumSelect = 0
' Enumerate commands
For Each PCDCommand In PCDCommands
' Constructed feature
If PCDCommand.IsConstructedFeature And PCDCommand.Feature = CONST_SCAN_SEG_ARC Then
CircName(NumFeat) = PCDCommand.ID
CenterPtName = CircName & "_CENTER"
RadLineName = CircName & "_RADLINE"
Set PCDFeatCmd = PCDCommand.FeatureCommand
Set CircCenter = PCDFeatCmd.GetPoint(FPOINT_CENTROID, FDATA_THEO, CircName)
nX = CDbl(CircCenter.X)
nY = CDbl(CircCenter.Y)
nZ = CDbl(CircCenter.Z)
MidHit = PCDCommand.GetText(N_HITS, 0) / 2
'CREATE OFFSET CENTERPOINT
Set cmd = PCDCommands.Add(511, True)
retval = cmd.PutText (nX, F_OFFSET, 1)
retval = cmd.PutText (nY, F_OFFSET, 2)
retval = cmd.PutText (nZ, F_OFFSET, 3)
retval = PCDCommand.PutText (CenterPtName, ID, 0)
retval = PCDCommand.SetToggleString ("ORIGIN", REF_ID, 0)
retval = PCDCommand.SetToggleString (1, COORD_TYPE, 0)
'CREATE BF RADIUS LINE
Set cmd = PCDCommands.Add(541, True)
retval = PCDCommand.PutText (CenterPtName, REF_ID, 1)
retval = PCDCommand.PutText (CircName & ".HIT[" & MidHit & ".." & MidHit & "]", REF_ID, 2)
retval = PCDCommand.PutText (RadLineName, ID, 0)
If (NumFeat < 1000) Then
NumFeat = NumFeat + 1
End If
End If
Next PCDCommand
PCDPartProgram.RefreshPart
'***** Cleanup
Set PCDCommand = Nothing
Set PCDCommands = Nothing
Set PCDPartProgram = Nothing
Set PCDPartPrograms = Nothing
Set PCDApp = Nothing
'*****
End Sub
typo
[edited by: Cliff Stearns at 5:01 PM (GMT -5) on May 9, 2025]
