Added preset attributes to dimensions, minimized the button and repaired the CorelDRAW high version without error

UI/Woodman.bas

@@ -1,10 +1,10 @@
 VERSION 5.00
 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} Woodman 
    Caption         =   "Batch Dimension Nodes"
-   ClientHeight    =   1995
+   ClientHeight    =   2220
    ClientLeft      =   45
    ClientTop       =   330
-   ClientWidth     =   3930
+   ClientWidth     =   3945
    OleObjectBlob   =   "Woodman.frx":0000
    StartUpPosition =   1  '所有者中心
 End
@@ -35,10 +35,6 @@ Private Const GWL_EXSTYLE = (-20)
 Private Const WS_CAPTION As Long = &HC00000
 Private Const WS_EX_DLGMODALFRAME = &H1&
 
-Private Sub chkOpposite_Click()
-  MiniForm
-End Sub
-
 '// Minimizes the window and retains dimensioning functionality   '// 最小化窗口并保留标注尺寸功能
 Private Function MiniForm()
 
@@ -54,18 +50,19 @@ Private Function MiniForm()
   IStyle = GetWindowLong(hWnd, GWL_EXSTYLE) And Not WS_EX_DLGMODALFRAME
   SetWindowLong hWnd, GWL_EXSTYLE, IStyle
 
-  Dim ctl As Control
+' Dim ctl As Control  '// CorelDRAW 2020 需要注释，才不会错误
   For Each ctl In Woodman.Controls
       ctl.Visible = False
       ctl.Top = 2
   Next ctl
   
-  With Woodman
+  With Me
     .StartUpPosition = 0
+    .BackColor = &H80000012
     .Left = Val(GetSetting("LYVBA", "Settings", "Left", "400")) + 318
     .Top = Val(GetSetting("LYVBA", "Settings", "Top", "55")) - 2
-    .Height = 30
-    .Width = 100
+    .Height = 28
+    .Width = 98
     
     .MarkLines_Makesize.Visible = True
     .btn_Makesizes.Visible = True
@@ -73,15 +70,19 @@ Private Function MiniForm()
     .chkOpposite.Visible = True
     .X_EXIT.Visible = True
     
-    .MarkLines_Makesize.Left = 0
-    .btn_Makesizes.Left = 25
+    .MarkLines_Makesize.Left = 1
+    .btn_Makesizes.Left = 26
     .Manual_Makesize.Left = 50
     .chkOpposite.Left = 75: .chkOpposite.Top = 14
     .X_EXIT.Left = 85: .X_EXIT.Top = 0
   End With
 End Function
 
-Private Sub btn_square_hi_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
+Private Sub btn_MiniForm_Click()
+  MiniForm
+End Sub
+
+Private Sub btn_square_hi_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
     ActiveDocument.BeginCommandGroup:  Application.Optimization = True
     Set os = ActiveSelectionRange
     Set ss = os.Shapes
