Adding to a list of points to create an AOI

NickB

(Originally posted by ytsejamr on 9/23/2005)

I'm trying to create an AOI based on a horizontal measurement line trace. I have the user create the trace, then I want to create an AOI that has that trace as the top of the "box", then the other 3 sides of the AOI are straight lines. I'm having a tough time explaining this, but basically the resulting AOI is a box with the top of the box being the line trace.

I'm having a problem adding the box corners to the list of points generated from the line trace.

I'm not sure if I need to add the box corners before the line trace points or after, or both. The problem is that the AOI is not being generated correctly. It seems like it's going far off of the image.

Here's the code:

Sub roughtest()
 Dim numPts As Integer, NumMeas As Integer, profPts() As PointAPI, aoiPts() As POINTAPI
 Dim workingDoc As Integer, i As Integer, aoiString As String

 ret = IpMeasShow(MEAS_SHOWADVANCED)
 ret = IpMeasTool(MEAS_TRACE)
 ret = IpMacroStop("Please trace the profile" & Chr(13) & "Select Continue when finished" , 0)
 'Get number of lines
 ret = IpMeasGet(GETNUMMEAS, 0, NumMeas)

 'Exit if there is more than one measurement
 If NumMeas > 1 Then
 ret = IpMacroStop("Please only create one measurement", MS_MODAL + MS_STOP)
 Exit Sub
 End If

 'Get the points that represent the line
 ret = IpMeasGet(GETNUMPTS,0, numPts)
 ReDim profPts(numPts -1)
 ret = IpMeasGet(GETPOINTS, 0, profPts(0))
 
'Get the width/height information of the image
 Dim dInfo As IPDOCINFO
 ret = IpDocGet(GETDOCINFO, DOCSEL_ACTIVE, dInfo)

 'Create a copy of the image to work with
 workingDoc = IpWsDuplicate()
 
'Fill the new image in black
 ret = IpWsFill(0, 3, 0)
 
'Create an AOI using the line trace as the top and extending all the way to the bottom of the image
 For i = 0 To numPts -1
 aoiString = aoiString & profPts(i).x & " " & profPts(i).y & " "
 Next i

 aoiString = aoiString & profPts(0).x & " " & dInfo.Height-1 & " "
 aoiString = aoiString & profPts(numPts-1).x & " " & dInfo.Height-1 & " "
aoiString = aoiString & profPts(0).x & " " & profPts(0).y
 
Dim newPts As Integer
 newPts = numPts + 3
 ret = IpListPts(Pts(0), aoiString)
 ret = IpAoiCreateIrregular(Pts(0), newPts)
End Sub

Thanks for any help,

-Brian

NickB

(Original response from Kryan 9/27/2005)

Adding the points at either the start or end of the array should work; here's some code I put together that does the job. Starting at the IpWsFill in your code:

...

'Fill the new image in black
ret = IpWsFill(0, 3, 0)

'Create an AOI using the line trace as the top and
'extending all the way to the bottom of the image.
'Copy points into a slightly larger array...
ReDim aoiPts(0 To numPts+1)
For i = 0 To numPts -1
aoiPts(i).x = profPts(i).x
aoiPts(i).y = profPts(i).y
Next i

' Add final points to close the AOI
aoiPts(numPts).x = aoiPts(numPts-1).x
aoiPts(numPts).y = dInfo.Height-1

aoiPts(numPts+1).x = aoiPts(0).x
aoiPts(numPts+1).y = dInfo.Height-1

' Create new aoi
ret = IpAoiCreateIrregular(aoiPts(0), numPts+2)
End Sub

Give that a try.

-- Kevin Ryan
Media Cybernetics, Inc.