CorelDRAW vba cdr插件 对象标注尺寸

Private Sub Cmdb6_Click()
Dim X As Double, Y As Double, Sx As Double, Sy As Double
Dim pt1 As SnapPoint, pt2 As SnapPoint
Dim s As Shape, SL As Shape, sr As ShapeRange
If ActiveShape Is Nothing Then Exit Sub
Set sr = ActiveSelection.Shapes.All

ActiveDocument.Unit = cdrMillimeter
    For Each s In sr
        s.GetBoundingBox X, Y, Sx, Sy
        Set pt1 = CreateSnapPoint(X, Y - 1)
        Set pt2 = CreateSnapPoint(X + Sx, Y - 1)
        Set SL = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pt1, pt2, True, Precision:=0, ShowUnits:=False, Placement:=cdrDimensionBelowLine, textsize:=IIf(Sx > Sy, Sy / 10, Sx / 10))
        SL.Dimension.TextShape.SetPosition s.CenterX, Y - IIf(Sx > Sy, Sy / 10, Sx / 10)
        With SL.Style.GetProperty("dimension")
'            .SetProperty "precision", 2 '       小数位数
'            .SetProperty "showUnits", 0 '       是否显示单位 0/1
            .SetProperty "textPlacement", 1 '   0、上方，1、下方，2、中间
'            .SetProperty "dynamicText", 0 '    是否可以编辑尺寸0/1
'            .SetProperty "overhang", 500000 '  0、上方，1、下方，2、中间
        End With
        Set pt1 = CreateSnapPoint(X + Sx + 1, Y)
        Set pt2 = CreateSnapPoint(X + Sx + 1, Y + Sy)
        Set SL = ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pt1, pt2, True, Precision:=0, ShowUnits:=False, Placement:=cdrDimensionBelowLine, textsize:=IIf(Sx > Sy, Sy / 10, Sx / 10))
        SL.Dimension.TextShape.SetPosition s.RightX + IIf(Sx > Sy, Sy / 10, Sx / 10), s.CenterY
        With SL.Style.GetProperty("dimension")
'            .SetProperty "precision", 2 '       小数位数
'            .SetProperty "showUnits", 0 '       是否显示单位 0/1
            .SetProperty "textPlacement", 1 '   0、上方，1、下方，2、中间
'            .SetProperty "dynamicText", 0 '    是否可以编辑尺寸0/1
'            .SetProperty "overhang", 500000 '  0、上方，1、下方，2、中间
        End With
    Next s


End Sub