VERSION 5.00
Begin VB.Form frmOpen 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "打開"
   ClientHeight    =   6810
   ClientLeft      =   2310
   ClientTop       =   750
   ClientWidth     =   7335
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6810
   ScaleWidth      =   7335
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdCancle 
      Caption         =   "確定"
      Height          =   735
      Left            =   6720
      TabIndex        =   6
      Top             =   1080
      Width           =   375
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "打開"
      Height          =   735
      Left            =   6720
      TabIndex        =   5
      Top             =   360
      Width           =   375
   End
   Begin VB.Frame Frame2 
      Caption         =   "查找范圍"
      Height          =   1935
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   7095
      Begin VB.FileListBox filFile 
         Height          =   1530
         Left            =   3960
         Pattern         =   "*.dxf"
         TabIndex        =   4
         Top             =   240
         Width           =   2535
      End
      Begin VB.DirListBox dirDir 
         Height          =   1140
         Left            =   120
         TabIndex        =   3
         Top             =   600
         Width           =   3735
      End
      Begin VB.DriveListBox drvDrive 
         Height          =   300
         Left            =   120
         TabIndex        =   2
         Top             =   240
         Width           =   3735
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "圖像預覽"
      Height          =   4575
      Left            =   120
      TabIndex        =   0
      Top             =   2160
      Width           =   7095
      Begin VB.Label lblImage 
         Alignment       =   2  'Center
         BeginProperty Font 
            Name            =   "宋體"
            Size            =   14.25
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   285
         Left            =   2280
         TabIndex        =   7
         Top             =   1920
         Width           =   2445
      End
      Begin VB.Image imgDXF 
         Height          =   4215
         Left            =   120
         Stretch         =   -1  'True
         Top             =   240
         Width           =   6780
      End
   End
End
Attribute VB_Name = "frmOpen"
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 '實體結構類型
    EName As String                   '實體類別名稱
    EDepth As Double                  '實體厚度
    ELayer As Long                    '實體層號
    ECoord() As CoordType             '實體中各點坐標
    EConvex() As Double               '弧的凸度,或半徑
    EPnum As Long                     '多線段中點的個數
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                  '圓弧包含的角度(角度制),負值表示逆時針方向旋轉
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      '保存每層圖元的第一個點的坐標
    
Dim cutWay As Long
Dim standHigh As Double
Dim cutterWidth As Double

Private Sub cmdCancle_Click()

    Unload frmOpen
    
End Sub

Private Sub cmdOK_Click()
     
    If filFile.filename = "" Then
        MsgBox "請選擇一個文件!"
    Else
        Call filFile_DblClick
    End If
    
End Sub

Private Sub dirDir_Change()
    
    filFile.Path = dirDir.Path
    
End Sub

Private Sub drvDrive_Change()
    On Error GoTo errorhandler
    
        dirDir.Path = drvDrive.Drive
        Exit Sub
        
errorhandler:
        Dim message As String
        
        If Err.Number = 68 Then
        Dim r As Integer
         
        message = "Drive is not ready"
        r = MsgBox(message, vbRetryCancel + vbCritical, "")
        
        If r = vbRetry Then
            Resume
        Else
            drvDrive.Drive = drvDrive.List(1)
            Resume Next
        End If
        
    Else
        Call MsgBox(Err.Description, vbOKOnly + vbExclamation)
        Resume Next
    End If
    
End Sub

Private Sub filFile_Click()
    Dim DXFImage As String
    DXFImage = Replace(filFile.filename, ".dxf", ".bmp")
    
    On Error GoTo errhand1
    Open DXFImage For Input As #2
    Close #2
    lblImage.Visible = False
    imgDXF.Picture = LoadPicture(DXFImage)
errhand1:
    If Err Then
        imgDXF.Picture = LoadPicture()
        lblImage.Visible = True
        lblImage.Caption = "沒有預覽圖形"
    End If
End Sub

Private Sub filFile_DblClick()
    
    
    DXFFileName = filFile.Path & "\" & filFile.filename
    
    readDXFFileToDXFFileArray
    readDXFFileArrayToEntitySectionArray
    readEntitySectionArrayToentityarray
    readentityarrayToInstructionSquence
    
    'Unload frmOpen
        
End Sub
'#############################################################################
'把DXF文件的內容讀到DXF文件數組DXFFileArray中
Private Sub readDXFFileToDXFFileArray()
    
    Dim LineNumber As Integer
    Dim Code As String
    Dim str As String
  
    Open DXFFileName 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

End Sub
'#############################################################################
'把DXF文件數組DXFFileArray中的實體段讀到實體段數組EntitySectionArray中
Private Sub readDXFFileArrayToEntitySectionArray()
    
    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()       '以便檢查段尾
        
End Sub
'#############################################################################
'把實體段數組EntitySectionArray讀到實體類型結構數組entityarray中
Private Sub readEntitySectionArrayToentityarray()
    
    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"
    
    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