@@ -95,7 +96,7 @@ Private Sub btn_square_hi_MouseUp(ByVal Button As Integer, ByVal Shift As Intege
 End Sub
 
 
-Private Sub btn_square_wi_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
+Private Sub btn_square_wi_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
     ActiveDocument.BeginCommandGroup:  Application.Optimization = True
     Set os = ActiveSelectionRange
     Set ss = os.Shapes
@@ -108,7 +109,7 @@ Private Sub btn_square_wi_MouseUp(ByVal Button As Integer, ByVal Shift As Intege
     ActiveWindow.Refresh:    Application.Refresh
 End Sub
 
-Private Sub btn_Makesizes_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
+Private Sub btn_Makesizes_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
     Dim os As ShapeRange
     Dim s As Shape
     Dim sr As ShapeRange
@@ -153,40 +154,39 @@ Private Sub btn_Makesizes_MouseUp(ByVal Button As Integer, ByVal Shift As Intege
     Application.Refresh
 End Sub
 
-Private Sub btn_sizes_up_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
+Private Sub btn_sizes_up_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
     make_sizes_sep "up", Shift
 End Sub
-Private Sub btn_sizes_dn_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
+Private Sub btn_sizes_dn_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
     make_sizes_sep "dn", Shift
 End Sub
-Private Sub btn_sizes_lf_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
+Private Sub btn_sizes_lf_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
     make_sizes_sep "lf", Shift
 End Sub
-Private Sub btn_sizes_ri_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
+Private Sub btn_sizes_ri_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
     make_sizes_sep "ri", Shift
 End Sub
 
-Private Sub btn_sizes_btw_up_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
+Private Sub btn_sizes_btw_up_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
     make_sizes_sep "upb", Shift
 End Sub
-Private Sub btn_sizes_btw_dn_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
+Private Sub btn_sizes_btw_dn_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
     make_sizes_sep "dnb", Shift
 End Sub
-Private Sub btn_sizes_btw_lf_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
+Private Sub btn_sizes_btw_lf_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
     make_sizes_sep "lfb", Shift
 End Sub
-Private Sub btn_sizes_btw_ri_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
+Private Sub btn_sizes_btw_ri_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
     make_sizes_sep "rib", Shift
 End Sub
 
 Sub make_sizes_sep(dr, Optional shft = 0, Optional ByVal mirror As Boolean = False)
+  On Error GoTo ErrorHandler
+  API.BeginOpt "Make Size"
     Set doc = ActiveDocument
-    Dim s As Shape
+    Dim s As Shape, sh As Shape
     Dim pts As New SnapPoint, pte As New SnapPoint
     Dim os As ShapeRange
-    un = doc.Unit
-    doc.Unit = cdrMillimeter
-    doc.BeginCommandGroup "make sizes"
     
     Set os = ActiveSelectionRange
     
@@ -209,49 +209,55 @@ Sub make_sizes_sep(dr, Optional shft = 0, Optional ByVal mirror As Boolean = Fal
     If dr = "lfbx" Or dr = "lfb" Or dr = "rib" Or dr = "lf" Or dr = "ri" Then os.Sort "@shape1.top > @shape2.top"
     
     If os.Count > 0 Then
-        If os.Count > 1 And Len(dr) > 2 Then
+        If os.Count > 1 And Len(dr) > 2 And os.Shapes.Count > 1 Then
             For i = 1 To os.Shapes.Count - 1
                 Select Case dr
                     Case "upbx":
                           Set pts = os.Shapes(i).SnapPoints.BBox(border(0))
                           Set pte = os.Shapes(i + 1).SnapPoints.BBox(border(1))
-                          ActiveLayer.CreateLinearDimension cdrDimensionHorizontal, pts, pte, True, 0, border(2), cdrDimensionStyleEngineering
+                          Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pts, pte, True, 0, border(2), cdrDimensionStyleEngineering)
+
                           If shft > 0 And i = 1 Then
+                            Dimension_SetProperty sh, PresetProperty.value
                             Set pts = os.FirstShape.SnapPoints.BBox(border(0))
                             Set pte = os.LastShape.SnapPoints.BBox(border(1))
-                            ActiveLayer.CreateLinearDimension cdrDimensionHorizontal, pts, pte, True, 0, border(3), cdrDimensionStyleEngineering
+                            Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pts, pte, True, 0, border(3), cdrDimensionStyleEngineering)
                           End If
-                          
+
                     Case "lfbx":
                           Set pts = os.Shapes(i).SnapPoints.BBox(border(4))
                           Set pte = os.Shapes(i + 1).SnapPoints.BBox(border(5))
-                          ActiveLayer.CreateLinearDimension cdrDimensionVertical, pts, pte, True, border(6), 0, cdrDimensionStyleEngineering
+                          Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pts, pte, True, border(6), 0, cdrDimensionStyleEngineering)
+  
                           If shft > 0 And i = 1 Then
+                            Dimension_SetProperty sh, PresetProperty.value
                             Set pts = os.FirstShape.SnapPoints.BBox(border(4))
                             Set pte = os.LastShape.SnapPoints.BBox(border(5))
-                           ActiveLayer.CreateLinearDimension cdrDimensionVertical, pts, pte, True, border(7), 0, cdrDimensionStyleEngineering
+                            Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pts, pte, True, border(7), 0, cdrDimensionStyleEngineering)
                           End If
                           
                     Case "upb":
                             Set pts = os.Shapes(i).SnapPoints.BBox(cdrTopRight)
                             Set pte = os.Shapes(i + 1).SnapPoints.BBox(cdrTopLeft)
-                            ActiveLayer.CreateLinearDimension cdrDimensionHorizontal, pts, pte, True, os.LeftX + os.SizeWidth / 10, os.TopY + os.SizeHeight / 10, cdrDimensionStyleEngineering
+                            Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pts, pte, True, os.LeftX + os.SizeWidth / 10, os.TopY + os.SizeHeight / 10, cdrDimensionStyleEngineering)
 
                     Case "dnb":
                             Set pts = os.Shapes(i).SnapPoints.BBox(cdrBottomRight)
                             Set pte = os.Shapes(i + 1).SnapPoints.BBox(cdrBottomLeft)
