VERSION 5.00
Begin VB.Form frmAnalyse 
   AutoRedraw      =   -1  'True
   Caption         =   "分析待加工文件"
   ClientHeight    =   4245
   ClientLeft      =   60
   ClientTop       =   285
   ClientWidth     =   5910
   Icon            =   "frmAnalyse.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4245
   ScaleWidth      =   5910
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdOK 
      Caption         =   "確 定"
      Height          =   375
      Left            =   4560
      TabIndex        =   2
      Top             =   3720
      Width           =   975
   End
   Begin VB.Frame Frame1 
      Caption         =   "分析信息"
      Height          =   3495
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   5655
      Begin VB.ListBox lstMsg 
         Height          =   3105
         IntegralHeight  =   0   'False
         Left            =   120
         TabIndex        =   1
         Top             =   240
         Width           =   5415
      End
   End
End
Attribute VB_Name = "frmAnalyse"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
 
Private Type CoordType  '二維坐標型
    CX As Double                      '第一坐標
    CY As Double                      '第二坐標
End Type

Private Type EntityType '實體結(jié)構(gòu)類型
    EName As String                   '實體類別名稱
    EDepth As Double                  '實體厚度
    ELayer As Long                    '實體層號
    ENum As Long
    ECoord() As CoordType             '實體中各點坐標
    EConvex() As Double               '弧的凸度,或半徑
    EPnum As Long                     '多線段中點的個數(shù)
End Type

Private Type LineType   '直線類型
    LK As Variant                     '斜率
    LB As Double                      '截距
    LBegin As CoordType               '起始端點
    LEnd As CoordType                 '末端點
End Type

Private Type ArcType    '圓弧類型
    ACentre As CoordType              '圓弧的圓心
    ABegin As CoordType               '圓弧的起點坐標
    AEnd As CoordType                 '圓弧的終點坐標
    ARadius As Double                 '圓弧的半徑
    AAngle As Double                  '圓弧包含的角度(角度制),負值表示逆時針方向旋轉(zhuǎn)
End Type

Dim DXFFileName As String
Dim DXFFileArray() As String
Dim EntitySectionArray() As String
Dim EntityArray() As EntityType
        
Private Type ScannerType '掃描器類型
    SSquence() As CoordType           '這一行掃描后得到的點序
    SAvailab As Boolean               '這一行是否掃空(有效)
    SDepth As Double                  '掃描層的厚度
    SLayer As Long                    '掃描層的層號
End Type

Private arrayCount As Long
Private arrayLines As Long

Private Last As CoordType             '保存上一次運動末的點的坐標
    
Private firPoint(1) As CoordType  '保存每層圖元縮小前后的第一個點的坐標
Private correctPoint() As CoordType

Dim AnalyseFlag As Boolean

Dim errMsg As String

Const ch1 = 1
Const ch2 = 2
Const ch3 = 3
Dim step As Long
Dim pos1 As Double
Dim pos2 As Double
Dim center1 As Double
Dim center2 As Double
Dim angle As Double

Private Sub cmdOK_Click()
    Unload frmAnalyse
End Sub

Public Function AnalyseDXFFile() As Long
    arrayCount = 0
    
    If readDXFFileToDXFFileArray = -1 Then
        lstMsg.AddItem ("分析失敗。")
        lstMsg.AddItem (errMsg)
        AnalyseDXFFile = 0
        Exit Function
    End If
    
    If readDXFFileArrayToEntitySectionArray = -1 Then
        lstMsg.AddItem ("分析失敗。")
        lstMsg.AddItem (errMsg)
        AnalyseDXFFile = 0
        Exit Function
    End If
    
    If readEntitySectionArrayToEntityArray = -1 Then
        lstMsg.AddItem ("分析失敗。")
        lstMsg.AddItem (errMsg)
        AnalyseDXFFile = 0
        Exit Function
    End If
    
    If readEntityArrayToInstructionSquence = -1 Then
        lstMsg.AddItem ("分析失敗。")
        lstMsg.AddItem (errMsg)
        AnalyseDXFFile = 0
        Exit Function
    End If
    
    If readInstructionSquenceToList = -1 Then
        lstMsg.AddItem ("分析失敗。")
        lstMsg.AddItem (errMsg)
        AnalyseDXFFile = 0
        Exit Function
    End If
    
    lstMsg.AddItem ("分析成功。")
    lstMsg.AddItem ("請檢查配置選項，確認后開始加工")
    
    AnalyseDXFFile = 1
