⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 position.cls

📁 数控自动编程系统
💻 CLS
字号:
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Position"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit
Private m_z As Double
Private m_x As Double

Public Property Let z(ByVal vData As Double)
    m_z = vData
End Property

Public Property Get z() As Double
    z = m_z
End Property

Public Property Let x(ByVal vData As Double)
    m_x = vData
End Property

Public Property Get x() As Double
    x = m_x
End Property

Public Function pntMirror(pntPos1 As Position, pntPos2 As Position) As Position
  Dim pMirror As New Position
  Dim Angle As Double
  Dim cos2v As Double, sin2v As Double
  Dim z1 As Double, x1 As Double
  Dim z2 As Double, x2 As Double
  Dim aa As Double
  Dim desZ As Double, desX As Double
  With pntPos1
    z1 = .z
    x1 = .x
  End With
  With pntPos2
    z2 = .z
    x2 = .x
  End With
  If z2 = z1 Then
    aa = 1000000
  Else
    aa = (z2 * x1 - z1 * x2) / (z2 - z1)
  End If
  Angle = GetAngle(pntPos1, pntPos2)
  cos2v = Cos(Angle * 2)
  sin2v = Sin(Angle * 2)
  desZ = m_z * cos2v + m_x * sin2v - aa * sin2v
  desX = m_z * sin2v - m_x * cos2v + aa * cos2v + aa
  With pMirror
    .z = desZ
    .x = desX
  End With
  Set pntMirror = pMirror
End Function

Public Function pntRotate(basePos As Position, Angle As Double) As Position
  Dim cosv As Double
  Dim sinv As Double
  Dim zc As Double
  Dim xc As Double
  Dim pRotate As New Position
  
  cosv = Cos(Angle)
  sinv = Sin(Angle)
  With pRotate
    .z = m_z * cosv - m_x * sinv + (1 - cosv) * basePos.z + basePos.x * sinv
    .x = sinv * m_z + cosv * m_x + (1 - cosv) * basePos.x - sinv * basePos.z
  End With
  Set pntRotate = pRotate
End Function

Public Function pntMove(zz As Double, xx As Double) As Position
  Dim pMove As New Position
  With pMove
    .z = m_z + zz
    .x = m_x + xx
  End With
  Set pntMove = pMove
End Function
Public Function pntScale(scalez As Double, scalex As Double) As Position
  Dim pScale As New Position
  With pScale
    .z = scalez * m_z
    .x = scalex * m_x
  End With
  Set pntScale = pScale
End Function

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -