This is free and unencumbered software released into the public domain.

module/API.bas

@@ -1,4 +1,32 @@
 Attribute VB_Name = "API"
+'// This is free and unencumbered software released into the public domain.
+'// For more information, please refer to  https://github.com/hongwenjun
+
+'// Attribute VB_Name = "CorelVBA工具窗口启动"   CorelVBA Tool Window Launches  2023.6.11
+Public Sub Start()
+  Toolbar.Show 0
+End Sub
+
+'// CorelDRAW 窗口刷新优化和关闭
+Public Function BeginOpt(Optional ByVal Name As String = "Undo")
+  EventsEnabled = False
+  ActiveDocument.BeginCommandGroup Name
+  ActiveDocument.SaveSettings
+  ActiveDocument.Unit = cdrMillimeter
+  Optimization = True
+' ActiveDocument.PreserveSelection = False
+End Function
+
+Public Function EndOpt()
+' ActiveDocument.PreserveSelection = True
+  ActiveDocument.RestoreSettings
+  EventsEnabled = True
+  Optimization = False
+  EventsEnabled = True
+  Application.Refresh
+  ActiveDocument.EndCommandGroup
+End Function
+
 Public Function Speak_Msg(message As String)
   Speak_Help = Val(GetSetting("262235.xyz", "Settings", "SpeakHelp", "1"))
   
@@ -89,13 +117,13 @@ End Function
 
 '// 对数组进行排序[单维]
 Public Function ArraySort(src As Variant) As Variant
-  Dim out As Long, I As Long, tmp As Variant
+  Dim out As Long, i As Long, tmp As Variant
   For out = LBound(src) To UBound(src) - 1
-    For I = out + 1 To UBound(src)
-      If src(out) > src(I) Then
-        tmp = src(I): src(I) = src(out): src(out) = tmp
+    For i = out + 1 To UBound(src)
+      If src(out) > src(i) Then
+        tmp = src(i): src(i) = src(out): src(out) = tmp
       End If
-    Next I
+    Next i
   Next out
   
   ArraySort = src
@@ -103,27 +131,27 @@ End Function
 
 '//  把一个数组倒序
 Public Function ArrayReverse(arr)
-    Dim I As Integer, n As Integer
+    Dim i As Integer, n As Integer
     n = UBound(arr)
     Dim p(): ReDim p(n)
-    For I = 0 To n
-        p(I) = arr(n - I)
+    For i = 0 To n
+        p(i) = arr(n - i)
     Next
     ArrayReverse = p
 End Function
 
 '// 测试数组排序
 Private Function test_ArraySort()
-  Dim arr As Variant, I As Integer
+  Dim arr As Variant, i As Integer
   arr = Array(5, 4, 3, 2, 1, 9, 999, 33)
-  For I = 0 To arrlen(arr) - 1
-    Debug.Print arr(I);
-  Next I
+  For i = 0 To arrlen(arr) - 1
+    Debug.Print arr(i);
+  Next i
   Debug.Print arrlen(arr)
   ArraySort arr
-  For I = 0 To arrlen(arr) - 1
-    Debug.Print arr(I);
-  Next I
+  For i = 0 To arrlen(arr) - 1
+    Debug.Print arr(i);
+  Next i
 End Function
 
 '// 两点连线的角度：返回角度(相对于X轴的角度)
@@ -154,21 +182,21 @@ Public Function alfaPP(p, o)
 End Function
 
 '// 求过P点到线段AB上的垂足点(XY平面内的二维计算)
