VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Main
Caption = "DXF pseudoparser"
ClientHeight = 6780
ClientLeft = 48
ClientTop = 336
ClientWidth = 7416
LinkTopic = "Form1"
ScaleHeight = 6780
ScaleWidth = 7416
StartUpPosition = 3
Begin VB.CommandButton cmd3DFACE
Caption = "3DFACE"
Enabled = 0
Height = 252
Left = 960
TabIndex = 17
Top = 1200
Width = 732
End
Begin VB.CommandButton cmdPLOT
Caption = "plot"
Enabled = 0
Height = 252
Left = 960
Style = 1
TabIndex = 16
Top = 840
Width = 732
End
Begin VB.CommandButton cmdCOPY
Caption = "COPY"
Height = 252
Left = 120
TabIndex = 15
ToolTipText = "Copy the image to the clipboard"
Top = 1200
Width = 732
End
Begin VB.TextBox TextMaxY
Height = 288
Left = 6480
TabIndex = 10
Text = "MaxY"
Top = 1200
Width = 852
End
Begin VB.TextBox TextMaxX
Height = 288
Left = 6480
TabIndex = 9
Text = "MaxX"
Top = 840
Width = 852
End
Begin VB.TextBox TextMinY
Height = 288
Left = 4680
TabIndex = 8
Text = "MinY"
Top = 1200
Width = 852
End
Begin VB.TextBox TextMinX
Height = 288
Left = 4680
TabIndex = 7
Text = "MinX"
Top = 840
Width = 852
End
Begin VB.TextBox TextScaling
Height = 288
Left = 2880
TabIndex = 6
Text = "DisplayScale"
Top = 840
Width = 852
End
Begin VB.CommandButton cmdCLR
Caption = "CLR"
Height = 252
Left = 120
TabIndex = 5
ToolTipText = "Clears the drawing"
Top = 840
Width = 732
End
Begin VB.PictureBox Picture1
AutoRedraw = -1
Height = 4812
Left = 0
ScaleHeight = 4764
ScaleWidth = 7164
TabIndex = 4
Top = 1560
Width = 7212
End
Begin VB.CommandButton CmdGCode
Caption = "ISO-Code"
Enabled = 0
Height = 252
Left = 120
Style = 1
TabIndex = 2
ToolTipText = "Draws the graphical data and generates the OUT.ISO-file"
Top = 480
Width = 1572
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 0
Top = 0
_ExtentX = 677
_ExtentY = 677
_Version = 393216
End
Begin VB.CommandButton cmdOpen
Caption = "Open"
Height = 252
Left = 120
Style = 1
TabIndex = 0
Top = 120
Width = 1572
End
Begin VB.Label LabelMessage
ForeColor = &H000000FF&
Height = 252
Left = 3840
TabIndex = 18
Top = 480
Width = 3492
End
Begin VB.Label Label4
Caption = "MinY"
Height = 252
Left = 3840
TabIndex = 14
Top = 1200
Width = 732
End
Begin VB.Label Label3
Caption = "MinX"
Height = 252
Left = 3840
TabIndex = 13
Top = 840
Width = 732
End
Begin VB.Label Label2
Caption = "MaxY"
Height = 252
Left = 5760
TabIndex = 12
Top = 1200
Width = 612
End
Begin VB.Label Label1
Caption = "MaxX"
Height = 252
Left = 5760
TabIndex = 11
Top = 840
Width = 612
End
Begin VB.Label LabelGFile
Caption = "OUT.ISO"
Height = 252
Left = 1920
TabIndex = 3
Top = 480
Width = 972
End
Begin VB.Label LabelFileName
Caption = "DXF ASCII Input file"
Height = 252
Left = 1800
TabIndex = 1
Top = 120
Width = 5532
End
End
Attribute VB_Name = "Main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim MinX As Single, MinY As Single, MinZ As Single
Dim MaxX As Single, MaxY As Single, MaxZ As Single
Const BorderX = 50
Const BorderY = 50
Dim Codes
Dim Scaling As Single
Const pi = 3.14159265358979
Const IsoFormat = "0000.000"
Dim LineNumber As Long
Const LineNumberFormat = "00000"
Private Sub cmd3DFACE_Click()
Dim ScalingX, ScalingY, ScalingZ1, ScalingZ2
Scaling = Val(Replace(TextScaling.Text, ",", "."))
cmd3DFACE.BackColor = vbYellow
DoEvents
Open LabelFileName.Caption For Input As #1
Call DXFGo2Entities
Codes = ReadCodes()
Do While Not EOF(1)
Select Case Codes(1)
Case "3DFACE"
Call DXF3DFace_3DrawOnly
Case Else
Codes = ReadCodes()
End Select
Loop
Close
cmd3DFACE.BackColor = vbGreen
End Sub
Private Sub cmdCLR_Click()
Picture1.Cls
End Sub
Private Sub cmdCOPY_Click()
Clipboard.Clear
Clipboard.SetData Picture1.Image
End Sub
Private Sub CmdGCode_Click()
LineNumber = 0
Scaling = Val(Replace(TextScaling.Text, ",", "."))
MinX = Val(Replace(TextMinX.Text, ",", "."))
MinY = Val(Replace(TextMinY.Text, ",", "."))
CmdGCode.BackColor = vbYellow
DoEvents
Open LabelFileName.Caption For Input As #1
Call DXFGo2Entities
Open LabelGFile.Caption For Output As #2
Print #2, LineNumberStr(LineNumber) & " G90; # absolute coordinates "
Print #2, LineNumberStr(LineNumber) & " G71; # metric programming unit "
Codes = ReadCodes()
Do While Not EOF(1)
Select Case Codes(1)
Case "POLYLINE"
Call DXFPolyLine
Case "LINE"
Call DXFLine
Case "ARC"
Call DXFArc
Case "CIRCLE"
Call DXFCircle
Case "POINT"
Call DXFPoint
Case Else
Codes = ReadCodes()
End Select
Loop
Print #2, LineNumberStr(LineNumber) & " M02; # program end "
Close
Close
CmdGCode.BackColor = vbGreen
End Sub
Private Sub cmdPLOT_Click()
Scaling = Val(Replace(TextScaling.Text, ",", "."))
MinX = Val(Replace(TextMinX.Text, ",", "."))
MinY = Val(Replace(TextMinY.Text, ",", "."))
cmdPLOT.BackColor = vbYellow
DoEvents
Open LabelFileName.Caption For Input As #1
Call DXFGo2Entities
If Not EOF(1) Then Codes = ReadCodes()
Do While Not EOF(1)
Select Case Codes(1)
Case "3DFACE"
Call DXF3DFace_DrawOnly
Case "POLYLINE"
Call DXFPolyLine_DrawOnly
Case "LINE"
Call DXFLine_DrawOnly
Case "ARC"
Call DXFArc_DrawOnly
Case "CIRCLE"
Call DXFCircle_DrawOnly
Case "POINT"
Call DXFPoint_DrawOnly
Case "TEXT"
Call DXFText_DrawOnly
Case Else
Codes = ReadCodes()
End Select
Loop
Close
cmdPLOT.BackColor = vbGreen
End Sub
Private Sub Form_Load()
MinX = 0
MaxX = 0
MinY = 0
MaxY = 0
Scaling = 1
End Sub
Private Sub cmdOPen_Click()
CommonDialog1.CancelError = True
On Error GoTo ErrHandler
CommonDialog1.Filter = "DXF Files(*.dxf)|*.dxf|" & _
"TXT Files (*.txt)|*.txt|All Files (*.*)|*.*"
CommonDialog1.ShowOpen
LabelFileName.Caption = CommonDialog1.FileName
MinX = 0: MaxX = 0
MinY = 0: MaxY = 0
MinZ = 0: MaxZ = 0
Scaling = 1
CmdGCode.BackColor = cmdOpen.BackColor
cmdPLOT.BackColor = cmdOpen.BackColor
cmdPLOT.Enabled = False
CmdGCode.Enabled = False
cmdOpen.Enabled = False
LabelMessage.Caption = "Analysing DXF file - please wait"
Call cmdParseMinMax
LabelMessage.Caption = "DXF file analysis done"
CmdGCode.Enabled = True
cmdPLOT.Enabled = True
cmdOpen.Enabled = True
Exit Sub
ErrHandler:
cmdOpen.Enabled = True
LabelMessage.Caption = "file error"
Exit Sub
End Sub
Private Sub Bulge2IJ(X1, Y1, X2, Y2, Bulge, i, J, R, alphafrom, alphato, Xg, Yg, Rg)
Dim C
Dim H
Dim alpha2
Dim beta
Dim dummy
If Bulge <> 0 Then
C = Sqr((X2 - X1) ^ 2 + (Y2 - Y1) ^ 2)
alpha2 = Atn(Bulge) * 2
R = Abs(((C / (2 * Sin(alpha2)))))
H = Sqr(R ^ 2 - (C / 2) ^ 2)
If (Bulge > 1) Or ((Bulge < 0) And (Bulge > -1)) Then alpha2 = alpha2 + pi
If (X1 <> X2) Then
beta = Atn((Y2 - Y1) / (X2 - X1))
If X2 < X1 Then beta = beta + pi
Else
If Y2 < Y1 Then beta = -pi / 2 Else beta = pi / 2
End If
If ((Bulge > 1) Or ((Bulge < 0) And (Bulge > -1))) Then
i = (X2 - X1) / 2 + (Cos(beta - pi / 2) * H)
J = (Y2 - Y1) / 2 + (Sin(beta - pi / 2) * H)
Else
i = (X2 - X1) / 2 - (Cos(beta - pi / 2) * H)
J = (Y2 - Y1) / 2 - (Sin(beta - pi / 2) * H)
End If
"P2=(" & X2 & " ; " & Y2 & ")" & vbCr & vbLf & _
"Beta=" & beta * 180 / pi & "" & vbCr & vbLf & _
"Alpha=" & alpha2 * 180 / pi & vbCr & vbLf & _
"I=(" & I & " ; " & J & ") "
If i <> 0 Then
alphafrom = Atn(J / i)
If i > 0 Then alphafrom = alphafrom + pi
Else
If (J > 0) Then alphafrom = pi / 2 Else alphafrom = -pi / 2
End If
alphato = alphafrom + alpha2 * 2
While (alphato > 2 * pi)
alphato = alphato - 2 * pi
Wend
While (alphato < 0)
alphato = alphato + 2 * pi
Wend
While (alphafrom > 2 * pi)
alphafrom = alphafrom - 2 * pi
Wend
While (alphafrom < 0)
alphafrom = alphafrom + 2 * pi
Wend
If Bulge < 0 Then
dummy = alphato: alphato = alphafrom: alphafrom = dummy
End If
Xg = CSng((X1 + i - MinX) * Scaling + BorderX)
Yg = CSng(Picture1.Height - (Y1 + J - MinY) * Scaling - BorderY)
Rg = CSng(R * Scaling)
End If
End Sub
Private Sub DXFPolyLine()
Dim LineStr
Dim VertexCount
Dim X0, Y0
Dim X1, Y1
Dim X, Y
Dim Bulge, Bulge1
Dim R
Dim alphafrom, alphato
Dim i, J
Dim Xg, Yg, Rg, Xg1, Yg1
Dim ClosedLine
X = 0: X1 = 0: i = 0
Y = 0: Y1 = 0: J = 0
Bulge = 0: Bulge1 = 0
VertexCount = -1
ClosedLine = False
Codes = ReadCodes
While Codes(1) <> "SEQEND"
Codes(1) = Replace(Codes(1), ",", ".")
Select Case Codes(0)
Case 8
Case 6
Case 40
Case 41
Case 66
Case 70
If Codes(1) And 1 = 1 Then
ClosedLine = True
End If
Case 10
X = Val(Codes(1))
Case 20
Y = Val(Codes(1))
Case 42
Bulge = Val(Codes(1))
Case 0
If Codes(1) = "VERTEX" Then
VertexCount = VertexCount + 1
If VertexCount = 1 Then
LineStr = "X" & Format(X, IsoFormat) & " Y" & Format(Y, IsoFormat)
LineStr = Replace(LineStr, ",", ".")
Print #2, LineNumberStr(LineNumber) & " G00 " & LineStr & ";"
X0 = X
Y0 = Y
End If
If VertexCount > 1 Then
Call Bulge2IJ(X1, Y1, X, Y, Bulge1, i, J, R, alphafrom, alphato, Xg, Yg, Rg)
If Bulge1 = 0 Then
LineStr = "X" & Format(X, IsoFormat) & " Y" & Format(Y, IsoFormat)
LineStr = Replace(LineStr, ",", ".")
Print #2, LineNumberStr(LineNumber) & " G01 " & LineStr & ";"
Xg = (X - MinX) * Scaling + BorderX
Yg = Picture1.Height - (Y - MinY) * Scaling - BorderY
Xg1 = (X1 - MinX) * Scaling + BorderX
Yg1 = Picture1.Height - (Y1 - MinY) * Scaling - BorderY
Picture1.Line (Xg, Yg)-(Xg1, Yg1)
Else
LineStr = "X" & Format(X, IsoFormat) & " Y" & Format(Y, IsoFormat) & " I" & Format(i, IsoFormat) & " J" & Format(J, IsoFormat)
LineStr = Replace(LineStr, ",", ".")
If Bulge1 > 0 Then
Print #2, LineNumberStr(LineNumber) & " G03 " & LineStr & "; "
Else
Print #2, LineNumberStr(LineNumber) & " G02 " & LineStr & "; "
End If
Picture1.Circle (Xg, Yg), Rg, , alphafrom, alphato
End If
End If
Bulge1 = Bulge
Bulge = 0
X1 = X
Y1 = Y
End If
Case Else
End Select
Codes = ReadCodes
Wend
Call Bulge2IJ(X1, Y1, X, Y, Bulge1, i, J, R, alphafrom, alphato, Xg, Yg, Rg)
If Bulge1 = 0 Then
LineStr = "X" & Format(X, IsoFormat) & " Y" & Format(Y, IsoFormat)
LineStr = Replace(LineStr, ",", ".")
Print #2, LineNumberStr(LineNumber) & " G01 " & LineStr & ";"
Xg = (X - MinX) * Scaling + BorderX
Yg = Picture1.Height - (Y - MinY) * Scaling - BorderY
Xg1 = (X1 - MinX) * Scaling + BorderX
Yg1 = Picture1.Height - (Y1 - MinY) * Scaling - BorderY
Picture1.Line (Xg, Yg)-(Xg1, Yg1)
Else
LineStr = "X" & Format(X, IsoFormat) & " Y" & Format(Y, IsoFormat) & " I" & Format(i, IsoFormat) & " J" & Format(J, IsoFormat)
LineStr = Replace(LineStr, ",", ".")
If Bulge1 > 0 Then
Print #2, LineNumberStr(LineNumber) & " G03 " & LineStr & "; "
Else
Print #2, LineNumberStr(LineNumber) & " G02 " & LineStr & "; "
End If
Picture1.Circle (Xg, Yg), Rg, , alphafrom, alphato
End If
If ClosedLine Then
Call Bulge2IJ(X, Y, X0, Y0, Bulge, i, J, R, alphafrom, alphato, Xg, Yg, Rg)
If Bulge1 = 0 Then
LineStr = "X" & Format(X0, IsoFormat) & " Y" & Format(Y0, IsoFormat)
LineStr = Replace(LineStr, ",", ".")
Print #2, LineNumberStr(LineNumber) & " G01 " & LineStr & ";"
Xg = (X0 - MinX) * Scaling + BorderX
Yg = Picture1.Height - (Y0 - MinY) * Scaling - BorderY
Xg1 = (X - MinX) * Scaling + BorderX
Yg1 = Picture1.Height - (Y - MinY) * Scaling - BorderY
Picture1.Line (Xg, Yg)-(Xg1, Yg1)
Else
LineStr = "X" & Format(X0, IsoFormat) & " Y" & Format(Y0, IsoFormat) & " I" & Format(i, IsoFormat) & " J" & Format(J, IsoFormat)
LineStr = Replace(LineStr, ",", ".")
If Bulge1 > 0 Then
Print #2, LineNumberStr(LineNumber) & " G03 " & LineStr & "; "
Else
Print #2, LineNumberStr(LineNumber) & " G02 " & LineStr & "; "
End If
Picture1.Circle (Xg, Yg), Rg, , alphafrom, alphato
End If
End If
End Sub
Private Sub DXFPolyLine_DrawOnly()
Dim LineStr
Dim VertexCount
Dim X0, Y0
Dim X1, Y1
Dim X, Y
Dim Bulge, Bulge1
Dim R
Dim alphafrom, alphato
Dim i, J
Dim Xg, Yg, Rg, Xg1, Yg1
Dim ClosedLine
X = 0: X1 = 0: i = 0
Y = 0: Y1 = 0: J = 0
Bulge = 0: Bulge1 = 0
VertexCount = -1
ClosedLine = False
Codes = ReadCodes
While Codes(1) <> "SEQEND"
Codes(1) = Replace(Codes(1), ",", ".")
Select Case Codes(0)
Case 8
Case 6
Case 40
Case 41
Case 66
Case 70
If (Val(Codes(1)) And 1) = 1 Then
ClosedLine = True
End If
Case 10
X = Val(Codes(1))
Case 20
Y = Val(Codes(1))
Case 42
Bulge = Val(Codes(1))
Case 0
If Codes(1) = "VERTEX" Then
VertexCount = VertexCount + 1
If VertexCount = 1 Then
X0 = X
Y0 = Y
End If
If VertexCount > 1 Then
Call Bulge2IJ(X1, Y1, X, Y, Bulge1, i, J, R, alphafrom, alphato, Xg, Yg, Rg)
If Bulge1 = 0 Then
Xg = (X - MinX) * Scaling + BorderX
Yg = Picture1.Height - (Y - MinY) * Scaling - BorderY
Xg1 = (X1 - MinX) * Scaling + BorderX
Yg1 = Picture1.Height - (Y1 - MinY) * Scaling - BorderY
Picture1.Line (Xg, Yg)-(Xg1, Yg1)
Else
Picture1.Circle (Xg, Yg), Rg, , alphafrom, alphato
End If
End If
Bulge1 = Bulge
Bulge = 0
X1 = X
Y1 = Y
End If
Case Else
End Select
Codes = ReadCodes
Wend
Call Bulge2IJ(X1, Y1, X, Y, Bulge1, i, J, R, alphafrom, alphato, Xg, Yg, Rg)
If Bulge1 = 0 Then
Xg = (X - MinX) * Scaling + BorderX
Yg = Picture1.Height - (Y - MinY) * Scaling - BorderY
Xg1 = (X1 - MinX) * Scaling + BorderX
Yg1 = Picture1.Height - (Y1 - MinY) * Scaling - BorderY
Picture1.Line (Xg, Yg)-(Xg1, Yg1)
Else
Picture1.Circle (Xg, Yg), Rg, , alphafrom, alphato
End If
If ClosedLine Then
Call Bulge2IJ(X, Y, X0, Y0, Bulge, i, J, R, alphafrom, alphato, Xg, Yg, Rg)
If Bulge1 = 0 Then
Xg = (X0 - MinX) * Scaling + BorderX
Yg = Picture1.Height - (Y0 - MinY) * Scaling - BorderY
Xg1 = (X - MinX) * Scaling + BorderX
Yg1 = Picture1.Height - (Y - MinY) * Scaling - BorderY
Picture1.Line (Xg, Yg)-(Xg1, Yg1)
Else
Picture1.Circle (Xg, Yg), Rg, , alphafrom, alphato
End If
End If
End Sub
Private Sub DXF3DFace_DrawOnly()
Dim LineStr
Dim VertexCount
Dim X0, Y0
Dim X1, Y1
Dim X2, Y2
Dim X3, Y3
X0 = 0: X1 = 0: X2 = 0: X3 = 0
Y0 = 0: Y1 = 0: Y2 = 0: Y3 = 0
VertexCount = -1
Codes = ReadCodes
While Codes(0) <> 0
Codes(1) = Replace(Codes(1), ",", ".")
Select Case Codes(0)
Case 10
X0 = Val(Codes(1)): VertexCount = 1
Case 20
Y0 = Val(Codes(1)): VertexCount = 1
Case 11
X1 = Val(Codes(1)): VertexCount = 2
Case 21
Y1 = Val(Codes(1)): VertexCount = 2
Case 12
X2 = Val(Codes(1)): VertexCount = 3
Case 22
Y2 = Val(Codes(1)): VertexCount = 3
Case 13
X3 = Val(Codes(1)): VertexCount = 4
Case 23
Y3 = Val(Codes(1)): VertexCount = 4
Case Else
End Select
Codes = ReadCodes
Wend
X0 = (X0 - MinX) * Scaling + BorderX
Y0 = Picture1.Height - (Y0 - MinY) * Scaling - BorderY
X1 = (X1 - MinX) * Scaling + BorderX
Y1 = Picture1.Height - (Y1 - MinY) * Scaling - BorderY
X2 = (X2 - MinX) * Scaling + BorderX
Y2 = Picture1.Height - (Y2 - MinY) * Scaling - BorderY
X3 = (X3 - MinX) * Scaling + BorderX
Y3 = Picture1.Height - (Y3 - MinY) * Scaling - BorderY
Picture1.Line (X0, Y0)-(X1, Y1)
Picture1.Line (X1, Y1)-(X2, Y2)
If VertexCount = 4 Then
Picture1.Line (X2, Y2)-(X3, Y3)
Picture1.Line (X3, Y3)-(X0, Y0)
Else
Picture1.Line (X2, Y2)-(X0, Y0)
End If
End Sub
Private Sub Line3D(X0, Y0, Z0, X1, Y1, Z1)
Picture1.Line ((X0 - MinX) * Scaling / 2, Picture1.Height - (Y0 - MinY) * Scaling / 2 - BorderY) _
-((X1 - MinX) * Scaling / 2, Picture1.Height - (Y1 - MinY) * Scaling / 2 - BorderY)
Picture1.Line ((Z0 - MinZ) * Scaling / 2 + Picture1.Width / 2, Picture1.Height - (Y0 - MinY) * Scaling / 2 - BorderY) _
-((Z1 - MinZ) * Scaling / 2 + Picture1.Width / 2, Picture1.Height - (Y1 - MinY) * Scaling / 2 - BorderY)
Picture1.Line ((X0 - MinX) * Scaling / 2, Picture1.Height / 2 - (Z0 - MinZ) * Scaling / 2 - BorderY) _
-((X1 - MinX) * Scaling / 2, Picture1.Height / 2 - (Z1 - MinZ) * Scaling / 2 - BorderY)
End Sub
Private Sub DXF3DFace_3DrawOnly()
Dim LineStr
Dim VertexCount
Dim X0, Y0, Z0
Dim X1, Y1, Z1
Dim X2, Y2, Z2
Dim X3, Y3, Z3
X0 = 0: X1 = 0: X2 = 0: X3 = 0
Y0 = 0: Y1 = 0: Y2 = 0: Y3 = 0
Z0 = 0: Z1 = 0: Z2 = 0: Z3 = 0
VertexCount = -1
Codes = ReadCodes
While Codes(0) <> 0
Codes(1) = Replace(Codes(1), ",", ".")
Select Case Codes(0)
Case 10
X0 = Val(Codes(1)): VertexCount = 1
Case 20
Y0 = Val(Codes(1)): VertexCount = 1
Case 30
Z0 = Val(Codes(1)): VertexCount = 1
Case 11
X1 = Val(Codes(1)): VertexCount = 2
Case 21
Y1 = Val(Codes(1)): VertexCount = 2
Case 31
Z1 = Val(Codes(1)): VertexCount = 2
Case 12
X2 = Val(Codes(1)): VertexCount = 3
Case 22
Y2 = Val(Codes(1)): VertexCount = 3
Case 32
Z2 = Val(Codes(1)): VertexCount = 3
Case 13
X3 = Val(Codes(1)): VertexCount = 4
Case 23
Y3 = Val(Codes(1)): VertexCount = 4
Case 33
Z3 = Val(Codes(1)): VertexCount = 4
Case Else
End Select
Codes = ReadCodes
Wend
Call Line3D(X0, Y0, Z0, X1, Y1, Z1)
Call Line3D(X1, Y1, Z1, X2, Y2, Z2)
If VertexCount = 4 Then
Call Line3D(X2, Y2, Z2, X3, Y3, Z3)
Call Line3D(X3, Y3, Z3, X0, Y0, Z0)
Else
Call Line3D(X2, Y2, Z2, X0, Y0, Z0)
End If
End Sub
Private Sub DXFLine()
Dim X1, Y1, X2, Y2, LineStr
Codes = ReadCodes
While Not EOF(1)
Codes(1) = Replace(Codes(1), ",", ".")
Select Case Codes(0)
Case 8
Case 6
Case 40
Case 41
Case 66
Case 10
X1 = Val(Codes(1))
Case 20
Y1 = Val(Codes(1))
Case 11
X2 = Val(Codes(1))
Case 21
Y2 = Val(Codes(1))
Case 0
LineStr = "X" & Format(X1, IsoFormat) & " Y" & Format(Y1, IsoFormat)
LineStr = Replace(LineStr, ",", ".")
Print #2, LineNumberStr(LineNumber) & " G00 " & LineStr & ";"
LineStr = "X" & Format(X2, IsoFormat) & " Y" & Format(Y2, IsoFormat)
LineStr = Replace(LineStr, ",", ".")
Print #2, LineNumberStr(LineNumber) & " G01 " & LineStr & ";"
Picture1.Line ((X1 - MinX) * Scaling + BorderX, Picture1.Height - (Y1 - MinY) * Scaling - BorderY)-((X2 - MinX) * Scaling + BorderX, Picture1.Height - (Y2 - MinY) * Scaling - BorderY)
Exit Sub
End Select
Codes = ReadCodes
Wend
End Sub
Private Sub DXFLine_DrawOnly()
Dim X1, Y1, X2, Y2, LineStr
Codes = ReadCodes
While Not EOF(1)
Codes(1) = Replace(Codes(1), ",", ".")
Select Case Codes(0)
Case 8
Case 6
Case 40
Case 41
Case 66
Case 10
X1 = Val(Codes(1))
Case 20
Y1 = Val(Codes(1))
Case 11
X2 = Val(Codes(1))
Case 21
Y2 = Val(Codes(1))
Case 0
Picture1.Line ((X1 - MinX) * Scaling + BorderX, Picture1.Height - (Y1 - MinY) * Scaling - BorderY)-((X2 - MinX) * Scaling + BorderX, Picture1.Height - (Y2 - MinY) * Scaling - BorderY)
Exit Sub
End Select
Codes = ReadCodes
Wend
End Sub
Private Sub DXFPoint_DrawOnly()
Dim X1, Y1, LineStr
Codes = ReadCodes
While Not EOF(1)
Codes(1) = Replace(Codes(1), ",", ".")
Select Case Codes(0)
Case 8
Case 6
Case 40
Case 41
Case 66
Case 10
X1 = Val(Codes(1))
Case 20
Y1 = Val(Codes(1))
Case 0
Picture1.Line ((X1 - MinX) * Scaling + BorderX, Picture1.Height - (Y1 - MinY) * Scaling - BorderY)-((X1 - MinX) * Scaling + BorderX, Picture1.Height - (Y1 - MinY) * Scaling - BorderY)
Exit Sub
End Select
Codes = ReadCodes
Wend
End Sub
Private Sub DXFPoint()
Dim X1, Y1, LineStr
Codes = ReadCodes
While Not EOF(1)
Codes(1) = Replace(Codes(1), ",", ".")
Select Case Codes(0)
Case 8
Case 6
Case 40
Case 41
Case 66
Case 10
X1 = Val(Codes(1))
Case 20
Y1 = Val(Codes(1))
Case 0
LineStr = "X" & Format(X1, IsoFormat) & " Y" & Format(Y1, IsoFormat)
LineStr = Replace(LineStr, ",", ".")
Print #2, LineNumberStr(LineNumber) & " G00 " & LineStr & ";"
Picture1.Line ((X1 - MinX) * Scaling + BorderX, Picture1.Height - (Y1 - MinY) * Scaling - BorderY)-((X1 - MinX) * Scaling + BorderX, Picture1.Height - (Y1 - MinY) * Scaling - BorderY)
Exit Sub
End Select
Codes = ReadCodes
Wend
End Sub
Private Sub DXFText_DrawOnly()
Dim X1, Y1, Text, Rot
Codes = ReadCodes
While Not EOF(1)
Codes(1) = Replace(Codes(1), ",", ".")
Select Case Codes(0)
Case 1
Text = Codes(1)
Case 8
Case 6
Case 40
Case 41
Case 50
Rot = Val(Codes(1))
Case 66
Case 10
X1 = Val(Codes(1))
Case 20
Y1 = Val(Codes(1))
Case 0
Picture1.Line ((X1 - MinX) * Scaling + BorderX, Picture1.Height - (Y1 - MinY) * Scaling - BorderY)-((X1 - MinX) * Scaling + BorderX, Picture1.Height - (Y1 - MinY) * Scaling - BorderY)
Picture1.Print Text
Exit Sub
End Select
Codes = ReadCodes
Wend
End Sub
Private Sub DXFArc()
Dim X, Y, X1, Y1, X2, Y2, R, A1, A2, LineStr, i, J
Codes = ReadCodes
While Not EOF(1)
Codes(1) = Replace(Codes(1), ",", ".")
Select Case Codes(0)
Case 8
Case 6
Case 41
Case 66
Case 50
A1 = Val(Codes(1))
Case 51
A2 = Val(Codes(1))
Case 10
X = Val(Codes(1))
Case 20
Y = Val(Codes(1))
Case 40
R = Val(Codes(1))
Case 0
X1 = X + R * Cos(A1 / 180 * pi)
Y1 = Y + R * Sin(A1 / 180 * pi)
X2 = X + R * Cos(A2 / 180 * pi)
Y2 = Y + R * Sin(A2 / 180 * pi)
i = X - X1
J = Y - Y1
LineStr = "X" & Format(X1, IsoFormat) & " Y" & Format(Y1, IsoFormat)
LineStr = Replace(LineStr, ",", ".")
Print #2, LineNumberStr(LineNumber) & " G00 " & LineStr & ";"
LineStr = "X" & Format(X2, IsoFormat) & " Y" & Format(Y2, IsoFormat) & " I" & Format(i, IsoFormat) & " J" & Format(J, IsoFormat)
LineStr = Replace(LineStr, ",", ".")
Print #2, LineNumberStr(LineNumber) & " G03 " & LineStr & "; "
X = CSng((X - MinX) * Scaling + BorderX)
Y = CSng((Picture1.Height - (Y - MinY) * Scaling - BorderY))
R = CSng(R * Scaling)
A1 = A1 / 180 * pi
A2 = A2 / 180 * pi
Picture1.Circle (X, Y), R, , A1, A2
Exit Sub
End Select
Codes = ReadCodes
Wend
End Sub
Private Sub DXFArc_DrawOnly()
Dim X, Y, X1, Y1, X2, Y2, R, A1, A2, LineStr, i, J
Codes = ReadCodes
While Not EOF(1)
Codes(1) = Replace(Codes(1), ",", ".")
Select Case Codes(0)
Case 8
Case 6
Case 41
Case 66
Case 50
A1 = Val(Codes(1))
Case 51
A2 = Val(Codes(1))
Case 10
X = Val(Codes(1))
Case 20
Y = Val(Codes(1))
Case 40
R = Val(Codes(1))
Case 0
X1 = X + R * Cos(A1 / 180 * pi)
Y1 = Y + R * Sin(A1 / 180 * pi)
X2 = X + R * Cos(A2 / 180 * pi)
Y2 = Y + R * Sin(A2 / 180 * pi)
i = X - X1
J = Y - Y1
X = CSng((X - MinX) * Scaling + BorderX)
Y = CSng((Picture1.Height - (Y - MinY) * Scaling - BorderY))
R = CSng(R * Scaling)
A1 = A1 / 180 * pi
A2 = A2 / 180 * pi
Picture1.Circle (X, Y), R, , A1, A2
Exit Sub
End Select
Codes = ReadCodes
Wend
End Sub
Private Sub DXFCircle()
Dim X, Y, X1, Y1, X2, Y2, R, LineStr
Codes = ReadCodes
While Not EOF(1)
Codes(1) = Replace(Codes(1), ",", ".")
Select Case Codes(0)
Case 8
Case 6
Case 41
Case 66
Case 10
X = Val(Codes(1))
Case 20
Y = Val(Codes(1))
Case 40
R = Val(Codes(1))
Case 0
X1 = X + R
Y1 = Y
X2 = X - R
Y2 = Y
LineStr = "X" & Format(X1, IsoFormat) & " Y" & Format(Y1, IsoFormat)
LineStr = Replace(LineStr, ",", ".")
Print #2, LineNumberStr(LineNumber) & " G00 " & LineStr & ";"
LineStr = "X" & Format(X2, IsoFormat) & " Y" & Format(Y2, IsoFormat) & " I" & Format(-R, IsoFormat) & " J" & Format(0, IsoFormat)
LineStr = Replace(LineStr, ",", ".")
Print #2, LineNumberStr(LineNumber) & " G03 " & LineStr & "; "
LineStr = "X" & Format(X1, IsoFormat) & " Y" & Format(Y1, IsoFormat) & " I" & Format(R, IsoFormat) & " J" & Format(0, IsoFormat)
LineStr = Replace(LineStr, ",", ".")
Print #2, LineNumberStr(LineNumber) & " G03 " & LineStr & "; "
X = CSng((X - MinX) * Scaling + BorderX)
Y = CSng((Picture1.Height - (Y - MinY) * Scaling - BorderY))
R = CSng(R * Scaling)
Picture1.Circle (X, Y), R
Exit Sub
End Select
Codes = ReadCodes
Wend
End Sub
Private Sub DXFCircle_DrawOnly()
Dim X, Y, X1, Y1, X2, Y2, R, LineStr
Codes = ReadCodes
While Not EOF(1)
Codes(1) = Replace(Codes(1), ",", ".")
Select Case Codes(0)
Case 8
Case 6
Case 41
Case 66
Case 10
X = Val(Codes(1))
Case 20
Y = Val(Codes(1))
Case 40
R = Val(Codes(1))
Case 0
X1 = X + R
Y1 = Y
X2 = X - R
Y2 = Y
X = CSng((X - MinX) * Scaling + BorderX)
Y = CSng((Picture1.Height - (Y - MinY) * Scaling - BorderY))
R = CSng(R * Scaling)
Picture1.Circle (X, Y), R
Exit Sub
End Select
Codes = ReadCodes
Wend
End Sub
Private Sub DXFGo2Entities()
Codes = ReadCodes
While (Codes(1) <> "ENTITIES") And (Not EOF(1))
Codes = ReadCodes
Wend
End Sub
Private Function LineNumberStr(LineNumber) As String
LineNumberStr = "N" & Format(LineNumber, LineNumberFormat)
LineNumber = LineNumber + 1
End Function
Private Sub CmdDraw_Click()
LineNumber = 0
Scaling = Val(Replace(TextScaling.Text, ",", "."))
MinX = Val(Replace(TextMinX.Text, ",", "."))
MinY = Val(Replace(TextMinY.Text, ",", "."))
CmdGCode.BackColor = vbYellow
DoEvents
Open LabelFileName.Caption For Input As #1
Call DXFGo2Entities
Open LabelGFile.Caption For Output As #2
Print #2, LineNumberStr(LineNumber) & " G90; # absolute coordinates "
Print #2, LineNumberStr(LineNumber) & " G71; # metric programming unit "
Codes = ReadCodes()
Do While Not EOF(1)
Select Case Codes(1)
Case "POLYLINE"
Call DXFPolyLine
Case "LINE"
Call DXFLine
Case "ARC"
Call DXFArc
Case "CIRCLE"
Call DXFCircle
Case "POINT"
Call DXFPoint
Case Else
Codes = ReadCodes()
End Select
Loop
Print #2, LineNumberStr(LineNumber) & " M02; #fine del programma"
Close
Close
CmdGCode.BackColor = vbGreen
End Sub
Private Sub cmdParseMinMax()
Dim MyString As String
Dim Layers As String, layerCount As Long, dummyI As Long
Dim FirstX, FirstY, FirstZ
Dim ScalingX, ScalingY
Dim GoodEntitie As Boolean
Dim BlockFound As Boolean
Dim Found3DFace As Boolean
FirstX = True: FirstY = True: FirstZ = True
BlockFound = False: Found3DFace = False
DoEvents
Open LabelFileName.Caption For Input As #1
Call DXFGo2Entities
Do While Not EOF(1)
Codes = ReadCodes()
Codes(1) = Replace(Codes(1), ",", ".")
If Codes(0) = 0 Then
Select Case Codes(1)
Case "VERTEX", "ARC", "LINE", "POINT", "TEXT": GoodEntitie = True
Case "INSERT":
GoodEntitie = False
BlockFound = True
Case "3DFACE"
GoodEntitie = True
Found3DFace = True
Case "ENDSEC":
GoodEntitie = False
Case Else: GoodEntitie = False
End Select
End If
If GoodEntitie Then
Select Case Codes(0)
Case 8
If (InStr(Layers, Codes(1)) > 0) Then
Else
Layers = Layers & Codes(1) & vbCr & vbLf
End If
Case 10, 11, 12, 13
If FirstX Then
MaxX = Val(Codes(1))
MinX = MaxX
FirstX = False
ElseIf Val(Codes(1)) > MaxX Then MaxX = Val(Codes(1))
ElseIf Val(Codes(1)) < MinX Then MinX = Val(Codes(1))
End If
Case 20, 21, 22, 23
If FirstY Then
MaxY = Val(Codes(1))
MinY = MaxY
FirstY = False
ElseIf Val(Codes(1)) > MaxY Then MaxY = Val(Codes(1))
ElseIf Val(Codes(1)) < MinY Then MinY = Val(Codes(1))
End If
Case 30, 31, 32, 33
If FirstZ Then
MaxZ = Val(Codes(1))
MinZ = MaxZ
FirstZ = False
ElseIf Val(Codes(1)) > MaxZ Then MaxZ = Val(Codes(1))
ElseIf Val(Codes(1)) < MinZ Then MinZ = Val(Codes(1))
End If
Case 42
End Select
End If
Loop
Close
If MaxX <> MinX Then ScalingX = (Picture1.Width - 2 * BorderX) / (MaxX - MinX)
If MaxY <> MinY Then ScalingY = (Picture1.Height - 2 * BorderY) / (MaxY - MinY)
If ScalingX > ScalingY Then Scaling = ScalingY Else Scaling = ScalingX
If Scaling > 10 Then Scaling = CInt(Scaling)
TextScaling.Text = Scaling
TextMinX.Text = MinX
TextMinY.Text = MinY
TextMaxX.Text = MaxX
TextMaxY.Text = MaxY
layerCount = 0: dummyI = InStr(1, Layers, vbCr)
While dummyI > 0
dummyI = InStr(dummyI + 1, Layers, vbCr)
layerCount = layerCount + 1
Wend
If layerCount > 1 Then MsgBox layerCount & " layer names found: " & vbCr & vbLf & Layers
If BlockFound = True Then MsgBox "DXF-File contains blocks - not full supported!"
If Found3DFace = True Then
MsgBox "Found 3DFace data - will be plotted only on XY-projection, or use 3DFACE to plot projections on XY, XZ and YZ planes"
cmd3DFACE.Enabled = True
Else
cmd3DFACE.Enabled = False
End If
End Sub
Private Sub Form_Resize()
Dim ScalingX, ScalingY
Picture1.Height = Main.Height - Picture1.Top - Picture1.Left
Picture1.Width = Main.Width - Picture1.Left * 2
If MaxX <> MinX Then ScalingX = (Picture1.Width - 2 * BorderX) / (MaxX - MinX)
If MaxY <> MinY Then ScalingY = (Picture1.Height - 2 * BorderY) / (MaxY - MinY)
If ScalingX > ScalingY Then Scaling = ScalingY Else Scaling = ScalingX
If Scaling > 10 Then Scaling = CInt(Int(Scaling))
TextScaling.Text = Scaling
End Sub