Home Image-Pro Automation (Macros, Apps, Reports)

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

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

Best Answer

  • Answer ✓
    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

Answers

  • 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
  • 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

  • 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

  • 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
Sign In or Register to comment.