-                            ActiveLayer.CreateLinearDimension cdrDimensionHorizontal, pts, pte, True, os.LeftX + os.SizeWidth / 10, os.BottomY - os.SizeHeight / 10, cdrDimensionStyleEngineering
+                            Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pts, pte, True, os.LeftX + os.SizeWidth / 10, os.BottomY - os.SizeHeight / 10, cdrDimensionStyleEngineering)
                     
                     Case "lfb":
                             Set pts = os.Shapes(i).SnapPoints.BBox(cdrBottomLeft)
                             Set pte = os.Shapes(i + 1).SnapPoints.BBox(cdrTopLeft)
-                            ActiveLayer.CreateLinearDimension cdrDimensionVertical, pts, pte, True, os.LeftX - os.SizeWidth / 10, os.BottomY + os.SizeHeight / 10, cdrDimensionStyleEngineering
+                            Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pts, pte, True, os.LeftX - os.SizeWidth / 10, os.BottomY + os.SizeHeight / 10, cdrDimensionStyleEngineering)
                     
                     Case "rib":
                             Set pts = os.Shapes(i).SnapPoints.BBox(cdrBottomRight)
                             Set pte = os.Shapes(i + 1).SnapPoints.BBox(cdrTopRight)
-                            ActiveLayer.CreateLinearDimension cdrDimensionVertical, pts, pte, True, os.RightX + os.SizeWidth / 10, os.BottomY + os.SizeHeight / 10, cdrDimensionStyleEngineering
+                            Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pts, pte, True, os.RightX + os.SizeWidth / 10, os.BottomY + os.SizeHeight / 10, cdrDimensionStyleEngineering)
                 End Select
+                '// 尺寸标注设置属性
+                Dimension_SetProperty sh, PresetProperty.value
                 'ActiveDocument.ClearSelection
             Next i
         Else
@@ -260,79 +266,84 @@ Sub make_sizes_sep(dr, Optional shft = 0, Optional ByVal mirror As Boolean = Fal
                     Case "up":
                             Set pts = os.FirstShape.SnapPoints.BBox(cdrTopLeft)
                             Set pte = os.LastShape.SnapPoints.BBox(cdrTopRight)
-                            ActiveLayer.CreateLinearDimension cdrDimensionHorizontal, pts, pte, True, os.LeftX + os.SizeWidth / 10, os.TopY + os.SizeHeight / 10, cdrDimensionStyleEngineering
+                            Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pts, pte, True, os.LeftX + os.SizeWidth / 10, os.TopY + os.SizeHeight / 10, cdrDimensionStyleEngineering)
                     
                     Case "dn":
                             Set pts = os.FirstShape.SnapPoints.BBox(cdrBottomLeft)
                             Set pte = os.LastShape.SnapPoints.BBox(cdrBottomRight)
-                            ActiveLayer.CreateLinearDimension cdrDimensionHorizontal, pts, pte, True, os.LeftX + os.SizeWidth / 10, os.BottomY - os.SizeHeight / 10, cdrDimensionStyleEngineering
+                            Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pts, pte, True, os.LeftX + os.SizeWidth / 10, os.BottomY - os.SizeHeight / 10, cdrDimensionStyleEngineering)
                     Case "lf":
                             Set pts = os.FirstShape.SnapPoints.BBox(cdrTopLeft)
                             Set pte = os.LastShape.SnapPoints.BBox(cdrBottomLeft)
-                            ActiveLayer.CreateLinearDimension cdrDimensionVertical, pts, pte, True, os.LeftX - os.SizeWidth / 10, os.BottomY + os.SizeHeight / 10, cdrDimensionStyleEngineering
+                            Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pts, pte, True, os.LeftX - os.SizeWidth / 10, os.BottomY + os.SizeHeight / 10, cdrDimensionStyleEngineering)
                     Case "ri":
                             Set pts = os.FirstShape.SnapPoints.BBox(cdrTopRight)
                             Set pte = os.LastShape.SnapPoints.BBox(cdrBottomRight)
-                            ActiveLayer.CreateLinearDimension cdrDimensionVertical, pts, pte, True, os.RightX + os.SizeWidth / 10, os.BottomY + os.SizeHeight / 10, cdrDimensionStyleEngineering
+                            Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pts, pte, True, os.RightX + os.SizeWidth / 10, os.BottomY + os.SizeHeight / 10, cdrDimensionStyleEngineering)
                 End Select