End Function
'#############################################################################
'把DXF文件的內(nèi)容讀到DXF文件數(shù)組DXFFileArray中
Private Function readDXFFileToDXFFileArray() As Long
    
    Dim LineNumber As Long
    Dim code As String
    Dim str As String
    
    On Error GoTo rDFTDAEerrHandle

    Open frmMain.lblFilePath.Caption For Input As #1

    LineNumber = 0
    
    While code <> "EOF" And Not EOF(1)
    
        Line Input #1, str
        code = Trim(str)
                
        ReDim Preserve DXFFileArray(LineNumber)
        DXFFileArray(LineNumber) = code
        
        LineNumber = LineNumber + 1
        
    Wend
    
    Close 1
    
    readDXFFileToDXFFileArray = 0
    Exit Function
rDFTDAEerrHandle:
    errMsg = "請檢查該文件是否存在。"
    readDXFFileToDXFFileArray = -1
End Function
'#############################################################################
'把DXF文件數(shù)組DXFFileArray中的實體段讀到實體段數(shù)組EntitySectionArray中
Private Function readDXFFileArrayToEntitySectionArray() As Long
    Dim lastObj As String
    arrayCount = 0
    arrayLines = 0
    
    Dim codes As Variant
        
    codes = readTwoLines(DXFFileArray())
    While codes(1) <> "EOF"
        If codes(0) = "0" And codes(1) = "SECTION" Then
            codes = readTwoLines(DXFFileArray())
            If codes(1) = "ENTITIES" Then
                codes = readTwoLines(DXFFileArray())
                While codes(1) <> "ENDSEC"
                    If codes(0) = "0" Then
                        lastObj = codes(1)
                        addToArray codes(0) & "", EntitySectionArray()
                        addToArray lastObj, EntitySectionArray()
                    End If
                    If codes(0) <> "0" Then
                        addToArray codes(0) & "", EntitySectionArray()
                        addToArray codes(1) & "", EntitySectionArray()
                    End If
                    codes = readTwoLines(DXFFileArray())
                Wend
            End If
        Else
            codes = readTwoLines(DXFFileArray())
        End If
    Wend
    
    addToArray "0", EntitySectionArray()          '添加一組碼
    addToArray "ENDS", EntitySectionArray()       '以便檢查段尾
        
    readDXFFileArrayToEntitySectionArray = 0
