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
Answers
Premier has Pitch with line measurement that does exactly that, you can find it on Measure tab.
Yuri
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