Create a MEASUREMENT OBJECT from an ARRAY of POINTS . . .

mbatchelor

2017-11-29-113301

All --

In the NEWMACRO shown below, I have recorded MANUALLY creating a MEASUREMENT OBJECT with 4 POINTS.

I would like to modify this so that I feed an ARRAY of BOUNDARY POINTS to

    Measure.MeasurementsCommands.Add

and have a new MEASUREMENT OBJECT appear on my image.

How is the best way to achieve this?

Thanks in advance.

-- Matt

-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-

    Public Function NewMacro() As SimpleScript
        NewMacro = New SimpleScript
        Dim image1, meas1

        With Application.RibbonCommands.SelectRibbonTab(NewMacro)
            .TabName = "Measure"
            .Run()
        End With

        With Application.DocumentCommands.ActiveImage(NewMacro)
            .Run(image1)
        End With

        With Measure.MeasurementsCommands.Add(NewMacro)
            .MeasurementType = McMeasurements.enumMMSTypes.mmtsPolygon
            .Points = New System.Collections.Generic.List(Of System.Drawing.PointF)
            .Points.Add(New System.Drawing.PointF(211.9235F,302.3622F))
            .Points.Add(New System.Drawing.PointF(272.6659F,207.874F))
            .Points.Add(New System.Drawing.PointF(175.4781F,161.9798F))
            .Points.Add(New System.Drawing.PointF(137.6828F,218.6727F))
            .FeatureName = "P2"
            .SnapFeature = False
            .Run(image1, meas1)
        End With

    End Function

YuriG

Hi Matt,

It should be straight forward. As you can see, the Points property of the command is a List of PointF objects, your macro adds 4 points to the list. You can add any number of points to the list from your array using a loop.

Yuri

mbatchelor

2017-11-29-131434

Yuri --

I was not considering putting a LOOP within the WITH.

I'll give that a go.

Thanks for the guidance.

-- Matt

mbatchelor

2017-11-29-141036

Yuri --

Using the advice you gave me above, I modified the routine that I am working on.

The routine shown below takes the BOUNDARY for each OBJECT / FEATURE and makes a MIRROR IMAGE of the OBJECT / FEATURE across the X AXIS at the top of the OBJECT / FEATURE.

This can be seen in the DEVELOPMENT and TESTING IMAGES below with:

1)  Original Image before DARK COUNT
2)  Original Image after DARK COUNT
3)  Original Image after MirrorAndFilter

I have not wired in the CODE for the FILTER yet.

Thanks again.

-- Matt

-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-

    Private Sub button_MirrorAndFilter_Click(ByVal sender As System.Object,ByVal e As System.EventArgs) Handles button_MirrorAndFilter.Click

        'Declare LOCAL VARIABLES
        Dim docA, imageA, measA

        'Call the TILE function to put the current image into the upper left hand corner
        Application.MDICommands.TileVertically(Nothing).Run()

        'Connect with the ACTIVE IMAGE

        With Application.DocumentCommands.Active(Nothing)
            .Run(docA)
        End With

        With Application.DocumentCommands.ActiveImage(Nothing)
            .Run(imageA)
        End With

        'Find the calibration units and resolution

        Dim MyTempCalibUnits As String
        Dim MyTempCalibPixelSize As Single

        If (ThisApplication.ActiveImage.SpatialCalibration IsNot Nothing) _
            Then

                MyTempCalibUnits = _
                    ThisApplication.ActiveImage.SpatialCalibration.UnitAbbrev
                MyTempCalibPixelSize = _
                    ThisApplication.ActiveImage.SpatialCalibration.PixelSizeX
            Else

                MyTempCalibUnits = _
                    "pix"
                MyTempCalibPixelSize = _
                    1

            End If

        'Connect with the ACTIVE IMAGE
        Dim im As McImage =  ThisApplication.ActiveImage

        'Connect with the MEASUREMENT DATA in the ACTIVE IMAGE
        Dim md As McMMData = im.MeasurementsData

        'Loop through the FEATURES in the ACTIVE IMAGE
        For Each sf As McMMSubFeature In md.SubFeatures

                'Create an ARRAY to hold the BOUNDARY POINTS
                Dim points() As SINGLEPOINT = Nothing
                Dim mybox(4) As Single

                'Fill the POINTS ARRAY with the BOUNDARY POINTS for this FEATURE
                sf.GetFeatures.GetFeaturePoints(sf.FeatureIndex,points)

                'Fill the MYBOX ARRAY with the BOUNDING BOX for this FEATURE
                'sf.GetFeatures.GetFeatureBoundingBox(sf.FeatureIndex,left,top,right,bottom)
                sf.GetFeatures.GetFeatureBoundingBox(sf.FeatureIndex,mybox(0),mybox(1),mybox(2),mybox(3))

                'Using the POLYGON TOOL
                With Measure.MeasurementsCommands.Add(Nothing)
                    .MeasurementType = McMeasurements.enumMMSTypes.mmtsPolygon
                    .Points = New System.Collections.Generic.List(Of System.Drawing.PointF)

                    'Loop through the BOUNDARY POINTS
                    Dim MyXX As Double
                    Dim MyYY As Double
                    For Each p As SINGLEPOINT In points

                            'Calculate MyXX and MyYY for the MIRRORED BOUNDARY
                            MyXX = _
                                p.x * _
                                MyTempCalibPixelSize

                            MyYY = _
                                p.y * _
                                MyTempCalibPixelSize
                            MyYY = _
                                MyYY - _
                                ( 2 * ( MyYY - mybox(1) ) )

                            'Add the current MyXX, MyYY to the POLYGON
                            .Points.Add(New System.Drawing.PointF(MyXX,MyYY))

                        Next

                    .SnapFeature = False
                    .Run(imageA, measA)
                End With

            Next

        'If the MIRRORS IQM FILE EXISTS
        If (Dir (MacroDir & "\Measurements File -- Mirrors.iqm") <> "") _
            Then
                'Delete the LIGHTS IQM FILE
                Kill MacroDir & "\Measurements File -- Mirrors.iqm"
            End If

        'Save the MEASUREMENT OBJECTS in MIRRORS IQM FILE
        With Measure.MeasurementsCommands.Save(Nothing)
            .FileName = MacroDir & "\Measurements File -- Mirrors.iqm"
            .FilterIndex = 1
            .Run(docA)
        End With

    End Sub

BEFORE COUNT


AFTER COUNT


AFTER MIRROR

YuriG

Hi Matt,

The macro looks good! The only note is that you should not convert coordinates to calibrated units as both GetFeaturePoints and the Add command deal with uncalibrated pixel coordinates.

Yuri

mbatchelor

2017-11-29-161252

Yuri --

Thank you for the reminder about that.

I had it on my TO TO LIST to check this on a CALIBRATED IMAGE but I got distracted.

I'll revise, test, and post ASAP.

Thanks again.

-- Matt