Need anyone help..!!

Here my requirement code

this is my record ( selected Object only )

please help..

Sub Label1()
' Recorded 6/13/2021
Dim s1 As Shape
Set s1 = ActiveLayer.CreateLineSegment(3.638768, 4.222035, 3.755059, 4.222035)
s1.Fill.ApplyNoFill
s1.Outline.SetPropertiesEx 0.006945, OutlineStyles(0), CreateRGBColor(0, 0, 0), ArrowHeads(0), ArrowHeads(0), cdrFalse, cdrFalse, cdrOutlineButtLineCaps, cdrOutlineMiterLineJoin, 0#, 100, MiterLimit:=45#, Justification:=cdrOutlineJustificationMiddle
ActiveDocument.ReferencePoint = cdrCenter
s1.SetSize 0.15748, 0.000016
Dim s2 As Shape
Set s2 = s1.Duplicate(0.303654, -0.452252)
s2.Move 0.303654, -0.452252
s2.OrderToFront
ActiveDocument.CreateShapeRangeFromArray(ActiveLayer.Shapes(3), s1).AlignAndDistribute 0, 1, 0, 0, False, 2
ActiveDocument.CreateShapeRangeFromArray(ActiveLayer.Shapes(3), s1).AlignAndDistribute 3, 0, 0, 0, False, 2
ActiveDocument.CreateShapeRangeFromArray(ActiveLayer.Shapes(3), s2).AlignAndDistribute 0, 2, 0, 0, False, 2
ActiveDocument.CreateShapeRangeFromArray(ActiveLayer.Shapes(3), s2).AlignAndDistribute 3, 0, 0, 0, False, 2
ActiveLayer.Shapes(3).Outline.SetNoOutline
End Sub

Thanks in Advance