实例介绍
【实例简介】本程序只能读取圆心图形，所以在画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
标签： vb.net读取dxf文件
好例子网口号：伸出你的我的手 — 分享！
小贴士
感谢您为本站写下的评论，您的评论对其它用户来说具有重要的参考价值，所以请认真填写。
- 类似“顶”、“沙发”之类没有营养的文字，对勤劳贡献的楼主来说是令人沮丧的反馈信息。
- 相信您也不想看到一排文字/表情墙，所以请不要反馈意义不大的重复字符，也请尽量不要纯表情的回复。
- 提问之前请再仔细看一遍楼主的说明，或许是您遗漏了。
- 请勿到处挖坑绊人、招贴广告。既占空间让人厌烦，又没人会搭理，于人于己都无利。
关于好例子网
本站旨在为广大IT学习爱好者提供一个非营利性互相学习交流分享平台。本站所有资源都可以被免费获取学习研究。本站资源来自网友分享，对搜索内容的合法性不具有预见性、识别性、控制性，仅供学习研究，请务必在下载后24小时内给予删除，不得用于其他任何用途，否则后果自负。基于互联网的特殊性，平台无法对用户传输的作品、信息、内容的权属或合法性、安全性、合规性、真实性、科学性、完整权、有效性等进行实质审查；无论平台是否已进行审查，用户均应自行承担因其传输的作品、信息、内容而可能或已经产生的侵权或权属纠纷等法律责任。本站所有资源不代表本站的观点或立场，基于网友分享，根据中国法律《信息网络传播权保护条例》第二十二与二十三条之规定，若资源存在侵权或相关问题请联系本站客服人员，点此联系我们。关于更多版权及免责申明参见 版权及免责申明
网友评论
我要评论