End Function
'#############################################################################
'把實體段數(shù)組EntitySectionArray讀到實體類型結(jié)構(gòu)數(shù)組entityarray中
Private Function readEntitySectionArrayToEntityArray() As Long
    
    arrayCount = 0
    arrayLines = 0
    
    Dim i As Long
    Dim j As Long
    Dim ecount As Long
    Dim codes As Variant
    Dim entityNameString As String
    entityNameString = "POINT,LINE,CIRCLE,LWPOLYLINE"
    
    On Error GoTo rESATEerrHandle
    codes = readTwoLines(EntitySectionArray())
        
    While codes(1) <> "ENDS"
        If InStr(entityNameString, codes(1)) Then
            Select Case codes(1)
                Case "CIRCLE"
                    ReDim Preserve EntityArray(ecount)
                    ReDim Preserve EntityArray(ecount).ECoord(0)
                    ReDim Preserve EntityArray(ecount).EConvex(0)
                    EntityArray(ecount).EName = codes(1)
                    codes = readTwoLines(EntitySectionArray())
                    While codes(0) <> "0"
                        Select Case codes(0)
                            Case "8": EntityArray(ecount).ELayer = codes(1)        'layer
                            Case "39": EntityArray(ecount).EDepth = codes(1)       'depth
                            Case "10": EntityArray(ecount).ECoord(0).CX = codes(1) 'x
                            Case "20": EntityArray(ecount).ECoord(0).CY = codes(1) 'y
                            Case "40": EntityArray(ecount).EConvex(0) = codes(1)   'radius
                        End Select
                        codes = readTwoLines(EntitySectionArray())
                    Wend
                    ecount = ecount + 1
                Case "POINT"
                    ReDim Preserve EntityArray(ecount)
                    ReDim Preserve EntityArray(ecount).ECoord(0)
                    EntityArray(ecount).EName = codes(1)
                    codes = readTwoLines(EntitySectionArray())
                    While codes(0) <> "0"
                        Select Case codes(0)
                            Case "8": EntityArray(ecount).ELayer = codes(1)         'layer
                            Case "39": EntityArray(ecount).EDepth = codes(1)        'depth
                            Case "10": EntityArray(ecount).ECoord(0).CX = codes(1)  'x
                            Case "20": EntityArray(ecount).ECoord(0).CY = codes(1)  'y
                        End Select
                        codes = readTwoLines(EntitySectionArray())
                    Wend
                    ecount = ecount + 1
                Case "LINE"
                    ReDim Preserve EntityArray(ecount)
                    ReDim Preserve EntityArray(ecount).ECoord(1)
                    EntityArray(ecount).EName = codes(1)
                    codes = readTwoLines(EntitySectionArray())
                    While codes(0) <> "0"
                        Select Case codes(0)
                            Case "8": EntityArray(ecount).ELayer = codes(1)    'layer
                            Case "39": EntityArray(ecount).EDepth = codes(1)   'depth
                            Case "10": EntityArray(ecount).ECoord(0).CX = codes(1)      'x1
                            Case "20": EntityArray(ecount).ECoord(0).CY = codes(1)      'x2
                            Case "11": EntityArray(ecount).ECoord(1).CX = codes(1)      'x2
                            Case "21": EntityArray(ecount).ECoord(1).CY = codes(1)      'y2
                        End Select
                        codes = readTwoLines(EntitySectionArray())
                    Wend
                    ecount = ecount + 1
                Case "LWPOLYLINE"
                    ReDim Preserve EntityArray(ecount)
                    i = 0
                    EntityArray(ecount).EName = codes(1)
                    codes = readTwoLines(EntitySectionArray())
                    While codes(0) <> "0"
                        Select Case codes(0)
                            Case "8": EntityArray(ecount).ELayer = codes(1)    'layer
                            Case "90"
                                ReDim EntityArray(ecount).ECoord(codes(1) - 1)
                                ReDim EntityArray(ecount).EConvex(codes(1) - 1)
                                EntityArray(ecount).EPnum = codes(1)
                            Case "39": EntityArray(ecount).EDepth = codes(1)    'depth
                            Case "10"
                                EntityArray(ecount).ECoord(i).CX = codes(1)
                            Case "20"
                                EntityArray(ecount).ECoord(i).CY = codes(1)
                                i = i + 1
                                If (EntityArray(ecount).ECoord(i - 1).CX = EntityArray(ecount).ECoord(0).CX) _
                                    And (i <> 1) And (EntityArray(ecount).ECoord(i - 1).CY = EntityArray(ecount).ECoord(0).CY) Then
                                    EntityArray(ecount).EPnum = EntityArray(ecount).EPnum - 1
                                    ReDim Preserve EntityArray(ecount).ECoord(EntityArray(ecount).EPnum - 1)
                                    ReDim Preserve EntityArray(ecount).EConvex(EntityArray(ecount).EPnum - 1)
                                End If
                            Case "42"
                                If i <> UBound(EntityArray(ecount).EConvex) + 2 Then
                                    EntityArray(ecount).EConvex(i - 1) = codes(1)
                                End If
                        End Select
                        codes = readTwoLines(EntitySectionArray())
                    Wend
                    ecount = ecount + 1
                Case Else
                    codes = readTwoLines(EntitySectionArray())
            End Select
            
        End If
    Wend
    readEntitySectionArrayToEntityArray = 0
    Exit Function
rESATEerrHandle:
    errMsg = "文件中有未知圖元，或圖形有錯誤"
    readEntitySectionArrayToEntityArray = -1
End Function
'#############################################################################
'由層決定處理文件中各個實體的次序
Private Function readEntityArrayToInstructionSquence() As Long
    
    Dim cutTimes As Long
    Dim i As Long
    Dim j As Long
    Dim maxDepth As Double
    
        
    For i = LBound(EntityArray) To UBound(EntityArray)
        For j = i + 1 To UBound(EntityArray)
            If EntityArray(j).ELayer <> 0 And EntityArray(j).ELayer = EntityArray(i).ELayer Then
                lstMsg.AddItem ("有相同的非零圖層號 " & EntityArray(i).ELayer & " " & EntityArray(i).EName & ",請檢查圖紙")
                readEntityArrayToInstructionSquence = -1
                Exit Function
            End If
        Next j
    Next i

    
    ReDim correctPoint(UBound(EntityArray)) As CoordType
    
    If cutterWidth = 0 Then
        errMsg = "請設(shè)置刀寬。"
        readEntityArrayToInstructionSquence = -1
        Exit Function
    End If
    
    For i = LBound(EntityArray) To UBound(EntityArray)
        EntityArray(i).ENum = i
    Next i
        
    If cutTwoTimes = 0 Then
        cutTimes = 0
    Else
        cutTimes = 1