Chen8013进来帮个忙哦。。麻烦了哈！~

Question

额~又来麻烦了哈~
啊能帮忙把你那程序稍微修改下？就是调用DXF的ENTITIES段改成调用ENTITIES段内的POLYLINE（多线段）段。
谢谢~
材料我发给你了~

Answer 1

我在2楼给你发的邮件只修改了这个函数，替换一下：
Function ResetPoint(ByVal strFile$) As Long
    
    Dim strSave$(), dVertex#(10), lBufSize&
    Dim lEndLine&, lRefOffset&, lPolyOffset&, lFlag&
    Dim dKa#, dKb#, dOx#, dOy#, dNx#, dNy#, dDist#
    Dim i&, lPnt&, strTemp$, iFileNum%
    
    On Error GoTo ErrExit
    lFlag = 1: lPnt = 0: lBufSize = 1024
    ReDim strSave(lBufSize)
    iFileNum = FreeFile()
    Open strFile For Input As #iFileNum
    Do While (Not EOF(iFileNum))
        Line Input #iFileNum, strTemp
        lPnt = lPnt + 1
        If (lPnt > lBufSize) Then
            lBufSize = lBufSize + 256
            ReDim Preserve strSave(lBufSize)
        End If
        strSave(lPnt) = strTemp
    Loop
    For i = 1 To lPnt
        If (strSave(i) = "ENTITIES") Then Exit For
    Next
    If (i > lPnt) Then Error 17
    For i = i To lPnt
        If (strSave(i) = "POLYLINE") Then Exit For
    Next
    If (i > lPnt) Then
        Error 17
    Else
        lPolyOffset = i
    End If
    lFlag = 2: Close #iFileNum
    lEndLine = lPnt: lRefOffset = i + 70
    Do
        For i = lPolyOffset + 14 To lRefOffset Step 12
            If (strSave(i) <> "VERTEX") Then lFlag = 3: Exit Do
        Next
    Loop While (0)
    If (lFlag = 3) Then Error 17
    lPnt = 0
    For i = lPolyOffset + 20 To lRefOffset Step 12
        lPnt = lPnt + 1: dVertex(lPnt) = Val(strSave(i))
        lPnt = lPnt + 1: dVertex(lPnt) = Val(strSave(i + 2))
    Next
    For i = 1 To 10
        Debug.Print i, dVertex(i)
    Next
    '闭合校验
    If (Abs(dVertex(1) - dVertex(9)) > 0.0000000001) Then lFlag = 4
    If (Abs(dVertex(2) - dVertex(10)) > 0.0000000001) Then lFlag = 4
    If (lFlag = 4) Then Error 17
    '直角验证
    Do
        dKa = dVertex(5) - dVertex(1)
        dKb = dVertex(6) - dVertex(2)
        dDist = dKa * dKa + dKb * dKb
        dOx = dVertex(3) - dVertex(1)
        dOy = dVertex(4) - dVertex(2)
        dNx = dVertex(5) - dVertex(3)
        dNy = dVertex(6) - dVertex(4)
        dKa = dOx * dOx + dOy * dOy + dNx * dNx + dNy * dNy
        If (Abs(dKa - dDist) > 0.0000001) Then Exit Do
        lFlag = lFlag Or 4
        dOx = dVertex(5) - dVertex(7)
        dOy = dVertex(6) - dVertex(8)
        dNx = dVertex(1) - dVertex(7)
        dNy = dVertex(2) - dVertex(8)
        dKa = dOx * dOx + dOy * dOy + dNx * dNx + dNy * dNy
        If (Abs(dKa - dDist) > 0.000001) Then Exit Do
        lFlag = lFlag Or 8
        dKa = dVertex(3) - dVertex(7)
        dKb = dVertex(4) - dVertex(8)
        dDist = dKa * dKa + dKb * dKb
        dOx = dVertex(3) - dVertex(1)
        dOy = dVertex(4) - dVertex(2)
        dKa = dOx * dOx + dOy * dOy + dNx * dNx + dNy * dNy
        If (Abs(dKa - dDist) > 0.000001) Then Exit Do
        lFlag = lFlag Or 16
        dOx = dVertex(5) - dVertex(7)
        dOy = dVertex(6) - dVertex(8)
        dNx = dVertex(3) - dVertex(5)
        dNy = dVertex(4) - dVertex(6)
        dKa = dOx * dOx + dOy * dOy + dNx * dNx + dNy * dNy
        If (Abs(dKa - dDist) > 0.000001) Then Exit Do
        lFlag = lFlag Or 32: Exit Do
    Loop
    If ((lFlag And &H3C) = 60) Then ResetPoint = 1&: Exit Function
    '重定位
    dKa = (dVertex(6) - dVertex(2)) / (dVertex(5) - dVertex(1))
    dKb = (dVertex(4) - dVertex(8)) / (dVertex(3) - dVertex(7))
    dOx = (dKa * dVertex(1) - dKb * dVertex(7) + dVertex(8) - dVertex(2)) / (dKa - dKb)
    dOy = (dOx - dVertex(1)) * dKa + dVertex(2)
    dNx = dOx - dVertex(1)
    dNy = dOy - dVertex(2)
    dDist = dNx * dNx + dNy * dNy
    dVertex(5) = dOx + dOx - dVertex(1)
    dVertex(6) = dOy + dOy - dVertex(2)
    dNx = Sqr(dDist / (dKb * dKb + 1))
    dNy = dNx * dKb
    dVertex(3) = dOx + dNx
    dVertex(4) = dOy + dNy
    dVertex(7) = dOx - dNx
    dVertex(8) = dOy - dNy
    lPnt = 2
    For i = lPolyOffset + 32 To lRefOffset Step 12
        lPnt = lPnt + 1: strSave(i) = CStr(dVertex(lPnt))
        lPnt = lPnt + 1: strSave(i + 2) = CStr(dVertex(lPnt))
    Next
    iFileNum = FreeFile()
    Open strFile For Output As #iFileNum
    For i = 1 To lEndLine
        Print #iFileNum, strSave(i)
    Next
    Close #iFileNum    ResetPoint = 0
    Exit Function
ErrExit:
    Close #iFileNum
    ResetPoint = -1&
End Function

Answer 2

可是发给你的包含2个四边形DXF文件内已经没有POLYLINE段了，而是LWPOLYLINE段。。