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

How to determine lengths on the Pitch Line measurement?

How can I automate finding the lengths at the point of intersection of the perpendicular line whilst using the pitch tool e.g. values for X and Y?

Best Answer

  • Answer ✓
    Many thanks Nikita this works brilliantly - just what I needed.

Answers

  • Hi Chris,

    Premier has Pitch with line measurement that does exactly that, you can find it on Measure  tab.

    Yuri
  • Hi Chris,

    The following macro uses Pitch tool and report segment's length.

    Thanks,
    Nikita.

    Imports MediaCy.Addins.Scripting
    Imports MediaCy.Addins.Scripting.Workflow
    Imports MediaCy.Addins.Measurements
    
    Public Module Macros
    
        Public Function MeasureSegments() As SimpleScript
            MeasureSegments = New SimpleScript
            Dim doc1, data
    
            With Application.DocumentCommands.Active(MeasureSegments)
                .Run(doc1)
            End With
    
            With Measure.MeasurementsCommands.DeleteAll(MeasureSegments)
                .Run(doc1)
            End With
    
            With Measure.Measurements.ToolsCommands.PitchWithLine(MeasureSegments)
                .Tool = eMMTool.PitchWithLine
                .Interactive = True
                .Run(doc1)
            End With
    
            With Measure.Measurements.ToolsCommands.Select(MeasureSegments)
                .Tool = eMMTool.SelectionTool
                .Run(doc1)
            End With
    
            With Measure.MeasurementsCommands.GetData(MeasureSegments)
                .Run(doc1, data)
            End With
    
            With Automate.ScriptingCommands.CodeCommand(MeasureSegments)
                If .Run() Then
                    ' User Code Here
                    Dim mData As MediaCy.Addins.Measurements.McMMData = data
                    Dim mFeature As MediaCy.Addins.Measurements.McMMFeature
                    Dim mList As MediaCy.Addins.Measurements.McMMData.CollectionSf
                    Dim l1() As Double = Nothing, l2() As Double = Nothing, s1 As Double, s2 As Double, s As String
    
                    If mData IsNot Nothing AndAlso mData.Count > 0 Then
                        mFeature = mData.Item(0)
    
                        If mFeature IsNot Nothing Then
                            mList = mFeature.MainSubFeatures
    
                            If mList IsNot Nothing Then
                                For Each sf As MediaCy.Addins.Measurements.McMMSubFeature In mList
                                    If sf.FeatureType = McMMSubFeature.mcmmsfTypes.mcmmsfLine Then
                                        If l1 Is Nothing Then
                                            l1 = New Double(){sf.Value(eMeasures.LnStartX), sf.Value(eMeasures.LnStartY), sf.Value(eMeasures.LnEndX), sf.Value(eMeasures.LnEndY)}
                                        ElseIf l2 Is Nothing Then
                                            l2 = New Double(){sf.Value(eMeasures.LnStartX), sf.Value(eMeasures.LnStartY), sf.Value(eMeasures.LnEndX), sf.Value(eMeasures.LnEndY)}
                                        End If
                                    End If
                                Next
    
                                If (l1 IsNot Nothing) And (l2 IsNot Nothing) Then
                                    s1 = System.Math.Sqrt((l1(0) - l2(2))^2 + (l1(1) - l2(3))^2)
                                    s2 = System.Math.Sqrt((l1(2) - l2(2))^2 + (l1(3) - l2(3))^2)
    
                                    s = "Segment 1 = " & s1 & vbNewLine & "Segment 2 = " & s2
                                    Debug.Print(s)
    
                                    MsgBox(s)
                                End If
                            End If
                        End If
                    End If
                End If
            End With
        End Function
    
    End Module
    

Sign In or Register to comment.