浏览代码

Update 智能群组 SmartGroup

hongwenjun 1 年之前
父节点
当前提交
985259649e
共有 1 个文件被更改,包括 5 次插入3 次删除
  1. 5 3
      module/SmartGroup.bas

+ 5 - 3
module/SmartGroup.bas

@@ -37,6 +37,7 @@ Public Function Smart_Group(Optional ByVal tr As Double = 0) As ShapeRange
   sr.AddRange ActivePage.Shapes.FindShapes(Query:="@fill.Color=RGB(26, 22, 35)")
 
   '// 新矩形寻找边界,散开,删除刚才画的新矩形
+  Dim brk1 As ShapeRange
   Set s1 = sr.CustomCommand("Boundary", "CreateBoundary")
   Set brk1 = s1.BreakApartEx
   sr.Delete
@@ -44,9 +45,9 @@ Public Function Smart_Group(Optional ByVal tr As Double = 0) As ShapeRange
   '// 矩形边界智能群组, RetSR 返回群组 和 删除矩形s
   Dim RetSR As New ShapeRange
   For Each s In brk1
-    Set OrigSelection = ActivePage.SelectShapesFromRectangle(s.LeftX, s.TopY, s.RightX, s.BottomY, False).Shapes.all
-    s.Delete
-    If OrigSelection.Count > 2 Then RetSR.Add OrigSelection.Group
+    Set sr = ActivePage.SelectShapesFromRectangle(s.LeftX, s.TopY, s.RightX, s.BottomY, False).Shapes.all
+    sr.DeleteItem sr.IndexOf(s)
+    If sr.Count > 0 Then RetSR.Add sr.Group
   Next s
   
   '// 智能群组返回和选择
@@ -76,3 +77,4 @@ Private Function Smart_Group_ABC()
     s.Delete
   Next
 End Function
+