VERSION 5.00 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} LinesForm Caption = "LinesForm" ClientHeight = 2430 ClientLeft = 45 ClientTop = 390 ClientWidth = 4680 OleObjectBlob = "LinesForm.frx":0000 StartUpPosition = 1 '所有者中心 End Attribute VB_Name = "LinesForm" 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 '// 插件名称 VBA_UserForm Private Const TOOLNAME As String = "LYVBA" Private Const SECTION As String = "LinesForm" '// 用户窗口初始化 Private Sub UserForm_Initialize() With Me .StartUpPosition = 0 .Left = Val(GetSetting(TOOLNAME, SECTION, "form_left", 900)) .Top = Val(GetSetting(TOOLNAME, SECTION, "form_top", 200)) End With End Sub '// 关闭窗口时保存窗口位置 Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) saveFormPos True End Sub '// 保存窗口位置和加载窗口位置 Sub saveFormPos(bDoSave As Boolean) If bDoSave Then 'save position SaveSetting TOOLNAME, SECTION, "form_left", Me.Left SaveSetting TOOLNAME, SECTION, "form_top", Me.Top End If End Sub Private Sub MyPen_Click() On Error GoTo ErrorHandler API.BeginOpt lines.Nodes_DrawLines ErrorHandler: API.EndOpt End Sub '// 左键右键Ctrl三键控制 Private Sub PenDrawLines_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single) On Error GoTo ErrorHandler API.BeginOpt If Button = 2 Then lines.Draw_Multiple_Lines cdrAlignVCenter ElseIf Shift = fmCtrlMask Then lines.Draw_Multiple_Lines cdrAlignHCenter Else lines.Draw_Multiple_Lines 0 End If ErrorHandler: API.EndOpt End Sub '''//// 傻瓜火车排列 ////''' Private Sub TOP_ALIGN_BT_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single) If Button = 2 Then Tools.Simple_Train_Arrangement 3# ElseIf Shift = fmCtrlMask Then Tools.Simple_Train_Arrangement 0# Else Tools.Simple_Train_Arrangement Set_Space_Width End If End Sub '''//// 傻瓜阶梯排列 ////''' Private Sub LEFT_ALIGN_BT_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single) If Button = 2 Then Tools.Simple_Ladder_Arrangement 3# ElseIf Shift = fmCtrlMask Then Tools.Simple_Ladder_Arrangement 0# Else Tools.Simple_Ladder_Arrangement Set_Space_Width End If End Sub Private Sub MakeBox_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single) On Error GoTo ErrorHandler API.BeginOpt Dim size As Variant size = input_box_lwh l = size(0): w = size(1): h = size(2): b = size(3) If b = 0 Then b = 15 If Button = 2 Then box.Simple_box_five l, w, h, b ElseIf Shift = fmCtrlMask Then box.Simple_box_four l, w, h, b Else box.Simple_box_three l, w, h, b End If ErrorHandler: API.EndOpt End Sub Private Sub Cmd_3D_Click() box.Simple_3Deffect End Sub '// 角度和旋转工具, 左键左转,右键右转 Private Sub Rotate_Shapes_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single) If Button = 2 Then '// 右键的代码 Shapes_Rotate -90 ElseIf Shift = fmCtrlMask Then '// 左键的代码 Shapes_Rotate 90 Else '// CTRL的代码 Shapes_Rotate -45 End If End Sub '// 移动和再制,我们来制作三键控制,左键只移动,右键是反方向,按CTRL 是复制的 Private Sub Move_Left_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single) If Button = 2 Then '// 右键的代码 move_shapes 100, 0 ElseIf Shift = fmCtrlMask Then '// 左键的代码 move_shapes -100, 0 Else '// CTRL的代码 Duplicate_shapes -100, 0 End If End Sub Private Sub Move_Up_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single) If Button = 2 Then '// 右键的代码 move_shapes 0, -100 ElseIf Shift = fmCtrlMask Then '// 左键的代码 move_shapes 0, 100 Else '// CTRL的代码 Duplicate_shapes 0, 100 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 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