Update cut_lines.bas

cut_lines.bas

@@ -4,58 +4,65 @@ Type Coordinate
 End Type
 
 Sub Cut_lines()
-'// 代码运行时关闭窗口刷新
-    Application.Optimization = True
-    ActiveDocument.BeginCommandGroup  '一步撤消'
-    ActiveDocument.Unit = cdrMillimeter
-    Dim OrigSelection As ShapeRange
-    Set OrigSelection = ActiveSelectionRange
+  If 0 = ActiveSelectionRange.Count Then Exit Sub
+  '// 代码运行时关闭窗口刷新
+  Application.Optimization = True
+  ActiveDocument.BeginCommandGroup  '一步撤消'
+  ActiveDocument.Unit = cdrMillimeter
+  Dim OrigSelection As ShapeRange
+  Set OrigSelection = ActiveSelectionRange
+  
+  Dim s1 As Shape, sbd As Shape
+  Dim dot As Coordinate
+  Dim arr As Variant, border As Variant
+  
+  ' 当前选择物件的范围边界
+  set_lx = OrigSelection.LeftX:   set_rx = OrigSelection.RightX
+  set_by = OrigSelection.BottomY: set_ty = OrigSelection.TopY
+  set_cx = OrigSelection.CenterX: set_cy = OrigSelection.CenterY
+  radius = 8:  border = Array(set_lx, set_rx, set_by, set_ty, set_cx, set_cy, radius)
+  
+  ' 创建边界矩形，用来添加角线
+  Set sbd = ActiveLayer.CreateRectangle(set_lx, set_by, set_rx, set_ty)
+  OrigSelection.Add sbd
+  
+  For Each Target In OrigSelection
+    Set s1 = Target
+    lx = s1.LeftX:   rx = s1.RightX
+    by = s1.BottomY: ty = s1.TopY
+    cx = s1.CenterX: cy = s1.CenterY
     
-    Dim s1 As Shape
-    Dim dot As Coordinate
-    Dim arr As Variant, border As Variant
-
-    ' 当前选择物件的范围边界
-    set_lx = OrigSelection.LeftX:   set_rx = OrigSelection.RightX
-    set_by = OrigSelection.BottomY: set_ty = OrigSelection.TopY
-    set_cx = OrigSelection.CenterX: set_cy = OrigSelection.CenterY
-    radius = 8:  border = Array(set_lx, set_rx, set_by, set_ty, set_cx, set_cy, radius)
-
-    For Each Target In OrigSelection
-        Set s1 = Target
-        lx = s1.LeftX:   rx = s1.RightX
-        by = s1.BottomY: ty = s1.TopY
-        cx = s1.CenterX: cy = s1.CenterY
+    '// 范围边界物件判断
+    If Abs(set_lx - lx) < radius Or Abs(set_rx - rx) < radius Or Abs(set_by - by) _
+      < 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)
         
-        '// 范围边界物件判断
-        If Abs(set_lx - lx) < radius Or Abs(set_rx - rx) < radius Or Abs(set_by - by) _
-            < 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)
-                
-                '// 范围边界坐标点判断
-                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
+        '// 范围边界坐标点判断
+        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
+            draw_line dot, border  '// 以坐标点和范围边界画裁切线
         End If
-    Next Target
+      Next i
+    End If
+  Next Target
   
-    ActiveDocument.EndCommandGroup
-    '// 使用CQL 颜色标志查找，然后群组统一设置线宽和注册色
-    ActivePage.Shapes.FindShapes(Query:="@colors.find(RGB(26, 22, 35))").CreateSelection
-    ActiveSelection.Group
-    ActiveSelection.Outline.SetProperties 0.1, Color:=CreateRegistrationColor
-    
-    '// 代码操作结束恢复窗口刷新
-    Application.Optimization = False
-    ActiveWindow.Refresh
-    Application.Refresh
+  sbd.Delete  '删除边界矩形
+  
+  '// 使用CQL 颜色标志查找，然后群组统一设置线宽和注册色
+  ActivePage.Shapes.FindShapes(Query:="@colors.find(RGB(26, 22, 35))").CreateSelection
+  ActiveSelection.Group
+  ActiveSelection.Outline.SetProperties 0.1, Color:=CreateRegistrationColor
+  
+  ActiveDocument.EndCommandGroup
+  '// 代码操作结束恢复窗口刷新
+  Application.Optimization = False
+  ActiveWindow.Refresh
+  Application.Refresh
 End Sub
 
 '范围边界 border = Array(set_lx, set_rx, set_by, set_ty, set_cx, set_cy, radius)
@@ -63,6 +70,29 @@ Private Function draw_line(dot As Coordinate, border As Variant)
     Bleed = 2:  line_len = 3:  radius = border(6)
     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_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_color line
+    End If
+    
+    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
+        Set line = ActiveLayer.CreateLineSegment(border(0) - Bleed, dot.y, border(0) - (line_len + Bleed), dot.y)
+        set_line_color line
+    End If
+
+End Function
+
+'// 旧版本
+Private Function draw_line_按点基准(dot As Coordinate, border As Variant)
+    Bleed = 2:  line_len = 3:  radius = border(6)
+    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_color line