EXCEL VBA读取DXF文件

因业务要求，需要读取DXF文件

开发环境：Excel 2013

Option Explicit
    
Dim dxfFile As String

Dim linesCount As Integer
'Start Point(x,y)、End Point(x,y)
'Parameters count: 4 Double
Dim Lines()

Dim circlesCount As Integer
'Arc Center(x,y)、Radius
'Parameters count: 3 Double
Dim Circles()

Dim arcsCount As Integer
'Arc Center(x,y)、Radius、StartAngle、EndAngle
'Parameters count: 5 Double
Dim Arcs()
    

'redim 将数组的数值也初始化了
Sub GetDXFEntities(ByVal maxCount As Integer)
    ReDim Lines(maxCount, 4) As Variant
    ReDim Circles(maxCount, 3) As Variant
    ReDim Arcs(maxCount, 5) As Variant

    linesCount = 0
    circlesCount = 0
    arcsCount = 0

    Dim strSection As String
    
    dxfFile = "input.dxf"
    strSection = "ENTITIES"
    
    Dim lastObj As String
    
    linesCount = 0
    
    Dim codes As Variant
    
    Open dxfFile For Input As #1
    ' 获取第一个代码/值对
    codes = ReadCodes()
    ' 遍历整个文件，直到“EOF”行
    While codes(1) <> "EOF"
        ' 如果组码为“0”，并且值为“SECTION”，则
        If codes(0) = "0" And codes(1) = "SECTION" Then
            ' 这必须是一个新的段，以便获取下一个代码/值对。
            codes = ReadCodes()
            ' 如果此段是要获取的段，则
            If codes(1) = strSection Then
                ' 获取下一个代码/值对，并
                codes = ReadCodes()
                ' 遍历此段，直到“ENDSEC”
                While codes(1) <> "ENDSEC"
                    ' 在某一段中，所有的“0”代码都表示对象。如果找到了“0”代码，则存储
                    ' 对象名称，供以后使用。
                    If codes(0) = "0" Then lastObj = codes(1)
                    ' 如果此对象是用户所需的对象，
                    If lastObj = "LINE" Then
                        If codes(0) = 5 Then
                            linesCount = linesCount + 1
                        ElseIf codes(0) = 10 Then
                            Lines(linesCount, 1) = codes(1)
                        ElseIf codes(0) = 20 Then
                            Lines(linesCount, 2) = codes(1)
                        ElseIf codes(0) = 11 Then
                            Lines(linesCount, 3) = codes(1)
                        ElseIf codes(0) = 21 Then
                            Lines(linesCount, 4) = codes(1)
                        End If
                    ElseIf lastObj = "CIRCLE" Then
                        If codes(0) = 5 Then
                            circlesCount = circlesCount + 1
                        ElseIf codes(0) = 10 Then
                            Circles(circlesCount, 1) = codes(1)
                        ElseIf codes(0) = 20 Then
                            Circles(circlesCount, 2) = codes(1)
                        ElseIf codes(0) = 40 Then
                            Circles(circlesCount, 3) = codes(1)
                        End If
                    ElseIf lastObj = "ARC" Then
                        If codes(0) = 5 Then
                            arcsCount = arcsCount + 1
                        ElseIf codes(0) = 10 Then
                            Arcs(arcsCount, 1) = codes(1)
                        ElseIf codes(0) = 20 Then
                            Arcs(arcsCount, 2) = codes(1)
                        ElseIf codes(0) = 40 Then
                            Arcs(arcsCount, 3) = codes(1)
                        ElseIf codes(0) = 50 Then
                            Arcs(arcsCount, 4) = codes(1)
                        ElseIf codes(0) = 51 Then
                            Arcs(arcsCount, 5) = codes(1)
                        End If
                    End If
                    ' 读取其他代码/值对
                    codes = ReadCodes()
                Wend
            End If
        Else
            codes = ReadCodes()
        End If
    Wend
    Close #1
    
End Sub


' ReadCodes 从打开的文件中读取两行，并返回一个包含两个项目的数组、一个组码及其组码值。只要一次读取 DXF 文件中的两行代码，
' 所有程序应该都能够顺利运行。但为了使代码更可靠，应该添加一些进行错误检查和其他检查的代码。
Function ReadCodes() As Variant
    Dim codeStr, valStr As String
    Line Input #1, codeStr
    Line Input #1, valStr
    ' 修剪代码中的前导空格和后续空格
    ReadCodes = Array(Trim(codeStr), valStr)
End Function