cpolyline.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 = "CPolyLine"
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
Implements CGElement

Private m_geColor As Double
Private m_geLineStyle As LineStyle
Private m_geLineWidth As Double
Private m_intPLinePointNum As Integer
Private m_pPLPoints(1 To 100, 1 To 100) As Position
Private m_ID_PLine As Integer

'写ID_PLine属性
Public Property Let ID_PLine(ByVal vData As Integer)
    m_ID_PLine = vData
End Property

'读ID_PLine属性
Public Property Get ID_PLine() As Integer
    ID_PLine = m_ID_PLine
End Property

'写geColor属性
Public Property Let geColor(ByVal RHS As Double)
  m_geColor = RHS
End Property

'读geColor属性
Public Property Get geColor() As Double
  geColor = m_geColor
End Property

'写geLlineStyle属性
Public Property Let geLineStyle(ByVal RHS As LineStyle)
  m_geLineStyle = RHS
End Property

'读geLineStyle属性
Public Property Get geLineStyle() As LineStyle
  geLineStyle = m_geLineStyle
End Property

'写geLineWidth属性
Public Property Let geLineWidth(ByVal RHS As Double)
  m_geLineWidth = RHS
End Property

'读geLineWidth属性
Public Property Get geLineWidth() As Double
  geLineWidth = m_geLineWidth
End Property

'写pPLPoints属性
Public Property Set pPLPoints(ByVal plindex As Integer, ByVal pindex As Integer, ByVal vData As Position)
    Set m_pPLPoints(plindex, pindex) = vData
End Property

'读pPLPoints属性
Public Property Get pPLPoints(ByVal plindex As Integer, ByVal pindex As Integer) As Position
    Set pPLPoints = m_pPLPoints(plindex, pindex)
End Property

'写intPinePointNum属性
Public Property Let intPLinePointNum(ByVal vData As Integer)
    m_intPLinePointNum = vData
End Property

'读intPLinePointNum属性
Public Property Get intPLinePointNum() As Integer
    intPLinePointNum = m_intPLinePointNum
End Property

'根据指定的绘图模式绘多义线
Private Sub CGElement_Draw(eDrawMode As GEDrawMode)
  Dim i As Integer
  Dim pen As Double
  Dim n As Integer
  Dim point1 As New Position
  Dim point2 As New Position
  
  '定义线宽
  m_geLineWidth = 1
  '根据绘图模式定义线型和颜色
  Select Case eDrawMode
    Case edmNormal
      m_geLineStyle = vbSolid
      m_geColor = RGB(0, 0, 0)     '正常模式下，黑色
    Case edmSelect
      m_geLineStyle = vbDash
      m_geColor = RGB(255, 0, 0)   '选择模式下，红色
    Case edmDelete                    '删除模式下，用绘图环境的底色重画
      m_geLineStyle = vbSolid
      m_geColor = GetBkColor(DrawMain.picDraw.hdc)
  End Select
    
  '设置图片框的绘图属性
  With DrawMain.picDraw
    .DrawStyle = m_geLineStyle
    .DrawWidth = m_geLineWidth
    .ForeColor = m_geColor
  End With
  
  '利用VB的Line方法将多义线的各个顶点依次连线
  For i = 1 To m_intPLinePointNum - 1
    Set point1 = m_pPLPoints(m_ID_PLine, i)
    Set point2 = m_pPLPoints(m_ID_PLine, i + 1)
    DrawMain.picDraw.Line (point1.z, point1.x)-(point2.z, point2.x)
  Next i
End Sub

'获取多义线的包围矩形
Private Sub CGElement_GetBox(pBox As Box)
  Dim z1 As Double, x1 As Double
  Dim z2 As Double, x2 As Double
  Dim i As Integer
  
  '用第一个顶点的坐标给x1,x2,y1,y2赋初值
  With m_pPLPoints(m_ID_PLine, 1)
    z1 = .z
    z2 = .z
    x1 = .x
    x2 = .x
  End With
  '遍历所有顶点，找到最小的横坐标、纵坐标和最大的
  '横坐标和纵坐标，并赋给z1,z2,x1和x2
  For i = 2 To m_intPLinePointNum
    With m_pPLPoints(m_ID_PLine, i)
      z1 = min(z1, .z)
      x1 = min(x1, .x)
      z2 = max(z2, .z)
      x2 = max(x2, .x)
    End With
  Next i
  '设置包围矩形的属性
  pBox.minZ = z1 - PickRadius
  pBox.maxZ = z2 - PickRadius
  pBox.minX = x1 + PickRadius
  pBox.maxX = x2 + PickRadius