+                Dimension_SetProperty sh, PresetProperty.value
             Else
                 For Each s In os.Shapes
                     Select Case dr
                         Case "up":
                                 Set pts = s.SnapPoints.BBox(cdrTopLeft)
                                 Set pte = s.SnapPoints.BBox(cdrTopRight)
-                                ActiveLayer.CreateLinearDimension cdrDimensionHorizontal, pts, pte, True, s.LeftX + s.SizeWidth / 10, s.TopY + s.SizeHeight / 10, cdrDimensionStyleEngineering
+                                Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pts, pte, True, s.LeftX + s.SizeWidth / 10, s.TopY + s.SizeHeight / 10, cdrDimensionStyleEngineering)
                         
                         Case "dn":
                                 Set pts = s.SnapPoints.BBox(cdrBottomLeft)
                                 Set pte = s.SnapPoints.BBox(cdrBottomRight)
-                                ActiveLayer.CreateLinearDimension cdrDimensionHorizontal, pts, pte, True, s.LeftX + s.SizeWidth / 10, s.BottomY - s.SizeHeight / 10, cdrDimensionStyleEngineering
+                                Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pts, pte, True, s.LeftX + s.SizeWidth / 10, s.BottomY - s.SizeHeight / 10, cdrDimensionStyleEngineering)
                         Case "lf":
                                 Set pts = s.SnapPoints.BBox(cdrTopLeft)
                                 Set pte = s.SnapPoints.BBox(cdrBottomLeft)
-                                ActiveLayer.CreateLinearDimension cdrDimensionVertical, pts, pte, True, s.LeftX - s.SizeWidth / 10, s.BottomY + s.SizeHeight / 10, cdrDimensionStyleEngineering
+                                Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pts, pte, True, s.LeftX - s.SizeWidth / 10, s.BottomY + s.SizeHeight / 10, cdrDimensionStyleEngineering)
                         Case "ri":
                                 Set pts = s.SnapPoints.BBox(cdrTopRight)
                                 Set pte = s.SnapPoints.BBox(cdrBottomRight)
-                                ActiveLayer.CreateLinearDimension cdrDimensionVertical, pts, pte, True, s.RightX + s.SizeWidth / 10, s.BottomY + s.SizeHeight / 10, cdrDimensionStyleEngineering
+                                Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pts, pte, True, s.RightX + s.SizeWidth / 10, s.BottomY + s.SizeHeight / 10, cdrDimensionStyleEngineering)
                     End Select
+                    Dimension_SetProperty sh, PresetProperty.value
                 Next s
             End If
         End If
     End If
     os.CreateSelection
-    doc.EndCommandGroup
-    doc.Unit = un
+    
+ErrorHandler:
+  API.EndOpt
 End Sub
 
 Sub make_sizes(Optional shft = 0)
-    Set doc = ActiveDocument
-    Dim s As Shape
-    Dim pts As SnapPoint, pte As SnapPoint
-    Dim os As ShapeRange
-    un = doc.Unit
-    doc.Unit = cdrMillimeter
-    doc.BeginCommandGroup "make sizes"
-    Set os = ActiveSelectionRange
-    If os.Count > 0 Then
-    For Each s In os.Shapes
-        Set pts = s.SnapPoints.BBox(cdrTopLeft)
-        Set pte = s.SnapPoints.BBox(cdrTopRight)
-        Set ptle = s.SnapPoints.BBox(cdrBottomLeft)
-        If shft <> 6 Then ActiveLayer.CreateLinearDimension cdrDimensionVertical, pts, ptle, True, s.LeftX - s.SizeWidth / 10, s.BottomY + s.SizeHeight / 10, cdrDimensionStyleEngineering
-        If shft <> 3 Then ActiveLayer.CreateLinearDimension cdrDimensionHorizontal, pts, pte, True, s.LeftX + s.SizeWidth / 10, s.TopY + s.SizeHeight / 10, cdrDimensionStyleEngineering
-    Next s
-    End If
-    doc.EndCommandGroup
-    doc.Unit = un
+  On Error GoTo ErrorHandler
+  API.BeginOpt
+  
+  Dim s As Shape
+  Dim pts As SnapPoint, pte As SnapPoint
+  Dim os As ShapeRange
+  Set os = ActiveSelectionRange
+  If os.Count > 0 Then
+  For Each s In os.Shapes
+      Set pts = s.SnapPoints.BBox(cdrTopLeft)
+      Set pte = s.SnapPoints.BBox(cdrTopRight)
+      Set ptle = s.SnapPoints.BBox(cdrBottomLeft)
+      If shft <> 6 Then Dimension_SetProperty ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pts, ptle, True, _
+                                              s.LeftX - s.SizeWidth / 10, s.BottomY + s.SizeHeight / 10, cdrDimensionStyleEngineering), PresetProperty.value
+      If shft <> 3 Then Dimension_SetProperty ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pts, pte, True, _
+                                              s.LeftX + s.SizeWidth / 10, s.TopY + s.SizeHeight / 10, cdrDimensionStyleEngineering), PresetProperty.value
+  Next s
+  End If
+
+ErrorHandler:
+  API.EndOpt
 End Sub
 
