1
1
蘭雅sRGB 3 жил өмнө
parent
commit
7c92fea9f4
1 өөрчлөгдсөн 8 нэмэгдсэн , 13 устгасан
  1. 8 13
      cut_lines.bas

+ 8 - 13
cut_lines.bas

@@ -3,8 +3,8 @@ Type Coordinate
     y As Double
 End Type
 
-Sub cut_lines()
-    '// 代码运行时关闭窗口刷新
+Sub ShapesRange()
+'// 代码运行时关闭窗口刷新
     Application.Optimization = True
     ActiveDocument.Unit = cdrMillimeter
     Dim OrigSelection As ShapeRange
@@ -44,14 +44,11 @@ Sub cut_lines()
             Next i
         End If
     Next Target
-
-    Dim s As Shape   '// 使用 ObjectData 搜索裁切线,群组裁切线
-    For Each s In ActivePage.Shapes
-        If "cut_line" = s.ObjectData("name").Value Then
-            ActiveDocument.AddToSelection s
-        End If
-    Next s
+  
+    '// 使用CQL 颜色标志查找,然后群组统一设置线宽和注册色
+    ActivePage.Shapes.FindShapes(Query:="@colors.find(RGB(26, 22, 35))").CreateSelection
     ActiveSelection.Group
+    ActiveSelection.Outline.SetProperties 0.1, Color:=CreateRegistrationColor
     
     '// 代码操作结束恢复窗口刷新
     Application.Optimization = False
@@ -83,8 +80,6 @@ Private Function draw_line(dot As Coordinate, border As Variant)
 End Function
 
 Private Function set_line_color(line As Shape)
-    '// 设置线宽和注册色,添加物件名为最后群组使用
-    line.Outline.SetProperties 0.1
-    line.Outline.SetProperties Color:=CreateRegistrationColor
-    line.ObjectData("Name").Value = "cut_line"
+    '// 设置线宽和注册色
+   line.Outline.SetProperties Color:=CreateRGBColor(26, 22, 35)
 End Function