Erosion Script

Hello David,

You can  use just one Count operation to speed it up. Add multiple ranges to thresholds and use it with Count (note that the ranges are overlapping), it will generate objects with increasing areas. Here is a sample macro:

  Public Sub MeasureDistMap
        Dim HighVal As Double=500'some high value
        Dim LowVal As Double=200'first threshold
        Dim ringStep As Double=5
        Dim MaxArea As Double

        With Measure.ThresholdToolCommands.Thresholds(Nothing)
            .AllowOverlap = True'specifically ALLOW overlap!!!
            .Interpretation = eInterpretation.Mono
            .Classes = New System.Collections.Generic.List(Of SegmentationClass)
            'create multiple segmentation ranges
            For z As Integer = 1 To 5
                .Classes.Add(New SegmentationClass("Class " & z,System.Drawing.Color.Yellow,New Double(){LowVal-ringStep*z,HighVal}))
            Next z
            .Run(ThisApplication.ActiveImage)
        End With
        '** Sets Count Size to Manual   **
        With Measure.MeasurementsCommands.Options(Nothing)
            .Segmentation.AutoFindPhase = MediaCy.IQL.Features.mcFindPhase.mcfpManual
            .Segmentation.SegmentationType = McMMOptions.mcmmSegmentationType.mcmmstThresholdSegmentation
            .Run(ThisApplication.ActiveImage)
        End With
        'execute count
        With Measure.MeasurementsCommands.ExecuteCount(Nothing)
            .Run(ThisApplication.ActiveImage)
        End With
        'print areas
        With ThisApplication.Output
            .Show
            Dim data As McMMData=ThisApplication.ActiveImage.MeasurementsData
            For Each sf As McMMSubFeature In data.SubFeatures
                MaxArea = sf.Value(eMeasures.RgnArea)
                .PrintMessage (MaxArea.ToString)
            Next
        End With
End Sub

Regards,

Yuri  

Hello David,

I missed that you want to have equal ring areas. 
If you want to have rings of equal area the best way would be to set threshold ranges after analyzing Histogram of the distance map, turning it to accumulated (to report area) and then calculate ranges based on that. It can still be done in one Count operation.

Here is the complete macro that will do that (note that you have to add reference to MediaCy.IQL.Operations.dll!):

  Public Sub SplitDistanceMapToEqualAreaRings
        Dim NumberOfRings As Integer=5'define number of rings
        Dim Ranges() As Double
        ReDim Ranges(NumberOfRings)
        Dim MaxArea As Double
        Dim i As Integer

        ThisApplication.Output.Show
        ThisApplication.Output.Clear

        Dim hist As MediaCy.IQL.Operations.McHistogram=ThisApplication.ActiveImage.Histogram
        'calculate accumulated area starting from 1
        Dim TotalArea As Double=0
        For i=1 To hist.BinCount-1
            TotalArea+=hist.Values(i)
        Next
        Dim targetRingArea As Double=TotalArea/NumberOfRings
        ThisApplication.Output.PrintMessage String.Format("Total distance map area = {0} Ring area = {1}",TotalArea,targetRingArea)
        'calculate threshold ranges for rings of (approximatelly) the same area
        Ranges(0)=1'start from 1
        Dim sum As Double=0
        Dim bin As Integer=1
        For i=1 To hist.BinCount-1
            sum+=hist.Values(i)
            If sum>=targetRingArea*bin Then
                Ranges(bin)=hist.BinXValues(i)'set threshold
                ThisApplication.Output.PrintMessage String.Format("Threshold {0} = {1}",bin,Ranges(bin))
                bin+=1'increment bin
            End If
        Next

        With Measure.ThresholdToolCommands.Thresholds(Nothing)
            .AllowOverlap = False
            .Interpretation = eInterpretation.Mono
            .Classes = New System.Collections.Generic.List(Of SegmentationClass)
            'create multiple segmentation ranges, RINGS based on the threshold ranges calculated from histogram
            For z As Integer = 1 To NumberOfRings
                .Classes.Add(New SegmentationClass("Class " & z,System.Drawing.Color.Yellow,New Double(){Ranges(z-1),Ranges(z)}))
            Next z
            .Run(ThisApplication.ActiveImage)
        End With
        '** Sets Count Size to Manual   **
        With Measure.MeasurementsCommands.Options(Nothing)
            .Segmentation.AutoFindPhase = MediaCy.IQL.Features.mcFindPhase.mcfpManual
            .Segmentation.SegmentationType = McMMOptions.mcmmSegmentationType.mcmmstThresholdSegmentation
            .Run(ThisApplication.ActiveImage)
        End With
        'execute count
        With Measure.MeasurementsCommands.ExecuteCount(Nothing)
            .Run(ThisApplication.ActiveImage)
        End With
        'print areas
        With ThisApplication.Output
            Dim data As McMMData=ThisApplication.ActiveImage.MeasurementsData
            For Each sf As McMMSubFeature In data.SubFeatures
                .PrintMessage String.Format("Ring {0} area = {1}",sf.Name, sf.Value(eMeasures.RgnArea))
            Next
        End With
End Sub

I've also attached the screenshot that shows rings with different thickness but the same area.

Regards,

Yuri

David,

You can just try my project (attached) on the demo images I used and then check what is the difference between your image and mine causing different areas. (areas in my test are the same as you can see from previous screenshot).

You can also send me your macro and image. Maybe the problem is in other part of your macro.

Regards,

Yuri