cselect.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 = "CSelect"
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 CCommand

'单击鼠标左键时发生
Private Sub CCommand_LButtonDown(pPos As Position)
  Dim i As Integer
  Dim j As Integer
  Dim jj As Integer
  Dim pGElement As CGElement
  Dim pEntity2 As CGElement
  Dim intEntityNum As Integer
  Dim pLine As CLine
  Dim pPLine As CPolyLine
  Dim pCircle As CCircle
  Dim pArc As CArc
  Dim pText As CText
  'someonePicked变量用于确定是否有图元被拾取到
  Dim someonePicked As Boolean
  
  someonePicked = False
  
  DrawMain.picDraw.DrawMode = 13
  
    If lines.Count > 0 Then
      For Each pLine In lines
        Set ptLineBegin = pLine.pLineBegin
        Set ptLineEnd = pLine.pLineEnd
        Set pGElement = pLine
        '如果直线段图元被拾取到
        If pGElement.Pick(pPos, PickRadius) = True Then
          someonePicked = True
          With pGElement
            .Draw (edmDelete)
            .Draw (edmSelect)     '用选择模式绘图元
          End With
          '将图元添加到选择集SelLines中
          With pLine
            Call SelLines.Add(.geLineWidth, .geLineStyle, .geColor, .ID_Line, .pLineBegin, .pLineEnd)
          End With
          Exit Sub      '退出过程
        End If
      Next
    End If
    
    '如果someonePicked变量值为False，继续拾取
    If someonePicked = False Then
      If polylines.Count > 0 Then
        For Each pPLine In polylines
          With pPLine
            For i = 1 To .intPLinePointNum
              Set ptPLPoints(pPLine.ID_PLine, i) = .pPLPoints(pPLine.ID_PLine, i)
            Next i
          End With
          Set pGElement = pPLine
          If pGElement.Pick(pPos, PickRadius) = True Then
            someonePicked = True
            With pGElement
              .Draw (edmDelete)
              .Draw (edmSelect)
            End With
            With pPLine
              Call SelPLines.Add(.intPLinePointNum, ptPLPoints(), .geLineWidth, .geLineStyle, .geColor, .ID_PLine)
            End With
            Exit Sub
          End If
        Next
      End If
    End If
    
      
    If someonePicked = False Then
      If circles.Count > 0 Then
        For Each pCircle In circles
          Set ptCircleCenter = pCircle.pCenter
          Set ptCircleR = pCircle.pCircleR
          Set pGElement = pCircle
          If pGElement.Pick(pPos, PickRadius) = True Then
            someonePicked = True
            With pGElement
              .Draw (edmDelete)
              .Draw (edmSelect)
            End With
            With pCircle
              Call SelCircles.Add(.geLineWidth, .geLineStyle, .geColor, .pCircleR, .pCenter, .ID_Circle)
            End With
            Exit Sub
          End If
        Next
      End If
    End If
      
    If someonePicked = False Then
      If arcs.Count > 0 Then
        For Each pArc In arcs
          Set ptArcCenter = pArc.pCenter
          Set ptArcBegin = pArc.pBegin
          Set ptArcEnd = pArc.pEnd
          Set pGElement = pArc
          If pGElement.Pick(pPos, PickRadius) = True Then
            someonePicked = True
            With pGElement
             .Draw (edmDelete)
             .Draw (edmSelect)
            End With
            With pArc
              Call SelArcs.Add(.geLineWidth, .geLineStyle, .geColor, .pCenter, .pBegin, .pEnd, .ID_Arc)
            End With
            Exit Sub
          End If
        Next
      End If
    End If
  
    If someonePicked = False Then
      If texts.Count > 0 Then
        For Each pText In texts
          Set pGElement = pText
          If pGElement.Pick(pPos, PickRadius) = True Then
            someonePicked = True
            With pGElement
             .Draw (edmDelete)
             .Draw (edmSelect)
            End With
            With pText
              Call SelTexts.Add(.z, .x, .Height, .Wide, .Content, .geColor, .ID_Text)
            End With
            Exit Sub
          End If
        Next
      End If
    End If
    
End Sub

Private Sub CCommand_MouseMove(pPos As Position)

End Sub

Private Sub CCommand_RButtonDown(pPos As Position)

End Sub