更新修正

Form/LinesForm.frm

@@ -1,7 +1,7 @@
 VERSION 5.00
 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} LinesForm 
    Caption         =   "LinesForm"
-   ClientHeight    =   1620
+   ClientHeight    =   2430
    ClientLeft      =   45
    ClientTop       =   390
    ClientWidth     =   4680
@@ -13,10 +13,10 @@ Attribute VB_GlobalNameSpace = False
 Attribute VB_Creatable = False
 Attribute VB_PredeclaredId = True
 Attribute VB_Exposed = False
+
 '// This is free and unencumbered software released into the public domain.
 '// For more information, please refer to  https://github.com/hongwenjun
 
-<<<<<<< HEAD
 '// 插件名称 VBA_UserForm
 Private Const TOOLNAME As String = "LYVBA"
 Private Const SECTION As String = "LinesForm"
@@ -46,8 +46,6 @@ Sub saveFormPos(bDoSave As Boolean)
   End If
 End Sub
 
-=======
->>>>>>> 06150b8661ccde06bd8f1e2522c77ce48be72b83
 Private Sub MyPen_Click()
 On Error GoTo ErrorHandler
   API.BeginOpt
@@ -58,11 +56,7 @@ End Sub
 
 
 '// 左键右键Ctrl三键控制
-<<<<<<< HEAD
 Private Sub PenDrawLines_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
-=======
-Private Sub PenDrawLines_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
->>>>>>> 06150b8661ccde06bd8f1e2522c77ce48be72b83
 On Error GoTo ErrorHandler
   API.BeginOpt
   If Button = 2 Then
@@ -159,6 +153,13 @@ Private Sub Move_Up_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, B
   End If
 End Sub
 
+'// 测量标尺和水平尺
+Private Sub Ruler_Measuring_BT_Click()
+  '// 角度转平
+  Angle_to_Horizon
+End Sub
+
+'// 选择的物件平均距离
 Private Sub Average_Distance_BT_Click()
   Average_Distance
 End Sub
@@ -166,3 +167,27 @@ End Sub
 Private Sub chkAutoDistribute_Click()
   AutoDistribute_Key = chkAutoDistribute.Value
 End Sub
+
+'// 镜像工具
+Private Sub MirrorLine_Click()
+  Mirror_ByGuide
+End Sub
+
+'// 平行线工具 CTRL 键设置距离
+Private Sub ParallelLines_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
+  Dim sp As Double
+  text = GlobalUserData("SpaceWidth", 1)
+  sp = Val(text)
+  If Button = 2 Then   '// 右键的代码
+    Create_Parallel_Lines -sp
+  ElseIf Shift = fmCtrlMask Then     '// 左键的代码
+    Create_Parallel_Lines sp
+  Else    '// CTRL的代码
+    Create_Parallel_Lines Set_Space_Width
+  End If
+End Sub
+
+'// 标记镜像参考线
+Private Sub Set_Guide_Click()
+  Set_Guides_Name
+End Sub

Form/lines.bas

@@ -1,99 +0,0 @@
-Attribute VB_Name = "lines"
-'// This is free and unencumbered software released into the public domain.
-'// For more information, please refer to  https://github.com/hongwenjun
-
-Sub start()
-  LinesForm.Show 0
-End Sub
-
-Public Function Nodes_DrawLines()
-  Dim sr As ShapeRange, sr_tmp As New ShapeRange, sr_lines As New ShapeRange
-  Dim s As Shape, sh As Shape
-  Dim nr As NodeRange
-  Set sr = ActiveSelectionRange
-  If sr.Count = 0 Then Exit Function
-  
-  For Each sh In sr
-    Set nr = sh.Curve.Selection
-    If nr.Count > 0 Then
-      For Each n In nr
-        Set s = ActiveLayer.CreateEllipse2(n.PositionX, n.PositionY, 0.5, 0.5)
-        sr_tmp.Add s
-      Next n
-    End If
-  Next sh
-  
-  '// 没有选择节点的情况，使用物件中心划线
-  If sr_tmp.Count < 2 And sr.Count > 1 Then
-    Set Line = DrawLine(sr(1), sr(2))
-    sr_lines.Add Line
-  End If
-
-#If VBA7 Then
-    sr_tmp.Sort "@shape1.left < @shape2.left"
-#Else
-    Set sr_tmp = X4_Sort_ShapeRange(sr_tmp, stlx)
-#End If
-
-  '// 使用 Count 遍历 shaperange 这种情况方便点
-  For i = 1 To sr_tmp.Count - 1
-    Set Line = DrawLine(sr_tmp(i), sr_tmp(i + 1))
-    sr_lines.Add Line
-  Next
-  
-  sr_tmp.Delete
-  sr_lines.CreateSelection
-End Function
-
-Public Function Draw_Multiple_Lines(hv As cdrAlignType)
-  Dim sr As ShapeRange, sr_lines As New ShapeRange
-  Set sr = ActiveSelectionRange
-  
-  If sr.Count < 2 Then Exit Function
-  
-#If VBA7 Then
-  If hv = cdrAlignVCenter Then
-    '// 从左到右排序
-    sr.Sort "@shape1.left < @shape2.left"
-  ElseIf hv = cdrAlignHCenter Then
-    '// 从上到下排序
-    sr.Sort "@shape1.top < @shape2.top"
-  End If
-#Else
-  '// X4_Sort_ShapeRange for CorelDRAW X4
-  If hv = cdrAlignVCenter Then
-    Set sr = X4_Sort_ShapeRange(sr, stlx)
-  ElseIf hv = cdrAlignHCenter Then
-    Set sr = X4_Sort_ShapeRange(sr, stty)
-  End If
- 
-#End If
-
-  For i = 1 To sr.Count - 1 Step 2
-    Set Line = DrawLine(sr(i), sr(i + 1))
-    sr_lines.Add Line
-  Next
- 
-  sr_lines.CreateSelection
-End Function
-
-Public Function FirtLineTool()
-  Dim sr As ShapeRange
-  Set sr = ActiveSelectionRange
-  If sr.Count > 1 Then
-    Set Line = DrawLine(sr(1), sr(2))
-  End If
-End Function
-
-Private Function DrawLine(ByVal s1 As Shape, ByVal s2 As Shape) As Shape
-'// 创建线段方法在图层上的指定位置创建由单个线段组成的曲线。
- Set DrawLine = ActiveLayer.CreateLineSegment(s1.CenterX, s1.CenterY, s2.CenterX, s2.CenterY)
-
-End Function
-
-Private Sub Test()
-  ActiveDocument.Unit = cdrMillimeter
-  Set Rect = ActiveLayer.CreateRectangle(0, 0, 30, 30)
-  Set ell = ActiveLayer.CreateEllipse2(50, 50, 10, 10)
-  Set Line = DrawLine(Rect, ell)
-End Sub

README.md

@@ -32,7 +32,7 @@
 - 平线线功能
 ![](https://github.com/hongwenjun/vbabox/blob/main/img/Paralle.gif)
 
---
+----
 ## CorelDRAW VBA 插件 简易的长宽高盒子插件和源码和步骤原理
 
 https://www.bilibili.com/video/BV1MF411f7qu/