基本信息

---

下载

   友情提示：（无需注册或充值，赞助后即可获取资源下载链接）

---

     嘿，亲！知识可是无价之宝呢，但咱这精心整理的资料也耗费了不少心血呀。小小地破费一下，绝对物超所值哦！如有下载和支付问题，请联系我们QQ(微信同号)：78630559

本次赞助数额为： 5 元　

支付宝支付

微信支付

   源码介绍

---

本程序只能读取圆心图形，所以在画CAD时候都画出圆，参照文件中的Circle.dxf一样

Imports System.Drawing
Public Class Form1
    Dim MyDXF As DXFData

    Public path1 As String
    Public fileName1 As String

    Dim m_iCircleNums As Long
    Dim m_iLineNums As Long
    Dim m_arrayX() As Double
    Dim m_arrayY() As Double
    Dim m_arrayR() As Double
    Dim m_bIsFinish() As Boolean

    Dim tranX, tranY, tranR As Integer
    Dim scaleX, scaleY, scaleR As Double

    Dim b As Bitmap
    Dim g As Graphics
    Dim p As Pen
    Dim bs As SolidBrush

    Private Sub Form1_Disposed(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Disposed
        b.Dispose()
        p.Dispose()
        bs.Dispose()
    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        b = New Bitmap(PictureBox1.Width, PictureBox1.Height)
        g = Graphics.FromImage(b)
        p = New Pen(System.Drawing.Color.Blue)
        bs = New SolidBrush(System.Drawing.Color.Green)
    End Sub
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        Dim openFileDig As New OpenFileDialog
        openFileDig.DefaultExt = "*.txt;*.rtf "
        openFileDig.Filter = "dxf文件   格式(*.dxf)|*.dxf|所有文件(*.*)|*.* "
        If openFileDig.ShowDialog() = DialogResult.OK Then
            Dim fileName As String = System.IO.Path.GetFileNameWithoutExtension(openFileDig.FileName)
            Dim path As String = System.IO.Path.GetPathRoot(openFileDig.FileName)
            Dim fullPath As String = openFileDig.FileName
            fileName1 = fileName
            path1 = fullPath
            Me.ListBox1.Items.Add(fileName)

            ghPath.Reset()
            bmp = New Bitmap(Me.Width, Me.Height)
            ' picDXF.Image = bmp

            ImportDXF(path1, MyDXF)
            ' RedrawPic()
            On Error Resume Next
            Me.ListBox2.Items.Clear()
            Dim i As Short
            Dim j As Short
            Dim k As Short

            For i = 0 To UBound(MyDXF.Blocks)
                Me.ListBox2.Items.Add("-" & MyDXF.Blocks(i).Name)
                For j = 0 To UBound(MyDXF.Blocks(i).Entities)
                    Me.ListBox2.Items.Add("--" & MyDXF.Blocks(i).Entities(j).Type)
                    For k = 0 To UBound(MyDXF.Blocks(i).Entities(j).Data)
                        Me.ListBox2.Items.Add("---" & MyDXF.Blocks(i).Entities(j).Data(k).Key & "  = " & MyDXF.Blocks(i).Entities(j).Data(k).Value)
                    Next k
                Next j
            Next i

            Me.ListBox2.Items.Add("--------------")
            '实体个数
            m_iCircleNums = UBound(MyDXF.Entities)
            ReDim m_arrayX(m_iCircleNums)
            ReDim m_arrayY(m_iCircleNums)
            ReDim m_arrayR(m_iCircleNums)
            ReDim m_bIsFinish(m_iCircleNums)

            For i = 0 To UBound(MyDXF.Entities)
                Me.ListBox2.Items.Add("PV -" & MyDXF.Entities(i).Type)
                For k = 0 To UBound(MyDXF.Entities(i).Data)
                    Me.ListBox2.Items.Add("---" & MyDXF.Entities(i).Data(k).Key & "   = " & MyDXF.Entities(i).Data(k).Value)
                Next k
                m_arrayX(i) = MyDXF.Entities(i).Data(0).Value
                m_arrayY(i) = MyDXF.Entities(i).Data(1).Value
                m_arrayR(i) = MyDXF.Entities(i).Data(2).Value
                m_bIsFinish(i) = False

            Next i

            'Dim filePuth As String
            'filePuth = Application.StartupPath   "\"   "" & fileName & ""   ".bmp"
            'bmp.Save(filePuth)
            'MyImage = bmp
            'Viewer.Image = MyImage

            DrawPicture()

        End If
    End Sub

    '绘图函数
    Public Sub DrawPicture()

        'Dim b As New Bitmap(PictureBox1.Width, PictureBox1.Height)
        'Dim g As Graphics = Graphics.FromImage(b)
        'Dim p As New Pen(System.Drawing.Color.Black)

        '测试画红色
        m_bIsFinish(2) = True
        m_bIsFinish(3) = True
        m_bIsFinish(4) = True

        g.Clear(System.Drawing.Color.White)
        p.EndCap = Drawing2D.LineCap.ArrowAnchor

        g.DrawLine(p, 10, PictureBox1.Height - 10, 10, 10)
        g.DrawLine(p, 10, PictureBox1.Height - 10, PictureBox1.Width - 10, PictureBox1.Height - 10)
        Dim i As Integer

        '计算绘图比例
        Dim temp As Double
        temp = m_arrayX(0)
        For i = 1 To m_iCircleNums
            If m_arrayX(i) > temp Then
                temp = m_arrayX(i)
            End If
        Next i
        scaleX = temp / (PictureBox1.Width - 50)

        temp = m_arrayY(0)
        For i = 1 To m_iCircleNums
            If m_arrayY(i) > temp Then
                temp = m_arrayY(i)
            End If
        Next i
        scaleY = temp / (PictureBox1.Height - 50)

        scaleR = scaleX
        If scaleX < scaleY Then
            scaleR = scaleY
        End If

        For i = 0 To m_iCircleNums
            tranX = m_arrayX(i) / scaleX
            tranY = PictureBox1.Height - 10 - m_arrayY(i) / scaleY
            tranR = m_arrayR(i) / scaleR
            If m_bIsFinish(i) Then
                p.Color = System.Drawing.Color.Red   '已经完成显示红色
                bs.Color = System.Drawing.Color.Red
            Else
                p.Color = System.Drawing.Color.Black  '未完成显示黑色
                bs.Color = System.Drawing.Color.Black
            End If

            g.DrawArc(p, tranX, tranY, tranR, tranR, 0, 360)
            g.DrawString(i, Me.Font, bs, tranX, tranY - tranR)
        Next i

        PictureBox1.Image = b

    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click

        'Dim b As New Bitmap(PictureBox1.Width, PictureBox1.Height)
        'Dim g As Graphics = Graphics.FromImage(b)
        'Dim p As New Pen(System.Drawing.Color.Black)

        g.Clear(System.Drawing.Color.White)
        p.EndCap = Drawing2D.LineCap.ArrowAnchor

        g.DrawLine(p, 10, PictureBox1.Height - 10, 10, 10)
        g.DrawLine(p, 10, PictureBox1.Height - 10, PictureBox1.Width - 10, PictureBox1.Height - 10)
        Dim i As Integer

        '计算绘图比例
        Dim temp As Double
        temp = m_arrayX(0)
        For i = 1 To m_iCircleNums
            If m_arrayX(i) > temp Then
                temp = m_arrayX(i)
            End If
        Next i
        scaleX = temp / (PictureBox1.Width - 50)

        temp = m_arrayY(0)
        For i = 1 To m_iCircleNums
            If m_arrayY(i) > temp Then
                temp = m_arrayY(i)
            End If
        Next i
        scaleY = temp / (PictureBox1.Height - 50)

        scaleR = scaleX
        If scaleX < scaleY Then
            scaleR = scaleY
        End If

        For i = 0 To m_iCircleNums
            tranX = m_arrayX(i) / scaleX
            tranY = PictureBox1.Height - 10 - m_arrayY(i) / scaleY
            tranR = m_arrayR(i) / scaleR
            g.DrawArc(p, tranX, tranY, tranR, tranR, 0, 360)
        Next i

        ' Dim bs As New SolidBrush(System.Drawing.Color.Green)
        'Dim po As New Point
        'po.X = 0
        'po.Y = PictureBox1.Height - 35
        'For i = 700 To 1000 Step 50
        '    g.DrawString(i, Me.Font, bs, po.X, po.Y)
        '    g.DrawLine(p, po.X   28, po.Y   5, po.X   30, po.Y   5)
        '    po.Y -= (PictureBox1.Height - 100) / 6
        'Next
        'po.X = 30
        'po.Y = PictureBox1.Height - 30
        'For i = 0 To 40 Step 5
        '    g.DrawString(i, Me.Font, bs, po.X, po.Y   5)
        '    g.DrawLine(p, po.X, po.Y   2, po.X, po.Y)
        '    po.X  = (PictureBox1.Width - 100) / 8
        'Next
        PictureBox1.Image = b
    End Sub

    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
        Dim filePuth As String
        filePuth = Application.StartupPath   "\"   "" & fileName1 & ""   ".bmp"
        PictureBox1.Image.Save(filePuth)
    End Sub
End Class