Creating Nominal Center Points of Constructed Scan Segment Arcs

Question

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&deg;. 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

WilliamL · Answer

I think this works. Only thing I noticed is that for some reason my Theo and Actual for the Line didn't match. Probably some weird math rounding going on in the background.

MIDP1      =FEAT/POINT,CARTESIAN,YES
            THEO/<-1.103,-0.6445,0.7911>,<0,0,1>
            ACTL/<-1.103,-0.6445,0.7911>,<0,0,1>
            CONSTR/POINT,OFFSET,ORIGIN,CIR1.TX,CIR1.TY,CIR1.TZ
MIDLINE1   =FEAT/LINE,CARTESIAN,UNBOUNDED,NO
            THEO/<-1.103,-0.6447,0.7911>,<-0.433579,0,0.9011156>
            ACTL/<-1.103,-0.6448,0.7911>,<-0.4331797,0,0.9013076>
            CONSTR/LINE,BF,2D,MIDP1,CIR1.HIT[5..5],,
            OUTLIER_REMOVAL/OFF,3
            FILTER/OFF,WAVELENGTH=0

Sub Main()

Dim DmisApp As Object
Dim DmisParts As Object
Dim DmisPart As Object
Dim DmisCmds As Object
Dim DmisCmd As Object
Dim FeatCmd As Object

Set DmisApp = CreateObject("PCDLRN.Application")
Set DmisParts = DmisApp.PartPrograms
Set DmisPart = DmisApp.ActivePartProgram
Set DmisCmds = DmisPart.Commands

Dim i As Integer
Dim nHits As Integer
Dim nX As Double
Dim nY As Double
Dim nZ As Double
Dim featureID As String
Dim pntID As String
Dim lineID As String
Dim Result As Long
Dim retval As Long

i = 0
For Each DmisCmd In DmisCmds
  If  DmisCmd.Type = CONST_SCAN_SEG_ARC Then 
    i = i + 1
    Set FeatCmd = DmisCmd.FeatureCommand
    pntID = "MIDP" & i
    lineID = "MIDLINE" & i
    featureID = DmisCmd
    nX = DmisCmd.GetText(THEO_X, 0)
    nY = DmisCmd.GetText(THEO_Y, 0)
    nZ = DmisCmd.GetText(THEO_Z, 0)
    nHit = Format(FeatCmd.NumHits / 2, "0")

    Set DmisCmd = DmisCmds.Add(CONST_OFF_POINT, True)
      DmisCmd.Marked = True      
      retval = DmisCmd.PutText(pntID, ID, 0)
      retval = DmisCmd.PutText("ORIGIN", REF_ID, 0)
      retval = DmisCmd.PutText (nX, THEO_X, 0)
      retval = DmisCmd.PutText (nY, THEO_Y, 0)
      retval = DmisCmd.PutText (nZ, THEO_Z, 0)
      Result = DmisCmd.SetExpression(featureID & ".TX", F_OFFSET, 1)
      Result = DmisCmd.SetExpression(featureID & ".TY", F_OFFSET, 2)
      Result = DmisCmd.SetExpression(featureID & ".TZ", F_OFFSET, 3)
     Set DmisCmd = DmisCmds.Add(CONST_BF_LINE, True)
      retval = DmisCmd.PutText(lineID, ID, 0)
      retval = DmisCmd.PutText(pntID, REF_ID, 1)
      retval = DmisCmd.PutText(featureID & ".HIT[" &  nHit & ".." & nHit & "]", REF_ID, 2)      

  End If
Next DmisCmd

DmisPart.RefreshPart

'***** Cleanup
Set DmisCmd = Nothing
Set DmisCmds = Nothing
Set DmisPart = Nothing
Set DmisParts = Nothing
Set DmisApp = Nothing

End Sub

Edit - Changed my usage of Left() function I used for testing for the rounding of hit number. Changed it to Format(value, "0") which properly rounds (up) rather than truncating. So in the event you have more than a single digit hit count, it will always just use the nearest whole number.