-Private Sub btn_join_nodes_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
+Private Sub btn_join_nodes_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
     ActiveSelection.CustomCommand "ConvertTo", "JoinCurves"
     Application.Refresh
 End Sub
 
-Private Sub btn_nodes_reduce_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
+Private Sub btn_nodes_reduce_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
     On Error GoTo ErrorHandler
     Set doc = ActiveDocument
     Dim s As Shape
@@ -355,7 +366,7 @@ ErrorHandler:
 End Sub
 
 '// 使用标记线批量建立尺寸标注:   左键上标注，右键右标注
-Private Sub MarkLines_Makesize_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
+Private Sub MarkLines_Makesize_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
   Dim sr As ShapeRange
   Set sr = ActiveSelectionRange
   
@@ -384,7 +395,7 @@ Private Sub MarkLines_Makesize_MouseUp(ByVal Button As Integer, ByVal Shift As I
 End Sub
 
 '// 使用手工选节点建立尺寸标注，使用Ctrl分离尺寸标注
-Private Sub Manual_Makesize_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
+Private Sub Manual_Makesize_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
   If Button = 2 Then
       '// 右键
   ElseIf Shift = fmCtrlMask Then
@@ -417,7 +428,7 @@ Private Function Slanted_Makesize()
   On Error GoTo ErrorHandler
   API.BeginOpt
   Dim nr As NodeRange, cnt As Integer
-  Dim sr As ShapeRange
+  Dim sr As ShapeRange, sh As Shape
   Dim x1 As Double, y1 As Double
   Dim x2 As Double, y2 As Double
   
@@ -439,7 +450,9 @@ Private Function Slanted_Makesize()
     
     Set pts = CreateSnapPoint(x1, y1)
     Set pte = CreateSnapPoint(x2, y2)
-    ActiveLayer.CreateLinearDimension cdrDimensionSlanted, pts, pte, True, x1 - 20, y1 + 20, cdrDimensionStyleEngineering
+    Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionSlanted, pts, pte, True, x1 - 20, y1 + 20, cdrDimensionStyleEngineering)
+    
+    Dimension_SetProperty sh, PresetProperty.value
     cnt = cnt - 1
   Wend
 
@@ -449,6 +462,7 @@ End Function
 
 '// 排序标注倾斜尺寸
 Private Function Slanted_Sort_Make(shs As ShapeRange)
+  On Error GoTo ErrorHandler
   Dim sr As New ShapeRange
   Dim s As Shape, sh As Shape
   Dim nr As NodeRange
@@ -472,13 +486,30 @@ Private Function Slanted_Sort_Make(shs As ShapeRange)
     
     Set pts = CreateSnapPoint(x1, y1)
     Set pte = CreateSnapPoint(x2, y2)
-    ActiveLayer.CreateLinearDimension cdrDimensionSlanted, pts, pte, True, x1 - 20, y1 + 20, cdrDimensionStyleEngineering
+    Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionSlanted, pts, pte, True, x1 - 20, y1 + 20, cdrDimensionStyleEngineering)
+    
+    Dimension_SetProperty sh, PresetProperty.value
   Next i
   sr.Delete
-  
+
+ErrorHandler:
   API.EndOpt
 End Function
 
+'// 尺寸标注设置属性
+Private Function Dimension_SetProperty(sh_dim As Shape, Optional ByVal Preset As Boolean = False)
+  If Preset And sh_dim.Type = cdrLinearDimensionShape Then
+    With sh_dim.Style.GetProperty("dimension")
+      .SetProperty "precision", 0 '       小数位数
+      .SetProperty "showUnits", 0 '       是否显示单位 0/1
+      .SetProperty "textPlacement", 0 '   0、上方，1、下方，2、中间
+    '  .SetProperty "dynamicText", 0 '    是否可以编辑尺寸0/1
+    '  .SetProperty "overhang", 500000 '
+    End With
+  End If
+End Function
+
+
 Private Sub X_EXIT_Click()
   Unload Me    '// EXIT
 End Sub