End Sub


Private Property Let CGElement_ID(ByVal RHS As Integer)

End Property

Private Property Get CGElement_ID() As Integer

End Property

'对多义线进行镜像变换
Private Sub CGElement_Mirror(Pos1 As Position, Pos2 As Position)
  Dim i As Integer
  Dim point As Position
  Dim MirroredPoints(1 To 100) As New Position
  
  For i = m_intPLinePointNum To 1 Step -1
    Set point = m_pPLPoints(m_ID_PLine, i)
    Set point = point.pntMirror(Pos1, Pos2)
    Set MirroredPoints(i) = point
  Next i
  For i = 1 To m_intPLinePointNum
    Set m_pPLPoints(m_ID_PLine, i) = MirroredPoints(i)
  Next i
End Sub

Private Sub CGElement_Move(basePos As Position, desPos As Position)
  Dim zz As Double, xx As Double
  Dim i As Integer
  Dim point As New Position
  Dim MoveedPoints(1 To 100) As New Position
  
  zz = desPos.z - basePos.z
  xx = desPos.x - basePos.x
  For i = m_intPLinePointNum To 1 Step -1
    Set point = m_pPLPoints(m_ID_PLine, i)
    Set point = point.pntMove(zz, xx)
    Set MoveedPoints(i) = point
  Next i
  For i = 1 To m_intPLinePointNum
    Set m_pPLPoints(m_ID_PLine, i) = MoveedPoints(i)
  Next i
End Sub
Private Sub CGElement_Moveonly()
  Dim i As Integer
  Dim point As New Position
  Dim MoveedPoints(1 To 100) As New Position
  For i = m_intPLinePointNum To 1 Step -1
    Set point = m_pPLPoints(m_ID_PLine, i)
    Set point = point.pntMove(100, 0)
    Set MoveedPoints(i) = point
  Next i
  For i = 1 To m_intPLinePointNum
    Set m_pPLPoints(m_ID_PLine, i) = MoveedPoints(i)
  Next i
End Sub
Private Function CGElement_Pick(pos As Position, PickRadius As Double) As Boolean
  Dim i As Integer
  Dim objPos As New Position
  Dim sourceBox As New Box
  Dim line As New CLine
  
  With objPos
    .z = pos.z
    .x = pos.x
  End With
  Call CGElement_GetBox(sourceBox)
  If (Not InBox(sourceBox, objPos)) Then
    CGElement_Pick = False
  Else
    For i = 1 To m_intPLinePointNum - 1
      With line
        Set .pLineBegin = m_pPLPoints(m_ID_PLine, i)
        Set .pLineEnd = m_pPLPoints(m_ID_PLine, i + 1)
      End With
      If distPtoL(objPos, line) <= PickRadius * 1000 / scale1 Then
        CGElement_Pick = True
        Exit Function
      Else
        CGElement_Pick = False
      End If
    Next i
  End If
End Function

Private Sub CGElement_Rotate(basePos As Position, Angle As Double)
  Dim i As Integer
  Dim point As Position
  Dim RotatedPoints(1 To 100) As New Position
  
  For i = m_intPLinePointNum To 1 Step -1
    Set point = m_pPLPoints(m_ID_PLine, i)
    Set point = point.pntRotate(basePos, Angle)
    Set RotatedPoints(i) = point
  Next i
  For i = 1 To m_intPLinePointNum
    Set m_pPLPoints(m_ID_PLine, i) = RotatedPoints(i)
  Next i
End Sub


Private Sub CGElement_ScaleTransform(scalez As Double, scalex As Double)
  Dim i As Integer
  Dim point As New Position
  Dim ScaledPoints(1 To 100) As New Position
  
  For i = m_intPLinePointNum To 1 Step -1
    Set point = m_pPLPoints(m_ID_PLine, i)
    Set point = point.pntScale(scalez, scalex)
    Set ScaledPoints(i) = point
  Next i
  For i = 1 To m_intPLinePointNum
    Set m_pPLPoints(m_ID_PLine, i) = ScaledPoints(i)
  Next i
End Sub