-Public Function pFootInXY(p, a, B)
-    If a(0) = B(0) Then
+Public Function pFootInXY(p, a, b)
+    If a(0) = b(0) Then
         pFootInXY = Array(a(0), p(1), 0#): Exit Function
     End If
-    If a(1) = B(1) Then
+    If a(1) = b(1) Then
         pFootInXY = Array(p(0), a(1), 0#): Exit Function
     End If
-    Dim aa, bb, c, d, x, Y
-    aa = (a(1) - B(1)) / (a(0) - B(0))
+    Dim aa, bb, c, d, X, Y
+    aa = (a(1) - b(1)) / (a(0) - b(0))
     bb = a(1) - aa * a(0)
-    c = -(a(0) - B(0)) / (a(1) - B(1))
+    c = -(a(0) - b(0)) / (a(1) - b(1))
     d = p(1) - c * p(0)
-    x = (d - bb) / (aa - c)
-    Y = aa * x + bb
-    pFootInXY = Array(x, Y, 0#)
+    X = (d - bb) / (aa - c)
+    Y = aa * X + bb
+    pFootInXY = Array(X, Y, 0#)
 End Function
 
 
@@ -216,3 +244,4 @@ Function test()
   Set sapi = CreateObject("sapi.spvoice")
   sapi.Speak message
 End Function
+

module/Arrange.bas

@@ -1,6 +1,11 @@
-Attribute VB_Name = "拼版裁切线"
+Attribute VB_Name = "Arrange"
+'// This is free and unencumbered software released into the public domain.
+'// For more information, please refer to  https://github.com/hongwenjun
+
+'// Attribute VB_Name = "拼版裁切线"   Arrange  2023.6.11
+
 Type Coordinate
-  x As Double
+  X As Double
   Y As Double
 End Type
 
@@ -42,17 +47,17 @@ Sub Cut_lines()
       < radius Or Abs(set_ty - ty) < radius Then
       
       arr = Array(lx, By, rx, By, lx, ty, rx, ty)  '// 物件左下-右下-左上-右上 四个顶点坐标数组
-      For I = 0 To 3
-        dot.x = arr(2 * I)
-        dot.Y = arr(2 * I + 1)
+      For i = 0 To 3
+        dot.X = arr(2 * i)
+        dot.Y = arr(2 * i + 1)
         
         '// 范围边界坐标点判断
-        If Abs(set_lx - dot.x) < radius Or Abs(set_rx - dot.x) < radius _
+        If Abs(set_lx - dot.X) < radius Or Abs(set_rx - dot.X) < radius _
               Or Abs(set_by - dot.Y) < radius Or Abs(set_ty - dot.Y) < radius Then
 
             draw_line dot, border  '// 以坐标点和范围边界画裁切线
         End If
-      Next I
+      Next i
     End If
   Next Target
   
@@ -60,7 +65,7 @@ Sub Cut_lines()
   
   '// 使用CQL 颜色标志查找，然后群组统一设置线宽和注册色
   ActivePage.Shapes.FindShapes(Query:="@colors.find(RGB(26, 22, 35))").CreateSelection
-  ActiveSelection.Group
+  ActiveSelection.group
   ActiveSelection.Outline.SetProperties Outline_Width, Color:=CreateRegistrationColor
   
   ActiveDocument.EndCommandGroup
@@ -76,17 +81,17 @@ Private Function draw_line(dot As Coordinate, border As Variant)
   Dim line As Shape
 
   If Abs(dot.Y - border(3)) < radius Then
-    Set line = ActiveLayer.CreateLineSegment(dot.x, border(3) + Bleed, dot.x, border(3) + (Line_len + Bleed))
+    Set line = ActiveLayer.CreateLineSegment(dot.X, border(3) + Bleed, dot.X, border(3) + (Line_len + Bleed))
     set_line_color line
   ElseIf Abs(dot.Y - border(2)) < radius Then
-    Set line = ActiveLayer.CreateLineSegment(dot.x, border(2) - Bleed, dot.x, border(2) - (Line_len + Bleed))
+    Set line = ActiveLayer.CreateLineSegment(dot.X, border(2) - Bleed, dot.X, border(2) - (Line_len + Bleed))
     set_line_color line
   End If
   
-  If Abs(dot.x - border(1)) < radius Then
+  If Abs(dot.X - border(1)) < radius Then
     Set line = ActiveLayer.CreateLineSegment(border(1) + Bleed, dot.Y, border(1) + (Line_len + Bleed), dot.Y)
     set_line_color line
-  ElseIf Abs(dot.x - border(0)) < radius Then
+  ElseIf Abs(dot.X - border(0)) < radius Then
     Set line = ActiveLayer.CreateLineSegment(border(0) - Bleed, dot.Y, border(0) - (Line_len + Bleed), dot.Y)
     set_line_color line
   End If
@@ -99,18 +104,18 @@ Private Function draw_line_按点基准(dot As Coordinate, border As Variant)
   Dim line As Shape
 
   If Abs(dot.Y - border(3)) < radius Then
-    Set line = ActiveLayer.CreateLineSegment(dot.x, dot.Y + Bleed, dot.x, dot.Y + (Line_len + Bleed))
+    Set line = ActiveLayer.CreateLineSegment(dot.X, dot.Y + Bleed, dot.X, dot.Y + (Line_len + Bleed))
     set_line_color line
   ElseIf Abs(dot.Y - border(2)) < radius Then
-    Set line = ActiveLayer.CreateLineSegment(dot.x, dot.Y - Bleed, dot.x, dot.Y - (Line_len + Bleed))
+    Set line = ActiveLayer.CreateLineSegment(dot.X, dot.Y - Bleed, dot.X, dot.Y - (Line_len + Bleed))
     set_line_color line
   End If
   
-  If Abs(dot.x - border(1)) < radius Then
-    Set line = ActiveLayer.CreateLineSegment(dot.x + Bleed, dot.Y, dot.x + (Line_len + Bleed), dot.Y)
+  If Abs(dot.X - border(1)) < radius Then
+    Set line = ActiveLayer.CreateLineSegment(dot.X + Bleed, dot.Y, dot.X + (Line_len + Bleed), dot.Y)
     set_line_color line
-  ElseIf Abs(dot.x - border(0)) < radius Then
-    Set line = ActiveLayer.CreateLineSegment(dot.x - Bleed, dot.Y, dot.x - (Line_len + Bleed), dot.Y)
+  ElseIf Abs(dot.X - border(0)) < radius Then
+    Set line = ActiveLayer.CreateLineSegment(dot.X - Bleed, dot.Y, dot.X - (Line_len + Bleed), dot.Y)
     set_line_color line
   End If
 
@@ -122,7 +127,7 @@ Private Function set_line_color(line As Shape)
 End Function
 
 '// CorelDRAW 物件排列拼版简单代码
-Sub arrange()
+Sub Arrange()
   On Error GoTo ErrorHandler
   ActiveDocument.Unit = cdrMillimeter
   row = 3     ' 拼版 3 x 4
@@ -133,25 +138,25 @@ Sub arrange()
   Str = API.GetClipBoardString
 
   ' 替换 mm x * 换行 TAB 为空格
-  Str = VBA.replace(Str, "mm", " ")
-  Str = VBA.replace(Str, "x", " ")
-  Str = VBA.replace(Str, "X", " ")
-  Str = VBA.replace(Str, "*", " ")
-  Str = VBA.replace(Str, Chr(13), " ")
-  Str = VBA.replace(Str, Chr(9), " ")
+  Str = VBA.Replace(Str, "mm", " ")
+  Str = VBA.Replace(Str, "x", " ")
+  Str = VBA.Replace(Str, "X", " ")
+  Str = VBA.Replace(Str, "*", " ")
+  Str = VBA.Replace(Str, Chr(13), " ")
+  Str = VBA.Replace(Str, Chr(9), " ")
   
   Do While InStr(Str, "  ")    '多个空格换成一个空格
-      Str = VBA.replace(Str, "  ", " ")
+      Str = VBA.Replace(Str, "  ", " ")
   Loop
   
   arr = Split(Str)
 
   Dim s1 As Shape
-  Dim x As Double, Y As Double
+  Dim X As Double, Y As Double
   
   If 0 = ActiveSelectionRange.Count Then
-    x = Val(arr(0)):    Y = Val(arr(1))
-    row = Int(ActiveDocument.Pages.First.SizeWidth / x)
+    X = Val(arr(0)):    Y = Val(arr(1))
+    row = Int(ActiveDocument.Pages.First.SizeWidth / X)
     List = Int(ActiveDocument.Pages.First.SizeHeight / Y)
 
     If UBound(arr) > 2 Then
@@ -164,7 +169,7 @@ Sub arrange()
     End If
      
     '// 建立矩形 Width  x Height 单位 mm
-    Set s1 = ActiveLayer.CreateRectangle(0, 0, x, Y)
+    Set s1 = ActiveLayer.CreateRectangle(0, 0, X, Y)
     
     '// 填充颜色无，轮廓颜色 K100，线条粗细0.3mm
     s1.Fill.ApplyNoFill
@@ -174,12 +179,12 @@ Sub arrange()
   '// 如果当前选择物件，按当前物件拼版
   ElseIf 1 = ActiveSelectionRange.Count Then
     Set s1 = ActiveSelection
-    x = s1.SizeWidth:    Y = s1.SizeHeight
-    row = Int(ActiveDocument.Pages.First.SizeWidth / x)
+    X = s1.SizeWidth:    Y = s1.SizeHeight
+    row = Int(ActiveDocument.Pages.First.SizeWidth / X)
     List = Int(ActiveDocument.Pages.First.SizeHeight / Y)
   End If
   
-  sw = x:  sh = Y
+  sw = X:  sh = Y
 
   '// StepAndRepeat 方法在范围内创建多个形状副本
   Dim dup1 As ShapeRange

module/AutoColorMark.bas

@@ -1,5 +1,9 @@
-Attribute VB_Name = "自动中线色阶条"
-' Attribute VB_Name = "自动中线色阶条"
+Attribute VB_Name = "AutoColorMark"
+'// This is free and unencumbered software released into the public domain.
+'// For more information, please refer to  https://github.com/hongwenjun
+
+'// Attribute VB_Name = "自动中线色阶条"   AutoColorMark  2023.6.11
+
 '// 请先选择要印刷的物件群组，本插件完成设置页面大小，自动中线色阶条对准线功能
 Sub Auto_ColorMark()
   If 0 = ActiveSelectionRange.Count Then Exit Sub
@@ -62,7 +66,7 @@ Sub Auto_ColorMark()
   
   '// 使用CQL 颜色标志查找，然后群组统一设置线宽和注册色
   ActivePage.Shapes.FindShapes(Query:="@colors.find(RGB(26, 22, 35))").CreateSelection
-  ActiveSelection.Group
+  ActiveSelection.group
   ActiveSelection.Outline.SetProperties 0.1, Color:=CreateRegistrationColor
 
   '// 代码操作结束恢复窗口刷新
@@ -81,7 +85,7 @@ Private Sub set_page_size()
   ActiveDocument.Unit = cdrMillimeter
   Dim OrigSelection As ShapeRange, sh As Shape
   Set OrigSelection = ActiveSelectionRange
-  Set sh = OrigSelection.Group
+  Set sh = OrigSelection.group
   
   ' MsgBox "选择物件尺寸: " & sh.SizeWidth & "x" & sh.SizeHeight
   ActivePage.SetSize Int(sh.SizeWidth + 0.9), Int(sh.SizeHeight + 0.9)
@@ -303,7 +307,7 @@ Sub Auto_ColorMark_K()
   
   '// 使用CQL 颜色标志查找，然后群组统一设置线宽和注册色
   ActivePage.Shapes.FindShapes(Query:="@colors.find(RGB(26, 22, 35))").CreateSelection
-  ActiveSelection.Group
+  ActiveSelection.group
   ActiveSelection.Outline.SetProperties 0.1, Color:=CreateRegistrationColor
 
   '// 代码操作结束恢复窗口刷新

module/CQLFindSame.bas

@@ -1,11 +1,11 @@
-Attribute VB_Name = "CQL查找相同"
+Attribute VB_Name = "CQLFindSame"
 Sub 属性选择()
   CQL_FIND_UI.Show 0
 End Sub
 
 Public Function CQLline_CM100()
   On Error GoTo err
-  Dim cm(5) As Color, I As Long
+  Dim cm(5) As Color, i As Long
   Set cm(0) = CreateCMYKColor(100, 0, 100, 0)  '绿
   Set cm(1) = CreateCMYKColor(0, 100, 0, 0)  '洋红
   Set cm(2) = CreateCMYKColor(100, 100, 0, 0) '红
@@ -13,15 +13,87 @@ Public Function CQLline_CM100()
   Set cm(4) = CreateRGBColor(255, 0, 0) ' RGB 红
 
   ActiveDocument.ClearSelection
-  For I = 0 To 4
-    cm(I).ConvertToRGB
-    r = cm(I).RGBRed
-    G = cm(I).RGBGreen
-    B = cm(I).RGBBlue
-    ActivePage.Shapes.FindShapes(Query:="@Outline.Color.rgb[.r='" & r & "' And .g='" & G & "' And .b='" & B & "']").AddToSelection
-  Next I
+  For i = 0 To 4
+    cm(i).ConvertToRGB
+    r = cm(i).RGBRed
+    G = cm(i).RGBGreen
+    b = cm(i).RGBBlue
+    ActivePage.Shapes.FindShapes(Query:="@Outline.Color.rgb[.r='" & r & "' And .g='" & G & "' And .b='" & b & "']").AddToSelection
+  Next i
 
 Exit Function
 err:
   MsgBox "Function CQLline_CM100 错误!"
 End Function
+
+
+Sub 一键加点工具()
+  Dim OrigSelection As ShapeRange
+  Set OrigSelection = ActiveSelectionRange
+  If OrigSelection.Count <> 0 Then
+    OrigSelection.Copy
+  Else
+    MsgBox "选择水洗标要加点部分，然后点击【加点工具】按钮!"
+    Exit Sub
+  End If
+  
+  ' 新建文件粘贴
+  Dim doc1 As Document
+  Set doc1 = CreateDocument
+  ActiveLayer.Paste
+  
+  ' 转曲线，一键加粗小红点
+  ActiveSelection.ConvertToCurves
+  Call get_little_points
+End Sub
+
+
+Private Sub get_little_points()
+  On Error GoTo ErrorHandler
+  '// 代码运行时关闭窗口刷新
+  Application.Optimization = True
+  ActiveDocument.BeginCommandGroup  '一步撤消'
+  
+  red_point_Size = 0.3
+  ActiveDocument.Unit = cdrMillimeter
+  Dim OrigSelection As ShapeRange, grp1 As ShapeRange, sh As Shape
+  Set OrigSelection = ActiveSelectionRange
+  Set grp1 = OrigSelection.UngroupAllEx
+  grp1.ApplyUniformFill CreateCMYKColor(50, 0, 0, 0)
+  
+  For Each sh In grp1
+    sh.BreakApartEx
+  Next sh
+  
+  ActiveDocument.ClearSelection
+  Dim sr As ShapeRange
+  Set sr = ActivePage.Shapes.FindShapes(Query:="@width < {" & red_point_Size & " mm} and @width > {0.1 mm} and @height <{" & red_point_Size & " mm} and @height >{0.1 mm}")
+  If sr.Count <> 0 Then
+    sr.CreateSelection
+    Set sh = ActiveSelection.group
+    sh.Outline.SetProperties 0.03, Color:=CreateCMYKColor(0, 100, 100, 0)
+    sr.ApplyUniformFill CreateCMYKColor(0, 100, 100, 0)
+    sh.Move 0, 0.015
+    sh.Copy
+  Else
+    MsgBox "文件中小圆点足够大，不需要加粗!"
+  End If
+
+  ActivePage.Shapes.FindShapes(Query:="@colors.find(CMYK(50, 0, 0, 0))").CreateSelection
+  ActiveSelection.group
+  
+  ActiveDocument.EndCommandGroup
+  Application.Optimization = False
+  ActiveWindow.Refresh
+  Application.Refresh
+  Exit Sub
+ErrorHandler:
+  MsgBox "选择水洗标要加点部分，然后点击【加点工具】按钮!"
+  Application.Optimization = False
+  On Error Resume Next
+End Sub
+
+Sub 文字转曲()
+  Tools.TextShape_ConvertToCurves
+End Sub
+

module/ClipbRectangle.bas

@@ -1,18 +1,22 @@
-Attribute VB_Name = "剪贴板尺寸建立矩形"
-'// Attribute VB_Name = "剪贴板尺寸建立矩形"
+Attribute VB_Name = "ClipbRectangle"
+'// This is free and unencumbered software released into the public domain.
+'// For more information, please refer to  https://github.com/hongwenjun
+
+'// Attribute VB_Name = "剪贴板尺寸建立矩形"  Clipboard Size Build Rectangle  2023.6.11
+
 Type Coordinate
-    x As Double
+    X As Double
     Y As Double
 End Type
 Public O_O As Coordinate
 
-Sub start()
+Sub Start()
     '// 坐标原点
-    O_O.x = 0:   O_O.Y = 0
+    O_O.X = 0:   O_O.Y = 0
     Dim ost As ShapeRange
     Set ost = ActiveSelectionRange
 
-    O_O.x = ost.LeftX
+    O_O.X = ost.LeftX
     O_O.Y = ost.BottomY - 50    '选择物件 下移动 50mm
 
     '// 建立矩形 Width  x Height 单位 mm
@@ -20,28 +24,28 @@ Sub start()
     Str = API.GetClipBoardString
 
     ' 替换 mm x * 换行 TAB 为空格
-    Str = VBA.replace(Str, "m", " ")
-    Str = VBA.replace(Str, "x", " ")
-    Str = VBA.replace(Str, "X", " ")
-    Str = VBA.replace(Str, "*", " ")
-    Str = VBA.replace(Str, vbNewLine, " ")
+    Str = VBA.Replace(Str, "m", " ")
+    Str = VBA.Replace(Str, "x", " ")
+    Str = VBA.Replace(Str, "X", " ")
+    Str = VBA.Replace(Str, "*", " ")
+    Str = VBA.Replace(Str, vbNewLine, " ")
 
     Do While InStr(Str, "  ") '多个空格换成一个空格
-        Str = VBA.replace(Str, "  ", " ")
+        Str = VBA.Replace(Str, "  ", " ")
     Loop
     arr = Split(Str)
     
     ActiveDocument.BeginCommandGroup  '一步撤消'
-    Dim x As Double
+    Dim X As Double
     Dim Y As Double
     For n = LBound(arr) To UBound(arr) - 1 Step 2
         ' MsgBox arr(n)
-        x = Val(arr(n))
+        X = Val(arr(n))
         Y = Val(arr(n + 1))
         
-        If x > 0 And Y > 0 Then
-            Rectangle x, Y
-            O_O.x = O_O.x + x + 30
+        If X > 0 And Y > 0 Then
+            Rectangle X, Y
+            O_O.X = O_O.X + X + 30
         End If
     Next
     ActiveDocument.EndCommandGroup
@@ -55,7 +59,7 @@ Private Function Rectangle(Width As Double, Height As Double)
   Dim s1 As Shape
 
   '// 建立矩形 Width  x Height 单位 mm
-  Set s1 = ActiveLayer.CreateRectangle(O_O.x, O_O.Y, O_O.x + Width, O_O.Y - Height)
+  Set s1 = ActiveLayer.CreateRectangle(O_O.X, O_O.Y, O_O.X + Width, O_O.Y - Height)
   
   '// 填充颜色无，轮廓颜色 K100，线条粗细0.3mm
   s1.Fill.ApplyNoFill
@@ -66,7 +70,7 @@ Private Function Rectangle(Width As Double, Height As Double)
 
   text = Trim(Str(sw)) + "x" + Trim(Str(sh)) + "mm"
   Set d = ActiveDocument
-  Set size = d.ActiveLayer.CreateArtisticText(O_O.x + sw / 2 - 25, O_O.Y + 10, text, Font:="Tahoma")  '// O_O.y + 10  标注尺寸上移 10mm
+  Set size = d.ActiveLayer.CreateArtisticText(O_O.X + sw / 2 - 25, O_O.Y + 10, text, Font:="Tahoma")  '// O_O.y + 10  标注尺寸上移 10mm
   size.Fill.UniformColor.CMYKAssign 0, 100, 100, 0
 End Function
 
@@ -92,16 +96,16 @@ End Function
 Sub get_all_size()
   ActiveDocument.Unit = cdrMillimeter
   Set fs = CreateObject("Scripting.FileSystemObject")
-  Set F = fs.CreateTextFile("R:\size.txt", True)
+  Set f = fs.CreateTextFile("R:\size.txt", True)
   Dim sh As Shape, shs As Shapes
   Set shs = ActiveSelection.Shapes
   Dim s As String
   For Each sh In shs
     size = Trim(Str(Int(sh.SizeWidth + 0.5))) + "x" + Trim(Str(Int(sh.SizeHeight + 0.5))) + "mm"
-    F.WriteLine (size)
+    f.WriteLine (size)
     s = s + size + vbNewLine
   Next sh
-  F.Close
+  f.Close
   MsgBox "输出物件尺寸信息到文件" & "R:\size.txt" & vbNewLine & s
   API.WriteClipBoard s
 End Sub

module/CutLines.bas

@@ -1,25 +1,22 @@
-Attribute VB_Name = "裁切线"
-' Attribute VB_Name = "裁切线"
-Sub start()
-If 0 = ActiveSelectionRange.Count Then Exit Sub
-  '// 代码运行时关闭窗口刷新
-  Application.Optimization = True
-  ActiveDocument.BeginCommandGroup  '一步撤消'
+Attribute VB_Name = "CutLines"
+'// This is free and unencumbered software released into the public domain.
+'// For more information, please refer to  https://github.com/hongwenjun
 
-   '// 设置当前文档 尺寸单位mm 出血和线长和线宽
-  ActiveDocument.Unit = cdrMillimeter
+'// Attribute VB_Name = "裁切线"   CutLines  2023.6.9
+
+'// 选中多个物件批量制作四角裁切线
+Public Function Batch_CutLines()
+  If 0 = ActiveSelectionRange.Count Then Exit Function
+  API.BeginOpt
   Bleed = API.GetSet("Bleed")
   Line_len = API.GetSet("Line_len")
   Outline_Width = API.GetSet("Outline_Width")
 
-  Dim OrigSelection As ShapeRange
-  Set OrigSelection = ActiveSelectionRange
-  
   '// 定义当前选择物件 分别获得 左右下上中心坐标(x,y)和尺寸信息
-  Dim s1 As Shape
+  Dim s1 As Shape, OrigSelection As ShapeRange, sr As New ShapeRange
+  Set OrigSelection = ActiveSelectionRange
 
-  For Each Target In OrigSelection
-    Set s1 = Target
+  For Each s1 In OrigSelection
     lx = s1.LeftX:      rx = s1.RightX
     By = s1.BottomY:    ty = s1.TopY
     cx = s1.CenterX:    cy = s1.CenterY
@@ -41,24 +38,119 @@ If 0 = ActiveSelectionRange.Count Then Exit Sub
 
     '// 选中裁切线 群组 设置线宽和注册色
     ActiveDocument.AddToSelection s2, s3, s4, s5, s6, s7, s8, s9
-    ActiveSelection.Group
-    ActiveSelection.Outline.SetProperties Outline_Width
-    ActiveSelection.Outline.SetProperties Color:=CreateRegistrationColor
-  
-  Next Target
+    ActiveSelection.group
+    sr.Add ActiveSelection
+  Next s1
 
-  ActiveDocument.EndCommandGroup
-  '// 代码操作结束恢复窗口刷新
-  Application.Optimization = False
-  ActiveWindow.Refresh
-  Application.Refresh
+  '// 设置线宽和颜色，再选择
+   sr.SetOutlineProperties Outline_Width
+   sr.SetOutlineProperties Color:=CreateRegistrationColor
+   sr.AddToSelection
+   
+  API.EndOpt
+End Function
+
+
+Sub test_MarkLines()
+ ' Dimension_MarkLines cdrAlignLeft
+  Dimension_MarkLines cdrAlignTop
 End Sub
 
+'// 标注尺寸标记线
+Public Function Dimension_MarkLines(Optional ByVal mark As cdrAlignType = cdrAlignTop)
+  If 0 = ActiveSelectionRange.Count Then Exit Function
+  API.BeginOpt
+  Bleed = API.GetSet("Bleed")
+  Line_len = API.GetSet("Line_len")
+  Outline_Width = API.GetSet("Outline_Width")
+
+  '// 定义当前选择物件 分别获得 左右下上中心坐标(x,y)和尺寸信息
+  Dim s As Shape, s1 As Shape, OrigSelection As ShapeRange, sr As New ShapeRange
+  Set OrigSelection = ActiveSelectionRange
+
+  For Each s1 In OrigSelection
+    lx = s1.LeftX:      rx = s1.RightX
+    By = s1.BottomY:    ty = s1.TopY
+    
+    '//  添加使用 左-上 标注尺寸标记线
+    Dim s2, s6, s7, s8, s9 As Shape
+    
+    If mark = cdrAlignTop Then
+      Set s7 = ActiveLayer.CreateLineSegment(lx, ty + Bleed, lx, ty + (Bleed + Line_len))
+      Set s9 = ActiveLayer.CreateLineSegment(rx, ty + Bleed, rx, ty + (Bleed + Line_len))
+      sr.Add s7: sr.Add s9
+    Else
+      Set s2 = ActiveLayer.CreateLineSegment(lx - Bleed, By, lx - (Bleed + Line_len), By)
+      Set s6 = ActiveLayer.CreateLineSegment(lx - Bleed, ty, lx - (Bleed + Line_len), ty)
+      sr.Add s2: sr.Add s6
+    End If
+  Next s1
+
+  '// 获得页面中心点 x,y
+'  px = ActiveDocument.Pages.First.CenterX
+'  py = ActiveDocument.Pages.First.CenterY
+  '// 物件范围边界
+  px = OrigSelection.LeftX
+  py = OrigSelection.TopY
+  
+  '// 页面边缘对齐
+  For Each s In sr
+    If mark = cdrAlignTop Then
+      s.TopY = py + Line_len + Bleed
+    Else
+      s.LeftX = px - Line_len - Bleed
+    End If
+  Next s
+  
+  '// 简单删除重复
+  RemoveDuplicates sr
+  
+  '// 设置线宽和颜色，再选择
+   sr.SetOutlineProperties Outline_Width
+   sr.SetOutlineProperties Color:=CreateRGBColor(0, 255, 0)
+   sr.AddToSelection
+   
+  API.EndOpt
+End Function
+
+ '// 简单删除重复线算法
+Private Function RemoveDuplicates(sr As ShapeRange)
+  Dim s As Shape, cnt As Integer, rms As New ShapeRange
+  cnt = 1
+  
+  #If VBA7 Then
+     sr.Sort " @shape1.Top * 100 - @shape1.Left > @shape2.Top * 100 - @shape2.Left"
+  #Else
+    ' X4 不支持 ShapeRange.sort
+  #End If
+
+  For Each s In sr
+    If cnt > 1 Then
+      If Check_duplicate(sr(cnt - 1), sr(cnt)) Then rms.Add sr(cnt)
+    End If
+    cnt = cnt + 1
+  Next s
+  
+  rms.Delete
+End Function
+
+ '// 检查重复算法
+Private Function Check_duplicate(s1 As Shape, s2 As Shape) As Boolean
+  Check_duplicate = False
+  Jitter = 0.1
+  X = Abs(s1.CenterX - s2.CenterX)
+  Y = Abs(s1.CenterY - s2.CenterY)
+  w = Abs(s1.SizeWidth - s2.SizeWidth)
+  h = Abs(s1.SizeHeight - s2.SizeHeight)
+  If X < Jitter And Y < Jitter And w < Jitter And h < Jitter Then
+    Check_duplicate = True
+  End If
+End Function
 
 
 '// 单线条转裁切线 - 放置到页面四边
-Sub SelectLine_to_Cropline()
-  If 0 = ActiveSelectionRange.Count Then Exit Sub
+Public Function SelectLine_to_Cropline()
+  If 0 = ActiveSelectionRange.Count Then Exit Function
   '// 代码运行时关闭窗口刷新
   Application.Optimization = True
   ActiveDocument.Unit = cdrMillimeter
@@ -117,4 +209,4 @@ Sub SelectLine_to_Cropline()
   Application.Optimization = False
   ActiveWindow.Refresh
   Application.Refresh
-End Sub
+End Function

module/Launcher.bas

@@ -1,43 +1,49 @@
 Attribute VB_Name = "Launcher"
-'// �行计算器
+'// This is free and unencumbered software released into the public domain.
+'// For more information, please refer to  https://github.com/hongwenjun
+
+'// Attribute VB_Name = "ÆäËû¹¤¾ßÆô¶¯"   Other Tools Start  2023.6.11
+
+
+'// ÔËÐмÆËãÆ÷
 Public Function START_Calc()
     Shell "Calc"
 End Function
 
 
-'// 记事本打开备忘录
+'// ¼Çʱ¾´ò¿ª±¸Íü¼
 Public Function START_Notepad()
-    cmd_line = "Notepad  C:\TSP\备忘录.txt"
+    cmd_line = "Notepad  C:\TSP\±¸Íü¼.txt"
     Shell cmd_line, vbNormalNoFocus
 End Function
 
 
-'// 打开��阅读器
+'// ´ò¿ªÌõÂëÔĶÁÆ÷
 Public Function START_Barcode_ImageReader()
     cmd_line = "C:\Program Files (x86)\Softek Software\Softek Barcode Toolkit 30 Day Evaluation\bin\ImageReader.exe"
     Shell cmd_line, vbNormalNoFocus
 End Function
 
 
-'// 矢�化工具 Vector Magic
+'// ʸÁ¿»¯¹¤¾ß Vector Magic
 Public Function START_Vector_Magic()
     cmd_line = "C:\Program Files (x86)\Vector Magic\vmde.exe"
     Shell cmd_line, vbNormalNoFocus
 End Function
 
-'// waifu2x 图片放大
+'// waifu2x ͼƬ·Å´ó
 Public Function START_waifu2x()
     cmd_line = "C:\soft\waifu2x-gui-1.2\waifu2x-gui.exe"
     Shell cmd_line, vbNormalNoFocus
 End Function
 
-'// 开始视频录制
+'// ¿ªÊ¼ÊÓƵ¼ÖÆ
 Public Function START_Bandicam()
     cmd_line = "C:\Program Files (x86)\Bandicam\BandicamPortable.exe"
     Shell cmd_line, vbNormalNoFocus
 End Function
 
-'// 找字体 https://www.myfonts.com/pages/whatthefont
+'// ÕÒ×ÖÌå https://www.myfonts.com/pages/whatthefont
 Public Function START_whatthefont()
     Weburl "https://www.myfonts.com/pages/whatthefont"
 End Function

module/SmartGroup.bas

@@ -1,4 +1,9 @@
-Attribute VB_Name = "智能群组和查找"
+Attribute VB_Name = "SmartGroup"
+'// This is free and unencumbered software released into the public domain.
+'// For more information, please refer to  https://github.com/hongwenjun
+
+'// Attribute VB_Name = "智能群组"   SmartGroup  2023.6.11
+
 Sub 剪贴板物件替换()
   Replace_UI.Show 0
 End Sub
@@ -13,16 +18,16 @@ Public Sub 智能群组(Optional ByVal tr As Double = 0)
   
   Dim OrigSelection As ShapeRange, sr As New ShapeRange
   Dim s1 As Shape, sh As Shape, s As Shape
-  Dim x As Double, Y As Double, w As Double, h As Double
+  Dim X As Double, Y As Double, w As Double, h As Double
   Dim eff1 As Effect
   
   Set OrigSelection = ActiveSelectionRange
 
   '// 遍历物件画矩形
   For Each sh In OrigSelection
-    sh.GetBoundingBox x, Y, w, h
+    sh.GetBoundingBox X, Y, w, h
     If w * h > 4 Then
-      Set s = ActiveLayer.CreateRectangle2(x - tr, Y - tr, w + 2 * tr, h + 2 * tr)
+      Set s = ActiveLayer.CreateRectangle2(X - tr, Y - tr, w + 2 * tr, h + 2 * tr)
       sr.Add s
 
     '// 轴线 创建轮廓处理
@@ -49,7 +54,7 @@ Public Sub 智能群组(Optional ByVal tr As Double = 0)
   '// 矩形边界智能群组，删除矩形
   For Each s In brk1
     Set sh = ActivePage.SelectShapesFromRectangle(s.LeftX, s.TopY, s.RightX, s.BottomY, False)
-    sh.Shapes.All.Group
+    sh.Shapes.all.group
     s.Delete
   Next
 
@@ -82,7 +87,7 @@ Function 智能群组_V1()
   For Each s In brk1
     If s.SizeHeight > 10 Then
       Set sh = ActivePage.SelectShapesFromRectangle(s.LeftX, s.TopY, s.RightX, s.BottomY, False)
-      sh.Shapes.All.Group
+      sh.Shapes.all.group
     End If
     s.Delete
   Next

module/TSP.bas

@@ -2,23 +2,23 @@ Attribute VB_Name = "TSP"
 '// 导出节点信息到数据文件
 Public Function CDR_TO_TSP()
   Set fs = CreateObject("Scripting.FileSystemObject")
-  Set F = fs.CreateTextFile("C:\TSP\CDR_TO_TSP", True)
+  Set f = fs.CreateTextFile("C:\TSP\CDR_TO_TSP", True)
   
   ActiveDocument.Unit = cdrMillimeter
   Dim sh As Shape, shs As Shapes, cs As Shape
-  Dim x As Double, Y As Double
+  Dim X As Double, Y As Double
   Set shs = ActiveSelection.Shapes
   
   Dim TSP As String
   TSP = shs.Count & " " & 0 & vbNewLine
   For Each sh In shs
-    x = sh.CenterX
+    X = sh.CenterX
     Y = sh.CenterY
-    TSP = TSP & x & " " & Y & vbNewLine
+    TSP = TSP & X & " " & Y & vbNewLine
   Next sh
   
-  F.WriteLine TSP
-  F.Close
+  f.WriteLine TSP
+  f.Close
   MsgBox "小圆点导出节点信息到数据文件!" & vbNewLine
 End Function
 
@@ -28,7 +28,7 @@ Public Function Nodes_To_TSP()
   ActiveDocument.BeginCommandGroup:  Application.Optimization = True
   
   Set fs = CreateObject("Scripting.FileSystemObject")
-  Set F = fs.CreateTextFile("C:\TSP\CDR_TO_TSP", True)
+  Set f = fs.CreateTextFile("C:\TSP\CDR_TO_TSP", True)
   ActiveDocument.Unit = cdrMillimeter
   
   Dim ssr As ShapeRange
@@ -37,21 +37,21 @@ Public Function Nodes_To_TSP()
   Dim nr As NodeRange
   Dim nd As Node
   
-  Dim x As String, Y As String
+  Dim X As String, Y As String
   Dim TSP As String
   
   Set s = ssr.UngroupAllEx.Combine
-  Set nr = s.Curve.Nodes.All
+  Set nr = s.Curve.Nodes.all
   
   TSP = nr.Count & " " & 0 & vbNewLine
   For Each n In nr
-      x = Round(n.PositionX, 3) & " "
-      Y = Round(n.PositionY, 3) & vbNewLine
-      TSP = TSP & x & Y
+      X = round(n.PositionX, 3) & " "
+      Y = round(n.PositionY, 3) & vbNewLine
+      TSP = TSP & X & Y
   Next n
   
-  F.WriteLine TSP
-  F.Close
+  f.WriteLine TSP
+  f.Close
   s.Delete
   MsgBox "选择物件导出节点信息到数据文件!" & vbNewLine
   
@@ -76,13 +76,13 @@ Public Function TSP_TO_DRAW_LINE()
   ActiveDocument.Unit = cdrMillimeter
   
   Set fs = CreateObject("Scripting.FileSystemObject")
-  Set F = fs.OpenTextFile("C:\TSP\TSP.txt", 1, False)
+  Set f = fs.OpenTextFile("C:\TSP\TSP.txt", 1, False)
   Dim Str, arr, n
-  Str = F.ReadAll()
+  Str = f.ReadAll()
   
-  Str = VBA.replace(Str, vbNewLine, " ")
+  Str = VBA.Replace(Str, vbNewLine, " ")
   Do While InStr(Str, "  ")
-      Str = VBA.replace(Str, "  ", " ")
+      Str = VBA.Replace(Str, "  ", " ")
   Loop
   
   arr = Split(Str)
@@ -95,14 +95,14 @@ Public Function TSP_TO_DRAW_LINE()
   ce(0).PositionX = Val(arr(2)) - 3    '// 线条起始坐标，偏移3mm方向指示
   ce(0).PositionY = Val(arr(3)) - 3
   
-  Dim x As Double
+  Dim X As Double
   Dim Y As Double
   For n = 2 To UBound(arr) - 1 Step 2
-    x = Val(arr(n))
+    X = Val(arr(n))
     Y = Val(arr(n + 1))
   
     ce(n / 2).ElementType = cdrElementLine
-    ce(n / 2).PositionX = x
+    ce(n / 2).PositionX = X
     ce(n / 2).PositionY = Y
   
   Next
@@ -128,29 +128,29 @@ Public Function TSP_TO_DRAW_LINES()
   ActiveDocument.Unit = cdrMillimeter
   
   Set fs = CreateObject("Scripting.FileSystemObject")
-  Set F = fs.OpenTextFile("C:\TSP\TSP2.txt", 1, False)
+  Set f = fs.OpenTextFile("C:\TSP\TSP2.txt", 1, False)
   Dim Str, arr, n
   Dim line As Shape
-  Str = F.ReadAll()
+  Str = f.ReadAll()
   
-  Str = VBA.replace(Str, vbNewLine, " ")
+  Str = VBA.Replace(Str, vbNewLine, " ")
   Do While InStr(Str, "  ")
-    Str = VBA.replace(Str, "  ", " ")
+    Str = VBA.Replace(Str, "  ", " ")
   Loop
   
   arr = Split(Str)
   For n = 2 To UBound(arr) - 1 Step 4
-    x = Val(arr(n))
+    X = Val(arr(n))
     Y = Val(arr(n + 1))
     x1 = Val(arr(n + 2))
     y1 = Val(arr(n + 3))
 
-    Set line = ActiveLayer.CreateLineSegment(x, Y, x1, y1)
+    Set line = ActiveLayer.CreateLineSegment(X, Y, x1, y1)
     set_line_color line
   Next
   
   ActivePage.Shapes.FindShapes(Query:="@colors.find(RGB(26, 22, 35))").CreateSelection
-  ActiveSelection.Group
+  ActiveSelection.group
   ActiveSelection.Outline.SetProperties 0.2, Color:=CreateCMYKColor(0, 100, 100, 0)
   
   ActiveDocument.EndCommandGroup: Application.Optimization = False
@@ -173,15 +173,15 @@ Public Function BITMAP_MAKE_DOTS()
   ActiveDocument.BeginCommandGroup: Application.Optimization = True
   ActiveDocument.Unit = cdrMillimeter
   Dim line, art, n, h, w
-  Dim x As Double
+  Dim X As Double
   Dim Y As Double
   Dim s As Shape
   flag = 0
   
   Set fs = CreateObject("Scripting.FileSystemObject")
-  Set F = fs.OpenTextFile("C:\TSP\BITMAP", 1, False)
+  Set f = fs.OpenTextFile("C:\TSP\BITMAP", 1, False)
 
-  line = F.ReadLine()
+  line = f.ReadLine()
   Debug.Print line
 
   ' 读取第一行，位图 h高度 和 w宽度
@@ -193,20 +193,20 @@ Public Function BITMAP_MAKE_DOTS()
       flag = 1
   End If
 
-  For I = 1 To h
-    line = F.ReadLine()
+  For i = 1 To h
+    line = f.ReadLine()
     arr = Split(line)
     For n = LBound(arr) To UBound(arr)
       If arr(n) > 0 Then
-        x = n: Y = -I
+        X = n: Y = -i
         If flag = 1 Then
-          Set s = ActiveLayer.CreateRectangle2(x, Y, 0.6, 0.6)
+          Set s = ActiveLayer.CreateRectangle2(X, Y, 0.6, 0.6)
         Else
-          make_dots x, Y
+          make_dots X, Y
         End If
       End If
     Next n
-  Next I
+  Next i
 
   ActiveDocument.EndCommandGroup: Application.Optimization = False
   ActiveWindow.Refresh: Application.Refresh
@@ -217,11 +217,11 @@ ErrorHandler:
 End Function
 
 '// 坐标绘制圆点
-Private Function make_dots(x As Double, Y As Double)
+Private Function make_dots(X As Double, Y As Double)
   Dim s As Shape
   Dim c As Variant
   c = Array(0, 255, 0)
-  Set s = ActiveLayer.CreateEllipse2(x, Y, 0.5, 0.5)
+  Set s = ActiveLayer.CreateEllipse2(X, Y, 0.5, 0.5)
   s.Fill.UniformColor.RGBAssign c(Int(Rnd() * 2)), c(Int(Rnd() * 2)), c(Int(Rnd() * 2))
   s.Outline.Width = 0#
 End Function

module/Tools.bas

@@ -1,6 +1,6 @@
 Attribute VB_Name = "Tools"
 Public Function 分分合合()
-  拼版裁切线.arrange
+  拼版裁切线.Arrange
   
   CQL查找相同.CQLline_CM100
   
@@ -15,7 +15,7 @@ Public Function 分分合合()
 
 End Function
 
-
+ActiveDocument.ReferencePoint = cdrTopLeft
 Public Function 傻瓜火车排列(space_width As Double)
   ActiveDocument.BeginCommandGroup:  Application.Optimization = True
   ActiveDocument.Unit = cdrMillimeter
@@ -71,15 +71,25 @@ Public Function 傻瓜阶梯排列(space_width As Double)
   ActiveWindow.Refresh:    Application.Refresh
 End Function
 
-'// 文本转曲线
-Public Function TextShape_ConvertToCurves()
+'// 文本转曲线   默认使用简单转曲，参数 all=1 ，支持框选和图框剪裁内的文本
+Public Function TextShape_ConvertToCurves(Optional all = 0)
   On Error GoTo ErrorHandler
   ActiveDocument.BeginCommandGroup:  Application.Optimization = True
   Dim s As Shape, cnt As Long
-  For Each s In API.FindAllShapes.Shapes.FindShapes(, cdrTextShape)
-    s.ConvertToCurves
-    cnt = cnt + 1
-  Next s
+  
+  If all = 1 Then
+    For Each s In API.FindAllShapes.Shapes.FindShapes(, cdrTextShape)
+      s.ConvertToCurves
+      cnt = cnt + 1
+    Next s
+  Else
+  
+    For Each s In ActivePage.FindShapes(, cdrTextShape)
+      s.ConvertToCurves
+      cnt = cnt + 1
+    Next s
+  End If
+  
   MsgBox "转曲物件统计: " & cnt, , "文本转曲线"
   
   ActiveDocument.EndCommandGroup
@@ -285,7 +295,7 @@ Public Function Split_Segment()
   Dim nd As Node
   
   Set s = ssr.UngroupAllEx.Combine
-  Set nr = s.Curve.Nodes.All
+  Set nr = s.Curve.Nodes.all
   
   nr.BreakApart
   s.BreakApartEx
@@ -429,7 +439,7 @@ Public Function Take_Apart_Character()
     mark_shape_expand sh, tr
   Next sh
   
-  Set ssr = ActivePage.Shapes.FindShapes(query:="@colors.find(RGB(0, 255, 0))")
+  Set ssr = ActivePage.Shapes.FindShapes(Query:="@colors.find(RGB(0, 255, 0))")
   ActiveDocument.ClearSelection
   ssr.AddToSelection
   
@@ -622,7 +632,7 @@ Public Function Single_Line_LastNode()
   Dim nr As NodeRange
   For Each s In ssr
     If cnt > 1 Then
-      Set nr = s.DisplayCurve.Nodes.All
+      Set nr = s.DisplayCurve.Nodes.all
       Set line = ActiveLayer.CreateLineSegment(nr.FirstNode.PositionX, nr.FirstNode.PositionY, nr.LastNode.PositionX, nr.LastNode.PositionY)
       line.Outline.SetProperties Color:=cm(1)
       SrNew.Add line
@@ -668,7 +678,7 @@ Function quickColorSelect()
 
     EventsEnabled = False
     
-    Set sr = ActivePage.Shapes.FindShapes(query:="@fill.type = 'uniform'")
+    Set sr = ActivePage.Shapes.FindShapes(Query:="@fill.type = 'uniform'")
     ActiveDocument.ClearSelection
     bClick = False
     While Not bClick
@@ -1005,7 +1015,7 @@ Public Function autogroup(Optional group As String = "group", Optional shft = 0,
   Dim sp As SubPaths
   Dim arr()
   Dim s As Shape
-  If sss Is Nothing Then Set os = ActiveSelectionRange Else Set os = sss.All
+  If sss Is Nothing Then Set os = ActiveSelectionRange Else Set os = sss.all
   On Error GoTo errn
   ActiveDocument.BeginCommandGroup:  Application.Optimization = True
   
@@ -1106,7 +1116,7 @@ Public Function 角度转平()
   On Error GoTo ErrorHandler
 '  ActiveDocument.ReferencePoint = cdrCenter
   Set sr = ActiveSelectionRange
-  Set nr = sr.LastShape.DisplayCurve.Nodes.All
+  Set nr = sr.LastShape.DisplayCurve.Nodes.all
 
   If nr.Count = 2 Then
     x1 = nr.FirstNode.PositionX: y1 = nr.FirstNode.PositionY
@@ -1121,7 +1131,7 @@ Public Function 自动旋转角度()
   On Error GoTo ErrorHandler
 '  ActiveDocument.ReferencePoint = cdrCenter
   Set sr = ActiveSelectionRange
-  Set nr = sr.LastShape.DisplayCurve.Nodes.All
+  Set nr = sr.LastShape.DisplayCurve.Nodes.all
 
   If nr.Count = 2 Then
     x1 = nr.FirstNode.PositionX: y1 = nr.FirstNode.PositionY
@@ -1145,7 +1155,7 @@ End Function
 Public Function 参考线镜像()
   On Error GoTo ErrorHandler
   Set sr = ActiveSelectionRange
-  Set nr = sr.LastShape.DisplayCurve.Nodes.All
+  Set nr = sr.LastShape.DisplayCurve.Nodes.all
 
   If nr.Count = 2 Then
     ActiveDocument.BeginCommandGroup "Mirror": Application.Optimization = True