零基础CorelVBA代码更新

ArrangeForm.frm

@@ -0,0 +1,88 @@
+VERSION 5.00
+Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} ArrangeForm 
+   Caption         =   "蘭雅sRGB 手动拼版 │ 嘉盟赞助"
+   ClientHeight    =   2475
+   ClientLeft      =   45
+   ClientTop       =   330
+   ClientWidth     =   4650
+   OleObjectBlob   =   "ArrangeForm.frx":0000
+   ShowModal       =   0   'False
+   StartUpPosition =   2  '屏幕中心
+   WhatsThisButton =   -1  'True
+   WhatsThisHelp   =   -1  'True
+End
+Attribute VB_Name = "ArrangeForm"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+
+Private Sub CommandButton1_Click()
+  On Error GoTo ErrorHandler
+  ActiveDocument.Unit = cdrMillimeter
+  Dim ls As Integer, hs As Integer
+  Dim lj As Double, hj As Double
+  Dim matrix As Variant
+  Dim s As ShapeRange
+  
+  ls = Val(TextBox1.text)
+  hs = Val(TextBox2.text)
+  lj = Val(TextBox3.text)
+  hj = Val(TextBox4.text)
+  matrix = Array(ls, hs, lj, hj)
+  
+  Set s = ActiveSelectionRange
+
+  If ls * hs = 0 Then Exit Sub
+  If ls = 1 Or hs = 1 Then
+    arrange_Clone_one matrix, s
+    Exit Sub
+  End If
+  
+  '// 代码运行时关闭窗口刷新
+  ActiveDocument.BeginCommandGroup:  Application.Optimization = True
+  '// 拼版矩阵
+  arrange_Clone matrix, s
+
+  ActiveDocument.EndCommandGroup
+  Unload Me
+  
+  '// 代码操作结束恢复窗口刷新
+  ActiveDocument.EndCommandGroup
+  Application.Optimization = False
+  ActiveWindow.Refresh:    Application.Refresh
+  Exit Sub
+ErrorHandler:
+  Application.Optimization = False
+  On Error Resume Next
+End Sub
+
+'// 拼版矩阵  matrix = Array(ls,hs,lj,hj)
+Private Function arrange_Clone(matrix As Variant, s As ShapeRange)
+  ls = matrix(0): hs = matrix(1)
+  lj = matrix(2): hj = matrix(3)
+  x = s.SizeWidth: y = s.SizeHeight
+  Set s1 = s.Clone
+  '// StepAndRepeat 方法在范围内创建多个形状副本
+  Set dup1 = s1.StepAndRepeat(ls - 1, x + lj, 0#)
+  Set dup2 = ActiveDocument.CreateShapeRangeFromArray(dup1, s1).StepAndRepeat(hs - 1, 0#, -(y + hj))
+  s1.Delete
+End Function
+
+Private Function arrange_Clone_one(matrix As Variant, s As ShapeRange)
+  ls = matrix(0): hs = matrix(1)
+  lj = matrix(2): hj = matrix(3)
+  x = s.SizeWidth: y = s.SizeHeight
+  Set s1 = s.Clone
+  '// StepAndRepeat 方法在范围内创建多个形状副本
+  If ls > 1 Then
+    Set dup1 = s1.StepAndRepeat(ls - 1, x + lj, 0#)
+  Else
+    Set dup1 = s1
+  End If
+  If hs > 1 Then
+    Set dup2 = ActiveDocument.CreateShapeRangeFromArray(dup1, s1).StepAndRepeat(hs - 1, 0#, -(y + hj))
+  End If
+  s1.Delete
+End Function
+

AutoCutLines.bas

@@ -9,7 +9,7 @@ Public Sub AutoCutLines()
   Nodes_TO_TSP
   START_Cut_Line_Algorithm 3#
   
-  '延时500毫秒，如果电脑够快，可以调整到100ms
+  '寤舵椂500姣��锛屽�鏋滅數鑴戝�蹇�紝鍙�互璋冩暣鍒�100ms
   Sleep 500
   TSP_TO_DRAW_LINES
 End Sub
@@ -39,7 +39,7 @@ Private Function Nodes_TO_TSP()
     f.WriteLine TSP
     f.Close
     
-    '// 刷新一下文件流，延时的效果
+    '// 鍒锋柊涓€涓嬫枃浠舵祦锛屽欢鏃剁殑鏁堟灉
     Set f = fs.OpenTextFile("C:\TSP\CDR_TO_TSP", 1, False)
     Dim str
     str = f.ReadAll()
@@ -53,7 +53,7 @@ ErrorHandler:
     On Error Resume Next
 End Function
 
-'//  TSP功能画线-多线段
+'//  TSP鍔熻兘鐢荤嚎-澶氱嚎娈�
 Private Function TSP_TO_DRAW_LINES()
   On Error GoTo ErrorHandler
   ActiveDocument.BeginCommandGroup: Application.Optimization = True
@@ -83,7 +83,7 @@ Private Function TSP_TO_DRAW_LINES()
     Set line = ActiveLayer.CreateLineSegment(x, y, x1, y1)
     set_line_color line
     
-    ' 调试线条顺序
+    ' 璋冭瘯绾挎潯椤哄簭
     puts x, y, (n + 2) / 4
     
   Next
@@ -100,13 +100,13 @@ ErrorHandler:
     On Error Resume Next
 End Function
 
-'// 运行裁切线算法 Cut_Line_Algorithm.py
+'// 杩愯�瑁佸垏绾跨畻娉� Cut_Line_Algorithm.py
 Private Function START_Cut_Line_Algorithm(Optional ext As Double = 3)
     cmd_line = "python C:\TSP\Cut_Line_Algorithm.py" & " " & ext
     Shell cmd_line
 End Function
 
-'// 设置线条标记(颜色)
+'// 璁剧疆绾挎潯鏍囪�(棰滆壊)
 Private Function set_line_color(line As Shape)
   line.Outline.SetProperties Color:=CreateRGBColor(26, 22, 35)
 End Function

Hello_VBA.bas

@@ -1,4 +1,4 @@
 Attribute VB_Name = "Hello_VBA"
 Sub run()
-  VBA_FORM.show 0
+  VBA_FORM.Show 0
 End Sub

PhotoForm.frm

@@ -14,6 +14,7 @@ Attribute VB_GlobalNameSpace = False
 Attribute VB_Creatable = False
 Attribute VB_PredeclaredId = True
 Attribute VB_Exposed = False
+
 #If VBA7 Then
     Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
     Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Tools.bas

@@ -9,9 +9,8 @@ Public Function wait()
   Sleep 3000
 End Function
 
-Public Sub 填入居中文字(str)
+Public Sub 濉�叆灞呬腑鏂囧瓧(str)
   Dim s As Shape
-<<<<<<< HEAD
   Dim x As Double, y As Double, Shift As Long
   Dim b As Boolean
   b = ActiveDocument.GetUserClick(x, y, Shift, 10, False, cdrCursorIntersectSingle)
@@ -21,80 +20,46 @@ Public Sub
   Set s = ActiveLayer.CreateArtisticText(0, 0, str)
   s.CenterX = x
   s.CenterY = y
-=======
-  Set s = ActiveSelection
-  X = s.CenterX
-  Y = s.CenterY
-  
-  Set s = ActiveLayer.CreateArtisticText(0, 0, Str)
-  s.CenterX = X
-  s.CenterY = Y
->>>>>>> 556e97d494ce938408287776a3528f332486766c
 End Sub
 
-Public Sub 尺寸标注()
+Public Sub 灏哄�鏍囨敞()
   ActiveDocument.Unit = cdrMillimeter
   Set s = ActiveSelection
-<<<<<<< HEAD
   x = s.CenterX: y = s.TopY
   sw = s.SizeWidth: sh = s.SizeHeight
         
   text = Int(sw) & "x" & Int(sh) & "mm"
   Set s = ActiveLayer.CreateArtisticText(0, 0, text)
   s.CenterX = x: s.BottomY = y + 5
-=======
-  X = s.CenterX: Y = s.TopY
-  sw = s.SizeWidth: sh = s.SizeHeight
-        
-  Text = Int(sw) & "x" & Int(sh) & "mm"
-  Set s = ActiveLayer.CreateArtisticText(0, 0, Text)
-  s.CenterX = X: s.BottomY = Y + 5
->>>>>>> 556e97d494ce938408287776a3528f332486766c
 End Sub
 
-Public Sub 批量居中文字(str)
+Public Sub 鎵归噺灞呬腑鏂囧瓧(str)
   Dim s As Shape, sr As ShapeRange
   Set sr = ActiveSelectionRange
   
   For Each s In sr.Shapes
-<<<<<<< HEAD
     x = s.CenterX: y = s.CenterY
     
     Set s = ActiveLayer.CreateArtisticText(0, 0, str)
     s.CenterX = x: s.CenterY = y
-=======
-    X = s.CenterX: Y = s.CenterY
-    
-    Set s = ActiveLayer.CreateArtisticText(0, 0, Str)
-    s.CenterX = X: s.CenterY = Y
->>>>>>> 556e97d494ce938408287776a3528f332486766c
   Next
 End Sub
 
-Public Sub 批量标注()
+Public Sub 鎵归噺鏍囨敞()
   ActiveDocument.Unit = cdrMillimeter
   Set sr = ActiveSelectionRange
   
   For Each s In sr.Shapes
-<<<<<<< HEAD
     x = s.CenterX: y = s.TopY
     sw = s.SizeWidth: sh = s.SizeHeight
           
     text = Int(sw + 0.5) & "x" & Int(sh + 0.5) & "mm"
     Set s = ActiveLayer.CreateArtisticText(0, 0, text)
     s.CenterX = x: s.BottomY = y + 5
-=======
-    X = s.CenterX: Y = s.TopY
-    sw = s.SizeWidth: sh = s.SizeHeight
-          
-    Text = Int(sw + 0.5) & "x" & Int(sh + 0.5) & "mm"
-    Set s = ActiveLayer.CreateArtisticText(0, 0, Text)
-    s.CenterX = X: s.BottomY = Y + 5
->>>>>>> 556e97d494ce938408287776a3528f332486766c
   Next
 End Sub
 
-Public Sub 智能群组()
+Public Sub 鏅鸿兘缇ょ粍()
   Set s1 = ActiveSelectionRange.CustomCommand("Boundary", "CreateBoundary")
   Set brk1 = s1.BreakApartEx
 
@@ -106,14 +71,14 @@ Public Sub
 End Sub
 
 
-' 实践应用: 选择物件群组,页面设置物件大小,物件页面居中
-Public Function 群组居中页面()
+' 瀹炶返搴旂敤: 閫夋嫨鐗╀欢缇ょ粍,椤甸潰璁剧疆鐗╀欢澶у皬,鐗╀欢椤甸潰灞呬腑
+Public Function 缇ょ粍灞呬腑椤甸潰()
   ActiveDocument.Unit = cdrMillimeter
   Dim OrigSelection As ShapeRange, sh As Shape
   Set OrigSelection = ActiveSelectionRange
   Set sh = OrigSelection.group
   
-  ' MsgBox "选择物件尺寸: " & sh.SizeWidth & "x" & sh.SizeHeight
+  ' MsgBox "閫夋嫨鐗╀欢灏哄�: " & sh.SizeWidth & "x" & sh.SizeHeight
   ActivePage.SetSize Int(sh.SizeWidth + 0.9), Int(sh.SizeHeight + 0.9)
   
 #If VBA7 Then
@@ -127,7 +92,7 @@ Public Function 群
 End Function
 
 
-Public Function 批量多页居中()
+Public Function 鎵归噺澶氶〉灞呬腑()
   If 0 = ActiveSelectionRange.Count Then Exit Function
   On Error GoTo ErrorHandler
   ActiveDocument.BeginCommandGroup:  Application.Optimization = True
@@ -136,19 +101,19 @@ Public Function
   Set sr = ActiveSelectionRange
   total = sr.Count
 
-  '// 建立多页面
+  '// 寤虹珛澶氶〉闈�
   Set doc = ActiveDocument
   doc.AddPages (total - 1)
 
   Dim sh As Shape
   
-  '// 遍历批量物件，放置物件到页面
+  '// 閬嶅巻鎵归噺鐗╀欢锛屾斁缃�墿浠跺埌椤甸潰
   For i = 1 To sr.Count
     doc.Pages(i).Activate
     Set sh = sr.Shapes(i)
     ActivePage.SetSize Int(sh.SizeWidth + 0.9), Int(sh.SizeHeight + 0.9)
  
-   '// 物件居中页面
+   '// 鐗╀欢灞呬腑椤甸潰
 #If VBA7 Then
   ActiveDocument.ClearSelection
   sh.AddToSelection
@@ -165,12 +130,12 @@ Exit Function
 
 ErrorHandler:
   Application.Optimization = False
-  MsgBox "请先选择一些物件"
+  MsgBox "璇峰厛閫夋嫨涓€浜涚墿浠�"
   On Error Resume Next
 End Function
 
 
-'// 安全线: 点击一次建立辅助线，再调用清除参考线
+'// 瀹夊叏绾�: 鐐瑰嚮涓€娆″缓绔嬭緟鍔╃嚎锛屽啀璋冪敤娓呴櫎鍙傝€冪嚎
 Public Function guideangle(actnumber As ShapeRange, cardblood As Integer)
   Dim sr As ShapeRange
   Set sr = ActiveDocument.MasterPage.GuidesLayer.FindShapes(Type:=cdrGuidelineShape)
@@ -192,7 +157,7 @@ Public Function guideangle(actnumber As ShapeRange, cardblood As Integer)
 End Function
 
 Public Function splash_cnt()
-  splash.show 0
+  splash.Show 0
   splash.text1 = splash.text1 & ">"
   Sleep 100
 End Function
@@ -203,7 +168,7 @@ Public Function vba_cnt()
   Sleep 100
 End Function
 
-Public Function 按面积排列(space_width As Double)
+Public Function 鎸夐潰绉�帓鍒�(space_width As Double)
   If 0 = ActiveSelectionRange.Count Then Exit Function
   ActiveDocument.Unit = cdrMillimeter
   ActiveDocument.ReferencePoint = cdrCenter
@@ -214,7 +179,7 @@ Public Function
 #If VBA7 Then
   ssr.Sort "@shape1.width * @shape1.height < @shape2.width * @shape2.height"
 #Else
-' X4 不支持 ShapeRange.sort
+' X4 涓嶆敮鎸� ShapeRange.sort
 #End If
 
   Dim str As String, size As String
@@ -235,29 +200,23 @@ Public Function
   Next s
 
 
-'  写文件，可以EXCEL里统计
+'  鍐欐枃浠讹紝鍙�互EXCEL閲岀粺璁�
 '  Set fs = CreateObject("Scripting.FileSystemObject")
 '  Set f = fs.CreateTextFile("D:\size.txt", True)
 '  f.WriteLine str: f.Close
 
-  str = 分类汇总(str)
+  str = 鍒嗙被姹囨€�(str)
   Debug.Print str
 
   Dim s1 As Shape
-' Set s1 = ActiveLayer.CreateParagraphText(0, 0, 100, 150, Str, Font:="华文中宋")
-<<<<<<< HEAD
+' Set s1 = ActiveLayer.CreateParagraphText(0, 0, 100, 150, Str, Font:="鍗庢枃涓�畫")
   x = ssr.FirstShape.LeftX - 100
   y = ssr.FirstShape.TopY
-  Set s1 = ActiveLayer.CreateParagraphText(x, y, x + 90, y - 150, str, Font:="华文中宋")
-=======
-  X = ssr.FirstShape.LeftX - 100
-  Y = ssr.FirstShape.TopY
-  Set s1 = ActiveLayer.CreateParagraphText(X, Y, X + 90, Y - 150, Str, Font:="华文中宋")
->>>>>>> 556e97d494ce938408287776a3528f332486766c
+  Set s1 = ActiveLayer.CreateParagraphText(x, y, x + 90, y - 150, str, Font:="鍗庢枃涓�畫")
 End Function
  
-'// 实现Excel里分类汇总功能
-Private Function 分类汇总(str As String) As String
+'// 瀹炵幇Excel閲屽垎绫绘眹鎬诲姛鑳�
+Private Function 鍒嗙被姹囨€�(str As String) As String
   Dim a, b, d, arr
   str = VBA.Replace(str, vbNewLine, " ")
   Do While InStr(str, "  ")
@@ -275,30 +234,30 @@ Private Function
     End If
   Next
 
-  str = "   规   格" & vbTab & vbTab & vbTab & "数量" & vbNewLine
+  str = "   瑙�   鏍�" & vbTab & vbTab & vbTab & "鏁伴噺" & vbNewLine
 
   a = d.keys: b = d.items
   For i = 0 To d.Count - 1
     ' Debug.Print a(i), b(i)
-    str = str & a(i) & vbTab & vbTab & b(i) & "条" & vbNewLine
+    str = str & a(i) & vbTab & vbTab & b(i) & "鏉�" & vbNewLine
   Next
 
-  分类汇总 = str & "合计总量:" & vbTab & vbTab & vbTab & UBound(arr) & "条" & vbNewLine
+  鍒嗙被姹囨€� = str & "鍚堣�鎬婚噺:" & vbTab & vbTab & vbTab & UBound(arr) & "鏉�" & vbNewLine
 End Function
 
 
-' 两个端点的坐标,为(x1,y1)和(x2,y2) 那么其角度a的tan值: tana=(y2-y1)/(x2-x1)
-' 所以计算arctan(y2-y1)/(x2-x1), 得到其角度值a
-' VB中用atn(), 返回值是弧度，需要 乘以 PI /180
+' 涓や釜绔�偣鐨勫潗鏍�,涓�(x1,y1)鍜�(x2,y2) 閭ｄ箞鍏惰�搴�鐨則an鍊�: tana=(y2-y1)/(x2-x1)
+' 鎵€浠ヨ�绠梐rctan(y2-y1)/(x2-x1), 寰楀埌鍏惰�搴﹀€糰
+' VB涓�敤atn(), 杩斿洖鍊兼槸寮у害锛岄渶瑕� 涔樹互 PI /180
 Private Function lineangle(x1, y1, x2, y2) As Double
-  pi = 4 * VBA.Atn(1) ' 计算圆周率
+  pi = 4 * VBA.Atn(1) ' 璁＄畻鍦嗗懆鐜�
   If x2 = x1 Then
     lineangle = 90: Exit Function
   End If
   lineangle = VBA.Atn((y2 - y1) / (x2 - x1)) / pi * 180
 End Function
 
-Public Function 角度转平()
+Public Function 瑙掑害杞�钩()
   On Error GoTo ErrorHandler
 '  ActiveDocument.ReferencePoint = cdrCenter
   Set sr = ActiveSelectionRange
@@ -308,12 +267,12 @@ Public Function
     x1 = nr.FirstNode.PositionX: y1 = nr.FirstNode.PositionY
     x2 = nr.LastNode.PositionX: y2 = nr.LastNode.PositionY
     a = lineangle(x1, y1, x2, y2): sr.Rotate -a
-    ' sr.LastShape.Delete   '// 删除参考线
+    ' sr.LastShape.Delete   '// 鍒犻櫎鍙傝€冪嚎
   End If
 ErrorHandler:
 End Function
 
-Public Function 自动旋转角度()
+Public Function 鑷�姩鏃嬭浆瑙掑害()
   On Error GoTo ErrorHandler
 '  ActiveDocument.ReferencePoint = cdrCenter
   Set sr = ActiveSelectionRange
@@ -323,13 +282,13 @@ Public Function
     x1 = nr.FirstNode.PositionX: y1 = nr.FirstNode.PositionY
     x2 = nr.LastNode.PositionX: y2 = nr.LastNode.PositionY
     a = lineangle(x1, y1, x2, y2): sr.Rotate 90 + a
-    sr.LastShape.Delete   '// 删除参考线
+    sr.LastShape.Delete   '// 鍒犻櫎鍙傝€冪嚎
   End If
 ErrorHandler:
 End Function
 
 
-Public Function 交换对象()
+Public Function 浜ゆ崲瀵硅薄()
   Set sr = ActiveSelectionRange
   If sr.Count = 2 Then
     x = sr.LastShape.CenterX: y = sr.LastShape.CenterY
@@ -338,7 +297,7 @@ Public Function
   End If
 End Function
 
-Public Function 参考线镜像()
+Public Function 鍙傝€冪嚎闀滃儚()
   On Error GoTo ErrorHandler
   Set sr = ActiveSelectionRange
   Set nr = sr.LastShape.DisplayCurve.Nodes.All
@@ -348,26 +307,26 @@ Public Function
     byshape = False
     x1 = nr.FirstNode.PositionX: y1 = nr.FirstNode.PositionY
     x2 = nr.LastNode.PositionX: y2 = nr.LastNode.PositionY
-    a = lineangle(x1, y1, x2, y2)  '// 参考线和水平的夹角 a
+    a = lineangle(x1, y1, x2, y2)  '// 鍙傝€冪嚎鍜屾按骞崇殑澶硅� a
     sr.Remove sr.Count
     
-    ang = 90 - a  ' 镜像的旋转角度
+    ang = 90 - a  ' 闀滃儚鐨勬棆杞��搴�
     For Each s In sr
       With s
-        .Duplicate   ' // 复制物件保留，然后按 x1,y1 点 旋转
+        .Duplicate   ' // 澶嶅埗鐗╀欢淇濈暀锛岀劧鍚庢寜 x1,y1 鐐� 鏃嬭浆
         .RotationCenterX = x1
         .RotationCenterY = y1
         .Rotate ang
         If Not byshape Then
             lx = .LeftX
-            .Stretch -1#, 1#    ' // 通过拉伸完成镜像
+            .Stretch -1#, 1#    ' // 閫氳繃鎷変几瀹屾垚闀滃儚
             .LeftX = lx
             .Move (x1 - .LeftX) * 2 - .SizeWidth, 0
-            .RotationCenterX = x1   '// 之前因为镜像，旋转中心点反了，重置回来
+            .RotationCenterX = x1   '// 涔嬪墠鍥犱负闀滃儚锛屾棆杞�腑蹇冪偣鍙嶄簡锛岄噸缃�洖鏉�
             .RotationCenterY = y1
             .Rotate -ang
         End If
-        .RotationCenterX = .CenterX   '// 重置回旋转中心点为物件中心
+        .RotationCenterX = .CenterX   '// 閲嶇疆鍥炴棆杞�腑蹇冪偣涓虹墿浠朵腑蹇�
         .RotationCenterY = .CenterY
       End With
     Next s
@@ -469,18 +428,7 @@ Public Function collect_arr(arr, ci, ki)
 End Function
 
 
-' 两个端点的坐标,为(x1,y1)和(x2,y2) 那么其角度a的tan值: tana=(y2-y1)/(x2-x1)
-' 所以计算arctan(y2-y1)/(x2-x1), 得到其角度值a
-' VB中用atn(), 返回值是弧度，需要 乘以 PI /180
-Private Function lineangle(x1, y1, x2, y2) As Double
-  pi = 4 * VBA.Atn(1) ' 计算圆周率
-  If x2 = x1 Then
-    lineangle = 90: Exit Function
-  End If
-  lineangle = VBA.Atn((y2 - y1) / (x2 - x1)) / pi * 180
-End Function
 
-<<<<<<< HEAD
 Sub Make_Sizes()
     ActiveDocument.Unit = cdrMillimeter
     Set os = ActiveSelectionRange
@@ -497,7 +445,7 @@ Sub Make_Sizes()
     End If
 End Sub
 
-'''////  选择多物件，组合然后拆分线段，为角线爬虫准备  ////'''
+'''////  閫夋嫨澶氱墿浠讹紝缁勫悎鐒跺悗鎷嗗垎绾挎�锛屼负瑙掔嚎鐖�櫕鍑嗗�  ////'''
 Public Function Split_Segment()
   On Error GoTo ErrorHandler
   ActiveDocument.BeginCommandGroup:  Application.Optimization = True
@@ -527,7 +475,7 @@ ErrorHandler:
 End Function
 
 
-'// 修复圆角缺角到直角
+'// 淇��鍦嗚�缂鸿�鍒扮洿瑙�
 Public Sub corner_off()
     Dim os As ShapeRange
     Dim s As Shape, fir As Shape, ci As Shape
@@ -678,17 +626,17 @@ Sub ExportNodePositions()
     ActiveDocument.Unit = cdrMillimeter
     
     'Get all the curve shapes on the Active Layer
-    '获取Active Layer上的所有曲线形状
+    '鑾峰彇Active Layer涓婄殑鎵€鏈夋洸绾垮舰鐘�
     Set srActiveLayer = ActiveLayer.Shapes.FindShapes(Query:="@type='curve'")
     'This is another way you can get only the curve shapes
-    '这是另一种你只能得到曲线形状的方法
+    '杩欐槸鍙︿竴绉嶄綘鍙�兘寰楀埌鏇茬嚎褰㈢姸鐨勬柟娉�
     'Set srActiveLayer = ActiveLayer.Shapes.FindShapes.FindAnyOfType(cdrCurveShape)
     
     'Loop through each curve
-    '遍历每条曲线
+    '閬嶅巻姣忔潯鏇茬嚎
     For Each s In srActiveLayer.Shapes
         'Loop though each node in the curve and get the position
-        '遍历曲线中的每个节点并获取位置
+        '閬嶅巻鏇茬嚎涓�殑姣忎釜鑺傜偣骞惰幏鍙栦綅缃�
         For Each n In s.Curve.Nodes
             n.GetPosition x, y
             strNodePositions = strNodePositions & "x: " & x & " y: " & y & vbCrLf
@@ -696,13 +644,13 @@ Sub ExportNodePositions()
     Next s
     
     'Save the node positions to a file
-    '将节点位置保存到文件
+    '灏嗚妭鐐逛綅缃�繚瀛樺埌鏂囦欢
     Open "C:\Temp\NodePositions.txt" For Output As #1
         Print #1, strNodePositions
     Close #1
 End Sub
 
-Sub 服务器T()
+Sub 鏈嶅姟鍣═()
    Dim mark As Shape
    Dim sr As ShapeRange
    
@@ -711,9 +659,9 @@ Sub
         sr.Shapes.FindShapes(Query:="@type ='rectangle'or @type ='curve'or @type ='Ellipse'or @type ='Polygon'").ConvertToCurves
    If sr.Count = 0 Then Exit Sub
    
-    ' CorelDRAW设置原点标记导出DXF使用
+    ' CorelDRAW璁剧疆鍘熺偣鏍囪�瀵煎嚭DXF浣跨敤
     
-    ' 更新原点标记，现在能设置任意坐标点
+    ' 鏇存柊鍘熺偣鏍囪�锛岀幇鍦ㄨ兘璁剧疆浠绘剰鍧愭爣鐐�
     Dim MarkPos_Array() As Double
     MarkPos_Array = Get_MarkPosition
     AtOrigin MarkPos_Array(0), MarkPos_Array(1)
@@ -754,50 +702,50 @@ Sub SaveDXF(FileName As String)
     End With
 End Sub
 
-' 更新原点标记函数，现在能设置任意坐标点
+' 鏇存柊鍘熺偣鏍囪�鍑芥暟锛岀幇鍦ㄨ兘璁剧疆浠绘剰鍧愭爣鐐�
 Sub AtOrigin(Optional px As Double = 0#, Optional py As Double = 0#)
   Dim doc As Document: Set doc = ActiveDocument
   doc.Unit = cdrMillimeter
 
-  '// 导入原点标记标记文件 OriginMark.cdr 解散群组
+  '// 瀵煎叆鍘熺偣鏍囪�鏍囪�鏂囦欢 OriginMark.cdr 瑙ｆ暎缇ょ粍
   doc.ActiveLayer.Import path & "GMS\OriginMark.cdr"
   doc.ReferencePoint = cdrCenter
   doc.Selection.Ungroup
 
   Dim sh As Shape, shs As Shapes
   Set shs = ActiveSelection.Shapes
-  '// 按 MarkName 名称查找 标记物件
+  '// 鎸� MarkName 鍚嶇О鏌ユ壘 鏍囪�鐗╀欢
   For Each sh In shs
     If "AtOrigin" = sh.ObjectData("MarkName").Value Then
       sh.SetPosition px, py
     Else
-      sh.Delete   ' 不需要的标记删除
+      sh.Delete   ' 涓嶉渶瑕佺殑鏍囪�鍒犻櫎
     End If
   Next sh
 End Sub
 
-' 使用 GlobalUserData 对象保存 Mark标记坐标文本，调用函数能设置文本
+' 浣跨敤 GlobalUserData 瀵硅薄淇濆瓨 Mark鏍囪�鍧愭爣鏂囨湰锛岃皟鐢ㄥ嚱鏁拌兘璁剧疆鏂囨湰
 Public Function Mark_SetPosition() As String
   Dim text As String
   If GlobalUserData.Exists("MarkPosition", 1) Then
     text = GlobalUserData("MarkPosition", 1)
   End If
-  text = InputBox("请输入Mark标记坐标(x,y),空格或逗号间隔", "设置Mark标记坐标(x,y),单位(mm)", text)
+  text = InputBox("璇疯緭鍏�ark鏍囪�鍧愭爣(x,y),绌烘牸鎴栭€楀彿闂撮殧", "璁剧疆Mark鏍囪�鍧愭爣(x,y),鍗曚綅(mm)", text)
   If text = "" Then Exit Function
   GlobalUserData("MarkPosition", 1) = text
   Mark_SetPosition = text
 End Function
 
-' 调用设置Mark标记坐标功能，返回 数组(x,y)
+' 璋冪敤璁剧疆Mark鏍囪�鍧愭爣鍔熻兘锛岃繑鍥� 鏁扮粍(x,y)
 Public Function Get_MarkPosition() As Double()
   Dim MarkPos_Array(0 To 1) As Double
   Dim str, arr
   
   str = Mark_SetPosition
 
-  ' 替换 逗号 为空格
+  ' 鏇挎崲 閫楀彿 涓虹┖鏍�
   str = VBA.Replace(str, ",", " ")
-  Do While InStr(str, "  ") '多个空格换成一个空格
+  Do While InStr(str, "  ") '澶氫釜绌烘牸鎹㈡垚涓€涓�┖鏍�
       str = VBA.Replace(str, "  ", " ")
   Loop
   arr = Split(str)
@@ -805,7 +753,7 @@ Public Function Get_MarkPosition() As Double()
   MarkPos_Array(0) = Val(arr(0))
   MarkPos_Array(1) = Val(arr(1))
   
-  Debug.Print MarkPos_Array(0), MarkPos_Array(1)  ' 视图->立即窗口，调试显示
+  Debug.Print MarkPos_Array(0), MarkPos_Array(1)  ' 瑙嗗浘->绔嬪嵆绐楀彛锛岃皟璇曟樉绀�
   
   Get_MarkPosition = MarkPos_Array
   
@@ -818,12 +766,12 @@ Public Function SetNames()
 #If VBA7 Then
   ssr.Sort " @shape1.left<@shape2.left"
 #Else
-' X4 不支持 ShapeRange.sort
+' X4 涓嶆敮鎸� ShapeRange.sort
 #End If
 
   Dim text As String
   Dim lines() As String
-  ' 提取文本信息，切割文本
+  ' 鎻愬彇鏂囨湰淇℃伅锛屽垏鍓叉枃鏈�
   If ssr(1).Type = cdrTextShape Then
     If ssr(1).text.Type = cdrArtistic Then
       text = ssr(1).text.Story.text
@@ -832,16 +780,16 @@ Public Function SetNames()
   #If VBA7 Then
       ssr.Sort " @shape1.top>@shape2.top"
   #Else
-  ' X4 不支持 ShapeRange.sort
+  ' X4 涓嶆敮鎸� ShapeRange.sort
   #End If
     End If
   Else
-      MsgBox "请把多行文本放最左边"
+      MsgBox "璇锋妸澶氳�鏂囨湰鏀炬渶宸﹁竟"
       Exit Function
   End If
     
 ' Debug.Print ssr.Count, UBound(lines), LBound(lines)
-' 给物件设置名称，用处:批量导出可以有一个名称
+' 缁欑墿浠惰�缃�悕绉帮紝鐢ㄥ�:鎵归噺瀵煎嚭鍙�互鏈変竴涓�悕绉�
   i = 0
   If ssr.Count <= UBound(lines) + 1 Then
     For Each s In ssr
@@ -850,7 +798,7 @@ Public Function SetNames()
     Next s
   End If
   
-  If ssr.Count <> UBound(lines) + 1 Then MsgBox "文本行:" & (UBound(lines) + 1) & vbNewLine & "右边物件:" & ssr.Count
+  If ssr.Count <> UBound(lines) + 1 Then MsgBox "鏂囨湰琛�:" & (UBound(lines) + 1) & vbNewLine & "鍙宠竟鐗╀欢:" & ssr.Count
     
 End Function
 
@@ -877,7 +825,7 @@ Sub Nodes_TO_TSP()
     f.Close
 End Sub
 
-'// 获得剪贴板文本字符
+'// 鑾峰緱鍓�创鏉挎枃鏈�瓧绗�
 Public Function GetClipBoardString() As String
   On Error Resume Next
   Dim MyData As New DataObject
@@ -886,281 +834,3 @@ Public Function GetClipBoardString() As String
   GetClipBoardString = MyData.GetText
   Set MyData = Nothing
 End Function
-=======
-Public Function 角度转平()
-  On Error GoTo ErrorHandler
-'  ActiveDocument.ReferencePoint = cdrCenter
-  Set sr = ActiveSelectionRange
-  Set nr = sr.LastShape.DisplayCurve.Nodes.All
-
-  If nr.Count = 2 Then
-    x1 = nr.FirstNode.PositionX: y1 = nr.FirstNode.PositionY
-    x2 = nr.LastNode.PositionX: y2 = nr.LastNode.PositionY
-    a = lineangle(x1, y1, x2, y2): sr.Rotate -a
-    ' sr.LastShape.Delete   '// 删除参考线
-  End If
-ErrorHandler:
-End Function
-
-Public Function 自动旋转角度()
-  On Error GoTo ErrorHandler
-'  ActiveDocument.ReferencePoint = cdrCenter
-  Set sr = ActiveSelectionRange
-  Set nr = sr.LastShape.DisplayCurve.Nodes.All
-
-  If nr.Count = 2 Then
-    x1 = nr.FirstNode.PositionX: y1 = nr.FirstNode.PositionY
-    x2 = nr.LastNode.PositionX: y2 = nr.LastNode.PositionY
-    a = lineangle(x1, y1, x2, y2): sr.Rotate 90 + a
-    sr.LastShape.Delete   '// 删除参考线
-  End If
-ErrorHandler:
-End Function
-
-
-Public Function 交换对象()
-  Set sr = ActiveSelectionRange
-  If sr.Count = 2 Then
-    X = sr.LastShape.CenterX: Y = sr.LastShape.CenterY
-    sr.LastShape.CenterX = sr.FirstShape.CenterX: sr.LastShape.CenterY = sr.FirstShape.CenterY
-    sr.FirstShape.CenterX = X: sr.FirstShape.CenterY = Y
-  End If
-End Function
-
-
-'//  ===================================================
-Private Sub btn_autoalign_byrow_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
-    If get_events("btn_autoalign_byrow", Shift, Button) = "exit" Then Exit Sub
-    autogroup("group_lines", 16 + Shift).CreateSelection
-End Sub
-Private Sub btn_autoalign_bycolumn_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
-    If get_events("btn_autoalign_bycolumn", Shift, Button) = "exit" Then Exit Sub
-    autogroup("group_lines", 13 + Shift).CreateSelection
-End Sub
-Private Sub btn_autogroup_byrow_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
-    If get_events("btn_autogroup_byrow", Shift, Button) = "exit" Then Exit Sub
-    autogroup("group_lines", 6).CreateSelection
-End Sub
-Private Sub btn_autogroup_bycolumn_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
-    If get_events("btn_autogroup_bycolumn", Shift, Button) = "exit" Then Exit Sub
-    autogroup("group_lines", 3).CreateSelection
-End Sub
-Private Sub btn_autogroup_bysquare_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
-    If get_events("btn_autogroup_bysquare", Shift, Button) = "exit" Then Exit Sub
-    autogroup("group").CreateSelection
-End Sub
-Private Sub btn_autogroup_byshape_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
-    If get_events("btn_autogroup_byshape", Shift, Button) = "exit" Then Exit Sub
-    autogroup("group", 1).CreateSelection
-End Sub
-
-Public Sub begin_func(Optional undoname = "nul", Optional units = cdrMillimeter, Optional undogroup = True, Optional optimize = True, Optional sett = "before")
-        ActiveDocument.SaveSettings sett
-        ActiveDocument.Unit = units
-        If undogroup Then ActiveDocument.BeginCommandGroup undoname
-        Application.Optimization = optimize
-        EventsEnabled = Not optimize
-End Sub
-
-Public Sub end_func(Optional undogroup = True, Optional sett = "before")
-    cure_app undogroup
-    ActiveDocument.RestoreSettings sett
-End Sub
-
-Sub cure_app(Optional undogroup = True)
-    EventsEnabled = True
-    Application.Optimization = False
-    Application.Refresh
-    DoEvents
-    If undogroup Then ActiveDocument.EndCommandGroup
-End Sub
-
-Public Function collect_arr(arr, ci, ki)
-    lim = UBound(arr)
-    For k = 1 To lim
-        If arr(ki, k) > 0 Then
-            arr(ci, k) = k
-            If ki <> ci Then arr(ki, k) = Empty
-            If ci <> k And ki <> k Then arr = collect_arr(arr, ci, k)
-        End If
-    Next k
-    'If ki <> ci Then arr(ki, ki) = Empty
-    collect_arr = arr
-End Function
-
-Public Function autogroup(Optional group As String = "group", Optional shft = 0, Optional sss As Shapes = Nothing, Optional undogroup = True) As ShapeRange
-    Dim sr As ShapeRange, sr_all As ShapeRange, os As ShapeRange
-    Dim sp As SubPaths
-    Dim arr()
-    Dim s As Shape
-    If sss Is Nothing Then Set os = ActiveSelectionRange Else Set os = sss.All
-'On Error GoTo errn
-    If ActiveSelection.Shapes.Count > 0 Then
-        begin_func "autogroup" & group, cdrMillimeter, undogroup
-        gcnt = os.Shapes.Count
-        ReDim arr(1 To gcnt, 1 To gcnt)
-        Set sr_all = ActiveSelectionRange
-        sr_all.RemoveAll
-        If group = "group_lines" Then
-            For i = 1 To gcnt
-                If shft = 3 Or shft = 13 Or shft = 14 Then
-                    coord = Int(os.Shapes(i).CenterX)
-                Else
-                    coord = Int(os.Shapes(i).CenterY)
-                End If
-                fnd = False
-                For k = 1 To gcnt
-                    If arr(k, 1) > 0 Then
-                        If arr(k, 2) = coord Then
-                            arr(k, 1) = arr(k, 1) + 1
-                            arr(k, 2 + arr(k, 1)) = i
-                            fnd = True
-                            Exit For
-                        End If
-                    Else
-                        Exit For
-                    End If
-                Next k
-                If Not fnd Then
-                    arr(k, 1) = 1
-                    arr(k, 2) = coord
-                    arr(k, 3) = i
-                End If
-            Next i
-            Set sr = ActiveSelectionRange
-            For i = 1 To gcnt
-                If arr(i, 1) > 0 Then
-                    sr.RemoveAll
-                    For k = 3 To gcnt
-                        If arr(i, k) > 0 Then sr.Add os.Shapes(arr(i, k))
-                    Next k
-                    If sr.Shapes.Count > 0 Then
-                        sr.CreateSelection
-                        If shft = 13 Then
-                            sr.AlignAndDistribute cdrAlignDistributeHNone, cdrAlignDistributeVDistributeSpacing
-                        ElseIf shft = 14 Then
-                            sr.AlignAndDistribute cdrAlignDistributeHNone, cdrAlignDistributeVDistributeCenter
-                        ElseIf shft = 16 Then
-                            sr.AlignAndDistribute cdrAlignDistributeHDistributeSpacing, cdrAlignDistributeVNone
-                        ElseIf shft = 17 Then
-                            sr.AlignAndDistribute cdrAlignDistributeHDistributeCenter, cdrAlignDistributeVNone
-                        Else
-                            sr.group
-                        End If
-                        sr_all.AddRange sr
-                    End If
-                End If
-            Next i
-        Else
-            ReDim arr(1 To gcnt, 1 To gcnt)
-            ActiveDocument.Unit = cdrTenthMicron
-            sgap = 10
-            If shft = 2 Or shft = 3 Or shft = 6 Or shft = 7 Then
-                os.RemoveAll
-                For Each s In ActiveSelectionRange.Shapes
-                    os.Add ActivePage.SelectShapesFromRectangle(s.LeftX - sgap, s.BottomY - sgap, s.RightX + sgap, s.TopY + sgap, True)
-                Next s
-            End If
-            
-            For i = 1 To os.Shapes.Count
-                Set s1 = os.Shapes(i)
-                arr(i, i) = i
-                For j = 1 To os.Shapes.Count
-                    Set s2 = os.Shapes(j)
-                    If s2.LeftX < s1.RightX + sgap And s2.RightX > s1.LeftX - sgap And s2.BottomY < s1.TopY + sgap And s2.TopY > s1.BottomY - sgap Then
-                        If shft = 1 Or shft = 3 Or shft = 5 Or shft = 7 Then
-                            Set isec = s1.Intersect(s2)
-                            If Not isec Is Nothing Then
-                                arr(i, j) = j
-                                isec.CreateSelection
-                                isec.Delete
-                            End If
-                        Else
-                            arr(i, j) = j
-                        End If
-                    End If
-                Next j
-            Next i
-            
-            For i = 1 To gcnt
-                arr = collect_arr(arr, i, i)
-            Next i
-            
-            Set sr = ActiveSelectionRange
-
-            For i = 1 To gcnt
-                sr.RemoveAll
-                inar = 0
-                For j = 1 To gcnt
-                    If arr(i, j) > 0 Then
-                        sr.Add os.Shapes(j)
-                        inar = inar + 1
-                    End If
-                Next j
-                If inar > 1 Then
-                    If group = "group" Then
-                        If shft < 4 Then sr_all.Add sr.group
-                    Else
-                        If group = "front" Then
-                            sr.Sort "@shape1.com.zOrder > @shape2.com.zOrder"
-                        ElseIf group = "back" Then
-                            sr.Sort "@shape1.com.zOrder < @shape2.com.zOrder"
-                        Else
-                            sr.Sort "@shape1.width*@shape1.height < @shape2.width*@shape2.height"
-                        End If
-                        Set fs = sr.FirstShape
-                        Set ls = sr.LastShape
-                        For Each s In sr.Shapes
-                            If Not s Is ls And Not s Is fs Then
-                                If group = "autocut" Then
-                                    Set isec = ls.Intersect(s)
-                                    If Not isec Is Nothing Then
-                                        If isec.Curve.Area = s.Curve.Area Then
-                                            Set ls = fs.Trim(ls, False)
-                                        Else
-                                            Set ls = fs.Weld(ls, False)
-                                        End If
-                                        isec.Delete
-                                    End If
-                                Else
-                                    Set fs = s.Weld(fs, False, False)
-                                End If
-                            End If
-                        Next s
-                        If group = "weld" Then
-                            Set ls = fs.Weld(ls, False)
-                        Else
-                            Set ls = fs.Trim(ls, False)
-                        End If
-                        sr_all.Add ls
-                    End If
-                Else
-                    If sr.Shapes.Count > 0 Then sr_all.AddRange sr
-                End If
-            Next i
-        End If
-        Set autogroup = sr_all
-    End If
-errn:
-    end_func undogroup
-End Function
-
-Sub auto_cut()
-    autogroup("autocut").CreateSelection
-End Sub
-Sub auto_big_small()
-    autogroup("big").CreateSelection
-End Sub
-Sub auto_group()
-    autogroup.CreateSelection
-End Sub
-Sub auto_weld()
-    autogroup("weld").CreateSelection
-End Sub
-Sub auto_group_lines()
-    autogroup("group_lines", 6).CreateSelection
-End Sub
-Sub auto_group_columns()
-    autogroup("group_lines", 3).CreateSelection
-End Sub
->>>>>>> 556e97d494ce938408287776a3528f332486766c

VBA_FORM.frm

@@ -1,34 +1,27 @@
 VERSION 5.00
 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} VBA_FORM 
    Caption         =   "Hello_VBA"
-   ClientHeight    =   7800
+   ClientHeight    =   7995
    ClientLeft      =   45
    ClientTop       =   390
-<<<<<<< HEAD
-   ClientWidth     =   6345
-=======
-   ClientWidth     =   5415
->>>>>>> 556e97d494ce938408287776a3528f332486766c
+   ClientWidth     =   6180
    OleObjectBlob   =   "VBA_FORM.frx":0000
-   StartUpPosition =   1  '所有者中心
+   StartUpPosition =   1  '鎵€鏈夎€呬腑蹇�
 End
 Attribute VB_Name = "VBA_FORM"
 Attribute VB_GlobalNameSpace = False
 Attribute VB_Creatable = False
 Attribute VB_PredeclaredId = True
 Attribute VB_Exposed = False
-<<<<<<< HEAD
+
 Private Sub AutoRotate_Click()
-  Tools.自动旋转角度
+  Tools.鑷�姩鏃嬭浆瑙掑害
 End Sub
 
-=======
->>>>>>> 556e97d494ce938408287776a3528f332486766c
 Private Sub btn_autoalign_bycolumn_Click()
   autogroup("group", 1).CreateSelection
 End Sub
 
-<<<<<<< HEAD
 Private Sub btn_corners_off_Click()
   Tools.corner_off
 End Sub
@@ -39,87 +32,77 @@ End Sub
 
 
 Private Sub CB_AQX_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
-=======
-Private Sub CB_AQX_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
->>>>>>> 556e97d494ce938408287776a3528f332486766c
   If Button = 2 Then
-    Tools.guideangle ActiveSelectionRange, 0#   ' 右键 0距离贴紧
+    Tools.guideangle ActiveSelectionRange, 0#   ' 鍙抽敭 0璺濈�璐寸揣
   ElseIf Shift = fmCtrlMask Then
-    Tools.guideangle ActiveSelectionRange, 4    ' 左键安全范围 4mm
+    Tools.guideangle ActiveSelectionRange, 4    ' 宸﹂敭瀹夊叏鑼冨洿 4mm
   Else
-    Tools.guideangle ActiveSelectionRange, -10     ' Ctrl + 鼠标左键
+    Tools.guideangle ActiveSelectionRange, -10     ' Ctrl + 榧犳爣宸﹂敭
   End If
 End Sub
 
 Private Sub CB_BZCC_Click()
-  Tools.尺寸标注
+  Tools.灏哄�鏍囨敞
 End Sub
 
 
 Private Sub CB_ECWZ_Click()
-  Tools.填入居中文字 GetClipBoardString
+  Tools.濉�叆灞呬腑鏂囧瓧 GetClipBoardString
 End Sub
 
 Private Sub CB_JDZP_Click()
-  Tools.角度转平
+  Tools.瑙掑害杞�钩
 End Sub
 
 Private Sub CB_JHDX_Click()
-  Tools.交换对象
+  Tools.浜ゆ崲瀵硅薄
 End Sub
 
-<<<<<<< HEAD
 Private Sub CB_make_sizes_Click()
   Tools.Make_Sizes
 End Sub
 
-=======
->>>>>>> 556e97d494ce938408287776a3528f332486766c
 Private Sub CB_PLBZ_Click()
-  Tools.批量标注
+  Tools.鎵归噺鏍囨敞
 End Sub
 
 Private Sub CB_PLDYJZ_Click()
-  Tools.批量多页居中
+  Tools.鎵归噺澶氶〉灞呬腑
 End Sub
 
 Private Sub CB_PLWZ_Click()
-  Tools.批量居中文字 "CorelVBA批量文字"
+  Tools.鎵归噺灞呬腑鏂囧瓧 "CorelVBA鎵归噺鏂囧瓧"
 End Sub
 
 Private Sub CB_QZJZ_Click()
-  Tools.群组居中页面
+  Tools.缇ょ粍灞呬腑椤甸潰
 End Sub
 
 
 Private Sub CB_SIZESORT_Click()
-    splash.show 1
+    splash.Show 1
 End Sub
 
 Private Sub CB_VBA_Click()
-  MsgBox "你好 CorelVBA!"
+  MsgBox "浣犲ソ CorelVBA!"
 End Sub
 
-<<<<<<< HEAD
 Private Sub CB_VBA_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
-=======
-Private Sub CB_VBA_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
->>>>>>> 556e97d494ce938408287776a3528f332486766c
   CB_VBA.BackColor = RGB(255, 0, 0)
 End Sub
 
 
 Private Sub CB_ZDJD_Click()
-  Tools.自动旋转角度
+  Tools.鑷�姩鏃嬭浆瑙掑害
 End Sub
 
 Private Sub CB_mirror_by_line_Click()
-  Tools.参考线镜像
+  Tools.鍙傝€冪嚎闀滃儚
 End Sub
 
 
 Private Sub CommandButton2_Click()
-  Tools.服务器T
+  Tools.鏈嶅姟鍣═
 End Sub
 
 Private Sub CommandButton3_Click()
@@ -130,10 +113,10 @@ Private Sub CommandButton3_Click()
     Set shr = ActivePage.Shapes.All
 
     If sr.Shapes.Count = 0 Then
-        shr.CreateSelection '所有对象
+        shr.CreateSelection '鎵€鏈夊�璞�
     Else
         shr.RemoveRange sr
-        shr.CreateSelection '不在原选择范围内的对象
+        shr.CreateSelection '涓嶅湪鍘熼€夋嫨鑼冨洿鍐呯殑瀵硅薄
     End If
 End Sub
 
@@ -142,7 +125,7 @@ Private Sub ExportNodePot_Click()
 End Sub
 
 Private Sub Photo_Form_Click()
-  PhotoForm.show 0
+  PhotoForm.Show 0
 End Sub
 
 Private Sub SetNames_Click()
@@ -151,7 +134,7 @@ End Sub
 
 Private Sub SplitSegment_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
   If Button = 2 Then
-    MsgBox "左键拆分线段，Ctrl合并线段"
+    MsgBox "宸﹂敭鎷嗗垎绾挎�锛孋trl鍚堝苟绾挎�"
   ElseIf Shift = fmCtrlMask Then
     Tools.Split_Segment
   Else
@@ -161,7 +144,7 @@ Private Sub SplitSegment_MouseDown(ByVal Button As Integer, ByVal Shift As Integ
 End Sub
 
 Private Sub Image4_Click()
-    cmd_line = "Notepad  D:\备忘录.txt"
+    cmd_line = "Notepad  D:\澶囧繕褰�.txt"
     Shell cmd_line, vbNormalNoFocus
 End Sub
 
@@ -170,74 +153,78 @@ Private Sub Image5_Click()
 End Sub
 
 Private Sub LevelRuler_Click()
-  Tools.角度转平
+  Tools.瑙掑害杞�钩
 End Sub
 
 Private Sub MakeSizes_Click()
-  ZCOPY.show 0
+  ZCOPY.Show 0
 End Sub
 
 Private Sub MirrorLine_Click()
-  Tools.参考线镜像
+  Tools.鍙傝€冪嚎闀滃儚
 End Sub
 
 Private Sub SortCount_Click()
-  Tools.按面积排列 50
+  Tools.鎸夐潰绉�帓鍒� 50
 End Sub
 
 Private Sub SwapShape_Click()
-  Tools.交换对象
+  Tools.浜ゆ崲瀵硅薄
 End Sub
 
 
 Private Sub ZNQZ_Click()
-  Tools.智能群组
+  Tools.鏅鸿兘缇ょ粍
 End Sub
 
-Private Sub 读取文本_Click()
+Private Sub 璇诲彇鏂囨湰_Click()
   AutoCutLines.AutoCutLines
 End Sub
 
-Sub 读取每一行数据()
+Sub 璇诲彇姣忎竴琛屾暟鎹�()
     Dim txt As Object, t As Object, path As String
     Set txt = CreateObject("Scripting.FileSystemObject")
     
     Dim a
-    ' 指定路径
+    ' 鎸囧畾璺�緞
     path = "R:\Temp.txt"
-    ' “1”表示只读打开，“2”表示写入，True表示目标文件不存在时是创建
+    ' 鈥�1鈥濊〃绀哄彧璇绘墦寮€锛屸€�2鈥濊〃绀哄啓鍏ワ紝True琛ㄧず鐩�爣鏂囦欢涓嶅瓨鍦ㄦ椂鏄�垱寤�
     Set t = txt.OpenTextFile(path, 1, True)
     '--------------------------
-    ' 读取每一行并把内容显示出来
+    ' 璇诲彇姣忎竴琛屽苟鎶婂唴瀹规樉绀哄嚭鏉�
     Do While Not t.AtEndOfStream
 '        a = t.ReadLine
         a = a & t.ReadLine & vbNewLine
     TextBox1.Value = a
     Loop
     '--------------------------
-    ' 打开文档，注意“notepad.exe ”最后有空格
+    ' 鎵撳紑鏂囨。锛屾敞鎰忊€渘otepad.exe 鈥濇渶鍚庢湁绌烘牸
     Shell "notepad.exe " & path, vbNormalFocus
-    ' 释放变量
+    ' 閲婃斁鍙橀噺
     Set t = Nothing
     Set txt = Nothing
 End Sub
 
 
 
-Private Sub 裁切线_Click()
+Private Sub 瑁佸垏绾縚Click()
  AutoCutLines.AutoCutLines
  
 End Sub
 
 
-Private Sub 算法计算_Click()
-  ChatGPT.计算行列
+Private Sub 鎵嬪姩鎷肩増_Click()
+  ArrangeForm.Show 0
+End Sub
+
+Private Sub 绠楁硶璁＄畻_Click()
+  ChatGPT.璁＄畻琛屽垪
 End Sub
 
-Private Sub Z序排列_Click()
-    ChatGPT.Z序排列
+Private Sub Z搴忔帓鍒梍Click()
+    ChatGPT.Z搴忔帓鍒�
 End Sub
 
-Private Sub U序排列_Click()
-  ChatGPT.正式U序排列
+Private Sub U搴忔帓鍒梍Click()
+  ChatGPT.姝ｅ紡U搴忔帓鍒�
 End Sub

ZCOPY.frm

@@ -6,7 +6,7 @@ Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} ZCOPY
    ClientTop       =   330
    ClientWidth     =   4860
    OleObjectBlob   =   "ZCOPY.frx":0000
-   StartUpPosition =   1  'ËùÓÐÕßÖÐÐÄ
+   StartUpPosition =   1  '所有者中心
 End
 Attribute VB_Name = "ZCOPY"
 Attribute VB_GlobalNameSpace = False
@@ -14,6 +14,7 @@ Attribute VB_Creatable = False
 Attribute VB_PredeclaredId = True
 Attribute VB_Exposed = False
 
+
 Private Sub btn_square_hi_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
     If get_events("btn_square_hi", Shift, Button) = "exit" Then Exit Sub
     Set os = ActiveSelectionRange

splash.frm

@@ -6,13 +6,14 @@ Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} splash
    ClientTop       =   330
    ClientWidth     =   8100
    OleObjectBlob   =   "splash.frx":0000
-   StartUpPosition =   1  '所有者中心
+   StartUpPosition =   1  '鎵€鏈夎€呬腑蹇�
 End
 Attribute VB_Name = "splash"
 Attribute VB_GlobalNameSpace = False
 Attribute VB_Creatable = False
 Attribute VB_PredeclaredId = True
 Attribute VB_Exposed = False
+
 #If VBA7 Then
     Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
     Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
@@ -52,15 +53,15 @@ Private Sub UserForm_Initialize()
 
 End Sub
 
-' 经过优化改写，勉强够用了
+' 缁忚繃浼樺寲鏀瑰啓锛屽媺寮哄�鐢ㄤ簡
 Private Sub UserForm_Activate()
-  Me.text1 = Me.text1 + "功能:按面积排列"
+  Me.text1 = Me.text1 + "鍔熻兘:鎸夐潰绉�帓鍒�"
   
   Unload VBA_FORM
   ActiveWindow.Refresh:    Application.Refresh
   DoEvents
 
-  Tools.按面积排列 50
+  Tools.鎸夐潰绉�帓鍒� 50
   
   'Close the window.
   Unload Me