123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193 |
- 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
|