Request Macro : Calculate Area And Length In CorelDraw

This Macro Request by Albert Gilm on Youtube GRAFISin Channels for Calculate Area & I Add Calculate Length too. Try This:

Sub doCalculateArea()
On Error Resume Next
Dim s As Shape, sr As ShapeRange, s2 As Shape
Dim oldUnit As cdrUnit, newUnit As cdrUnit
Dim strUnit As String, strArea As String
Dim strMessage As String

Dim myOptionUnit, myOptionInfo


ActiveDocument.ReferencePoint = cdrCenter
'=== DEFAULT UNIT
newUnit = cdrMillimeter
strUnit = "mm"
strArea = "²" 'SUBSCRIPT '2'

myOptionUnit = InputBox("Enter Value 0 (mm), 1 (inch), 2 (cm)", "Change Unit:", 0)
myOptionInfo = InputBox("Enter Value 0 (Dialog Box), 1 (Create Text In Object Selected)", "Option for Info Area:", 0)
   

If myOptionUnit = 1 Then
    newUnit = cdrInch
    strUnit = "inch"
ElseIf myOptionUnit = 2 Then
    newUnit = cdrCentimeter
    strUnit = "cm"
End If

'=== CHANGE UNIT
'For Reset to Recent Document Unit
oldUnit = ActiveDocument.Unit
ActiveDocument.Unit = newUnit


Set sr = ActiveSelectionRange
For Each s In sr
    'IF NOT BITMAP & NOT CURVES MUST BE CONVERT TO CURVE
    If s.Type <> cdrBitmapShape And s.Type <> cdrCurveShape Then s.ConvertToCurves
   
    strMessage = "Name : " & s.Name & vbCrLf & "Area : " & s.Curve.Area & " " & strUnit & strArea & vbCrLf & "Length : " & s.Curve.Length & " " & strUnit & strArea & vbCrLf
   
    ' REMOVE ' BEFORE MsgBox If you want to Get Info By Dialog Message
  
    '========= START OPTION INFO
    If myOptionInfo = 0 Then
        MsgBox "Name : " & s.Name & vbCrLf & "Area : " & s.Curve.Area & " " & strUnit & strArea & vbCrLf & "Length : " & s.Curve.Length & " " & strUnit & strArea & vbCrLf
    Else
        '========== START CREATE INFO TEXT
        If s.Type = cdrCurveShape Then
   
            'CREATE INFO AREA IN ACTIVE LAYER WITH ARTISTIC TEXT
            Set s2 = ActiveLayer.CreateArtisticText(0, 0, strMessage, , , , 6)
       
            'ALIGN TEXT INFO AREA TO CURRENT SHAPE
            s2.AlignToShape cdrAlignHCenter + cdrAlignVCenter, s
           
            Set s2 = Nothing
        End If
        '========== END CREATE INFO TEXT
    End If
    '========= END OPTION INFO
   
   
Next s

'RESET TO RECENT DEFAULT UNIT
ActiveDocument.Unit = oldUnit

End Sub

http://www.grafisin.com/2018/06/request-macro-calculate-area-and-length.html

Follow GRAFISin Channels on Youtube