一键智能拆字功能更新

UI/Toolbar.bas

@@ -338,12 +338,11 @@ Private Sub Batch_Combine_MouseDown(ByVal Button As Integer, ByVal Shift As Inte
   If Button = 2 Then
     Tools.Batch_Combine
     MsgBox "右键暂定功能: 智能群组后的拆开组合"
-    Exit Sub
-  End If
-  
-  If Button Then
+  ElseIf Shift = fmCtrlMask Then
     Tools.Take_Apart_Character
     Me.Height = 30
+  Else
+    Tools.Create_Tolerance
   End If
 End Sub
 

donate.md

@@ -9,6 +9,11 @@
 
 蘭雅sRGB(蘭公子)
 
+
+| 微信支付 | 支付宝 |
+| ------- | ------- |
+| ![](https://262235.xyz/donate/WXPay.png) | ![](https://262235.xyz/donate/AliPay.jpg) |
+
 ### 捐赠者:
 ```
 山河激光

module/Tools.bas

@@ -399,7 +399,7 @@ Public Function Take_Apart_Character()
   ' 记忆选择范围
   Dim x As Double, y As Double, w As Double, h As Double
   ssr.GetBoundingBox x, y, w, h
-' ActiveLayer.CreateRectangle2 x, y, w, h
+  Set s1 = ActiveLayer.CreateRectangle2(x, y, w, h)
   
   ' 解散群组，先组合，再散开
   Set s = ssr.UngroupAllEx.Combine
@@ -424,12 +424,13 @@ Public Function Take_Apart_Character()
   智能群组和查找.智能群组
   ssr.Delete
   
-  ' 调用 批量组合合并
-  ActiveDocument.ReferencePoint = cdrBottomLeft
-  Set sh = ActivePage.SelectShapesFromRectangle(x - 1, y - 1, w + 2, h + 2, False)
-  sh.Shapes.All.AddToSelection
-
-  Batch_Combine
+  Set sh = ActivePage.SelectShapesFromRectangle(s1.LeftX, s1.TopY, s1.RightX, s1.BottomY, False)
+' sh.Shapes.All.Group
+  s1.Delete
+  
+  For Each s In sh.Shapes
+    s.UngroupAllEx.Combine
+  Next s
 
   ActiveDocument.EndCommandGroup
   Application.Optimization = False