如何使用VB6代码在网关之间切换 [英] How to switch between Gateways with VB6 code
本文介绍了如何使用VB6代码在网关之间切换的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!
问题描述
嗨!
如何在网关之间切换并用VB6代码设置IP?
请帮助我。
谢谢。
Hi !
How to switch between Gateways and set IP with VB6 code ?
Please help me .
Thanks .
推荐答案
您好b $ b
要获得答案,请关注链接:
用于VB的高性能TCP / IP套接字服务器COM组件 [ ^ ]
使用Winsock创建客户端/服务器应用程序 [ ^ ]
高性能TCP / IP套接字服务器VB的COM组件 [ ^ ]
http://vbnet.mvps.org/index.html?code/internet/chat.htm [ ^ ]
如果你想得到真的关于vb6中TCP / IP编程的好概念请点击此链接:
http://www.codeguru.com/vb/vb_internet/aspnet/article.php/c19533/Creating-a-TCP-Component-in-Visual- Basic.htm [ ^ ]
最好的问候。
Hi
For the getting your answer please follow of links:
A high performance TCP/IP socket server COM component for VB[^]
Creating Client/Server Application using Winsock[^]
A high performance TCP/IP socket server COM component for VB[^]
http://vbnet.mvps.org/index.html?code/internet/chat.htm[^]
And if you want get the really good concept about TCP/IP programming in vb6 please follow this link:
http://www.codeguru.com/vb/vb_internet/aspnet/article.php/c19533/Creating-a-TCP-Component-in-Visual-Basic.htm[^]
Best Regards.
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 'Windows Default
Begin VB.CommandButton cmd3DFACE
Caption = "3DFACE"
Enabled = 0 'False
Height = 252
Left = 960
TabIndex = 17
Top = 1200
Width = 732
End
Begin VB.CommandButton cmdPLOT
Caption = "plot"
Enabled = 0 'False
Height = 252
Left = 960
Style = 1 'Graphical
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 'True
Height = 4812
Left = 0
ScaleHeight = 4764
ScaleWidth = 7164
TabIndex = 4
Top = 1560
Width = 7212
End
Begin VB.CommandButton CmdGCode
Caption = "ISO-Code"
Enabled = 0 'False
Height = 252
Left = 120
Style = 1 'Graphical
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 'Graphical
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
' ScalingX = (Picture1.Width - 2 * BorderX) / (MaxX - MinX)
' ScalingY = (Picture1.Height - 2 * BorderY) / (MaxY - MinY)
' ScalingZ1 = (Picture1.Width - 2 * BorderX) / (MaxZ - MinZ)
' ScalingZ2 = (Picture1.Height - 2 * BorderY) / (MaxZ - MinZ)
' If ScalingX > ScalingY Then Scaling = ScalingY Else Scaling = ScalingX
' If Scaling > ScalingZ1 Then Scaling = ScalingZ1
' If Scaling > ScalingZ2 Then Scaling = ScalingZ2
Scaling = Val(Replace(TextScaling.Text, ",", "."))
cmd3DFACE.BackColor = vbYellow
DoEvents
Open LabelFileName.Caption For Input As #1
Call DXFGo2Entities 'skip all other sections
Codes = ReadCodes()
Do While Not EOF(1) ' Loop until end of file.
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 'skip all other sections
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) ' Loop until end of file.
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 'skip all other sections
If Not EOF(1) Then Codes = ReadCodes()
Do While Not EOF(1) ' Loop until end of file.
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 (*.*)|*.*"
' Specify default filter
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:
'User pressed the Cancel button
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 'lunghezza della corda - length of the cord
Dim H 'altezza del triangolo - height of the triangle
Dim alpha2 'mezzo angolo di arco - half arc angle
Dim beta 'angolo della corda rispetto agli assi - orientation of the segment
Dim dummy
' The bulge is the tangent of one fourth the
' included angle for an arc segment, made negative if the arc goes
' clockwise from the start point to the endpoint.
' A bulge of 0 indicates a straight segment,
' and a bulge of 1 is a semicircle
'abbiamo la corda e la tangente dell'angolo della corda (0=Nord)
'We have the cord and the tangent of the arc radius
' C=2R sin (Alpha/2)
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
' MsgBox "P1=(" & X1 & " ; " & Y1 & ")" & vbCr & vbLf & _
"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
'clip angles to 0...2pi
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 'Se closedLine contiene le coordinate del vertice di partenza
'Reminds the first vertex for the closed line attribute
Dim X1, Y1 'coordinate del vertice precedente - last vertex
Dim X, Y 'coordinate del vertice attuale - actual vertex
Dim Bulge, Bulge1 '
Dim R 'raggio - radius
Dim alphafrom, alphato 'angolo di inizio e di fine - starting and ending angle
Dim i, J 'centro dell'arco - realtive arc center
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" ' POLYLINE end with 'SEQEND'
'sometimes there are problems with decimal point place holder
Codes(1) = Replace(Codes(1), ",", ".")
Select Case Codes(0)
Case 8 'Layer Name
Case 6 'Line Type
Case 40 'Start width
Case 41 'End width
Case 66 'Obsolete (variable attributes flag)
Case 70 'Polyline flag (bit-coded; default = 0):
If Codes(1) And 1 = 1 Then 'This is a closed polyline (or a polygon mesh closed in the M direction)
ClosedLine = True
End If
'other flags non supported
Case 10 'X coordinate value
X = Val(Codes(1))
Case 20 'Y coordinate value
Y = Val(Codes(1))
Case 42 'Bulge - questo ci complica la vita...
'Bulge (optional; default is 0). The bulge is the tangent of one fourth the
'included angle for an arc segment, made negative if the arc goes
'clockwise from the start point to the endpoint. A bulge of 0 indicates a
'straight segment, and a bulge of 1 is a semicircle
Bulge = Val(Codes(1))
Case 0 'Entity type (vertex)
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 & ";" 'traccia la linea
X0 = X 'remember first vertex, it may be closedline!
Y0 = Y
End If
If VertexCount > 1 Then
'With 2 vertex we can draw the first segment
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 & ";" 'traccia la linea
'let's draw it!
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 & "; " 'traccia l'arco
Else
Print #2, LineNumberStr(LineNumber) & " G02 " & LineStr & "; " 'traccia l'arco
End If
'let's draw it!
Picture1.Circle (Xg, Yg), Rg, , alphafrom, alphato
End If
End If
Bulge1 = Bulge
Bulge = 0
X1 = X
Y1 = Y
End If
Case Else
'not supported
End Select
' Read another code value pair
Codes = ReadCodes
Wend
'We have to draw the last segment!
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 & ";" 'traccia la linea
'let's draw it!
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 & "; " 'traccia l'arco
Else
Print #2, LineNumberStr(LineNumber) & " G02 " & LineStr & "; " 'traccia l'arco
End If
'let's draw it!
Picture1.Circle (Xg, Yg), Rg, , alphafrom, alphato
End If
'If closedline we have to draw from the last vertex to the first
If ClosedLine Then ' could be bulge...
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 & ";" 'traccia la linea
'let's draw it!
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 & "; " 'traccia l'arco
Else
Print #2, LineNumberStr(LineNumber) & " G02 " & LineStr & "; " 'traccia l'arco
End If
'let's draw it!
Picture1.Circle (Xg, Yg), Rg, , alphafrom, alphato
End If
End If
End Sub
Private Sub DXFPolyLine_DrawOnly()
Dim LineStr
Dim VertexCount
Dim X0, Y0 'Se closedLine contiene le coordinate del vertice di partenza
'Reminds the first vertex for the closed line attribute
Dim X1, Y1 'coordinate del vertice precedente - last vertex
Dim X, Y 'coordinate del vertice attuale - actual vertex
Dim Bulge, Bulge1 '
Dim R 'raggio - radius
Dim alphafrom, alphato 'angolo di inizio e di fine - starting and ending angle
Dim i, J 'centro dell'arco - realtive arc center
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" ' POLYLINE end with 'SEQEND'
'sometimes there are problems with decimal point place holder
Codes(1) = Replace(Codes(1), ",", ".")
Select Case Codes(0)
Case 8 'Layer Name
Case 6 'Line Type
Case 40 'Start width
Case 41 'End width
Case 66 'Obsolete (variable attributes flag)
Case 70 'Polyline flag (bit-coded; default = 0):
If (Val(Codes(1)) And 1) = 1 Then 'This is a closed polyline (or a polygon mesh closed in the M direction)
ClosedLine = True
End If
'other flags non supported
Case 10 'X coordinate value
X = Val(Codes(1))
Case 20 'Y coordinate value
Y = Val(Codes(1))
Case 42 'Bulge - questo ci complica la vita...
'Bulge (optional; default is 0). The bulge is the tangent of one fourth the
'included angle for an arc segment, made negative if the arc goes
'clockwise from the start point to the endpoint. A bulge of 0 indicates a
'straight segment, and a bulge of 1 is a semicircle
Bulge = Val(Codes(1))
Case 0 'Entity type (vertex)
If Codes(1) = "VERTEX" Then
VertexCount = VertexCount + 1
If VertexCount = 1 Then
X0 = X 'remember first vertex, it may be closedline!
Y0 = Y
End If
If VertexCount > 1 Then
'With 2 vertex we can draw the first segment
Call Bulge2IJ(X1, Y1, X, Y, Bulge1, i, J, R, alphafrom, alphato, Xg, Yg, Rg)
If Bulge1 = 0 Then
'let's draw it!
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
'let's draw it!
Picture1.Circle (Xg, Yg), Rg, , alphafrom, alphato
End If
End If
Bulge1 = Bulge
Bulge = 0
X1 = X
Y1 = Y
End If
Case Else
'not supported
End Select
' Read another code value pair
Codes = ReadCodes
Wend
'We have to draw the last segment!
Call Bulge2IJ(X1, Y1, X, Y, Bulge1, i, J, R, alphafrom, alphato, Xg, Yg, Rg)
If Bulge1 = 0 Then
'let's draw it!
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
'let's draw it!
Picture1.Circle (Xg, Yg), Rg, , alphafrom, alphato
End If
'If closedline we have to draw from the last vertex to the first
If ClosedLine Then ' could be bulge...
Call Bulge2IJ(X, Y, X0, Y0, Bulge, i, J, R, alphafrom, alphato, Xg, Yg, Rg)
If Bulge1 = 0 Then
'let's draw it!
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
'let's draw it!
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 ' 3DFace ends with next entitie
'sometimes there are problems with decimal point place holder
Codes(1) = Replace(Codes(1), ",", ".")
Select Case Codes(0)
Case 10 'X coordinate value
X0 = Val(Codes(1)): VertexCount = 1
Case 20 'Y coordinate value
Y0 = Val(Codes(1)): VertexCount = 1
Case 11 'X coordinate value
X1 = Val(Codes(1)): VertexCount = 2
Case 21 'Y coordinate value
Y1 = Val(Codes(1)): VertexCount = 2
Case 12 'X coordinate value
X2 = Val(Codes(1)): VertexCount = 3
Case 22 'Y coordinate value
Y2 = Val(Codes(1)): VertexCount = 3
Case 13 'X coordinate value
X3 = Val(Codes(1)): VertexCount = 4
Case 23 'Y coordinate value
Y3 = Val(Codes(1)): VertexCount = 4
Case Else
'not supported
End Select
' Read another code value pair
Codes = ReadCodes
Wend
'We have to draw the face!
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)
'Plane XY
Picture1.Line ((X0 - MinX) * Scaling / 2, Picture1.Height - (Y0 - MinY) * Scaling / 2 - BorderY) _
-((X1 - MinX) * Scaling / 2, Picture1.Height - (Y1 - MinY) * Scaling / 2 - BorderY)
'Plane YZ
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)
'Plane XZ
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 ' 3DFace ends with next entitie
'sometimes there are problems with decimal point place holder
Codes(1) = Replace(Codes(1), ",", ".")
Select Case Codes(0)
Case 10 'X coordinate value
X0 = Val(Codes(1)): VertexCount = 1
Case 20 'Y coordinate value
Y0 = Val(Codes(1)): VertexCount = 1
Case 30 'Z coordinate value
Z0 = Val(Codes(1)): VertexCount = 1
Case 11 'X coordinate value
X1 = Val(Codes(1)): VertexCount = 2
Case 21 'Y coordinate value
Y1 = Val(Codes(1)): VertexCount = 2
Case 31 'Z coordinate value
Z1 = Val(Codes(1)): VertexCount = 2
Case 12 'X coordinate value
X2 = Val(Codes(1)): VertexCount = 3
Case 22 'Y coordinate value
Y2 = Val(Codes(1)): VertexCount = 3
Case 32 'Z coordinate value
Z2 = Val(Codes(1)): VertexCount = 3
Case 13 'X coordinate value
X3 = Val(Codes(1)): VertexCount = 4
Case 23 'Y coordinate value
Y3 = Val(Codes(1)): VertexCount = 4
Case 33 'Z coordinate value
Z3 = Val(Codes(1)): VertexCount = 4
Case Else
'not supported
End Select
' Read another code value pair
Codes = ReadCodes
Wend
'We have to draw the face!
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) 'Line ends with next entitie declaration
'sometimes there are problems with decimal point place holder
Codes(1) = Replace(Codes(1), ",", ".")
Select Case Codes(0)
Case 8 'Layer Name
Case 6 'Line Type
Case 40 'Start width
Case 41 'End width
Case 66 'Obsolete (variable attributes flag)
Case 10 'X coordinate value start point
X1 = Val(Codes(1))
Case 20 'Y coordinate value start point
Y1 = Val(Codes(1))
Case 11 'X coordinate value end point
X2 = Val(Codes(1))
Case 21 'Y coordinate value end point
Y2 = Val(Codes(1))
Case 0 'Next Entity type --> this one is complete
'Ho notato dei problemi di notazione scientifica e con la virgola
'quindi devo usare format.
'I have seen problems with the scientific notation, we have to use format!
LineStr = "X" & Format(X1, IsoFormat) & " Y" & Format(Y1, IsoFormat)
'Però format è bastardo: invece di mettere il punto mi mette . o , a dipendenza del paese
'Quindi devo rimpiazzare a mano la , con . per sicurezza!
'Caveat: format uses the decimal placeholder of the country - coul be . or ,
'But ISO-code needs always . --> let's replace , by . to avoid problems!
LineStr = Replace(LineStr, ",", ".")
Print #2, LineNumberStr(LineNumber) & " G00 " & LineStr & ";" 'posizioniamoci senza disegnare
LineStr = "X" & Format(X2, IsoFormat) & " Y" & Format(Y2, IsoFormat)
LineStr = Replace(LineStr, ",", ".")
Print #2, LineNumberStr(LineNumber) & " G01 " & LineStr & ";" 'traccia la linea
'let's draw it!
Picture1.Line ((X1 - MinX) * Scaling + BorderX, Picture1.Height - (Y1 - MinY) * Scaling - BorderY)-((X2 - MinX) * Scaling + BorderX, Picture1.Height - (Y2 - MinY) * Scaling - BorderY)
Exit Sub 'linea terminata: esci
End Select
' Read another code value pair
Codes = ReadCodes
Wend
End Sub
Private Sub DXFLine_DrawOnly()
Dim X1, Y1, X2, Y2, LineStr
Codes = ReadCodes
While Not EOF(1) 'Line ends with next entitie declaration
'sometimes there are problems with decimal point place holder
Codes(1) = Replace(Codes(1), ",", ".")
Select Case Codes(0)
Case 8 'Layer Name
Case 6 'Line Type
Case 40 'Start width
Case 41 'End width
Case 66 'Obsolete (variable attributes flag)
Case 10 'X coordinate value start point
X1 = Val(Codes(1))
Case 20 'Y coordinate value start point
Y1 = Val(Codes(1))
Case 11 'X coordinate value end point
X2 = Val(Codes(1))
Case 21 'Y coordinate value end point
Y2 = Val(Codes(1))
Case 0 'Next Entity type --> this one is complete
'let's draw it!
Picture1.Line ((X1 - MinX) * Scaling + BorderX, Picture1.Height - (Y1 - MinY) * Scaling - BorderY)-((X2 - MinX) * Scaling + BorderX, Picture1.Height - (Y2 - MinY) * Scaling - BorderY)
Exit Sub 'linea terminata: esci
End Select
' Read another code value pair
Codes = ReadCodes
Wend
End Sub
Private Sub DXFPoint_DrawOnly()
Dim X1, Y1, LineStr
Codes = ReadCodes
While Not EOF(1) 'Point ends with next entitie decalration
'sometimes there are problems with decimal point place holder
Codes(1) = Replace(Codes(1), ",", ".")
Select Case Codes(0)
Case 8 'Layer Name
Case 6 'Line Type
Case 40 'Start width
Case 41 'End width
Case 66 'Obsolete (variable attributes flag)
Case 10 'X coordinate value point
X1 = Val(Codes(1))
Case 20 'Y coordinate value point
Y1 = Val(Codes(1))
Case 0 ''Next Entity type --> this one is complete
'let's draw it! non esiste point
Picture1.Line ((X1 - MinX) * Scaling + BorderX, Picture1.Height - (Y1 - MinY) * Scaling - BorderY)-((X1 - MinX) * Scaling + BorderX, Picture1.Height - (Y1 - MinY) * Scaling - BorderY)
Exit Sub 'linea terminata: esci
End Select
' Read another code value pair
Codes = ReadCodes
Wend
End Sub
Private Sub DXFPoint()
Dim X1, Y1, LineStr
Codes = ReadCodes
While Not EOF(1) 'Point ends with next entitie decalration
'sometimes there are problems with decimal point place holder
Codes(1) = Replace(Codes(1), ",", ".")
Select Case Codes(0)
Case 8 'Layer Name
Case 6 'Line Type
Case 40 'Start width
Case 41 'End width
Case 66 'Obsolete (variable attributes flag)
Case 10 'X coordinate value point
X1 = Val(Codes(1))
Case 20 'Y coordinate value point
Y1 = Val(Codes(1))
Case 0 ''Next Entity type --> this one is complete
'Ho notato dei problemi di notazione scientifica e con la virgola
'quindi devo usare format.
LineStr = "X" & Format(X1, IsoFormat) & " Y" & Format(Y1, IsoFormat)
LineStr = Replace(LineStr, ",", ".")
Print #2, LineNumberStr(LineNumber) & " G00 " & LineStr & ";" 'posizioniamoci senza disegnare
'let's draw it! non esiste point
Picture1.Line ((X1 - MinX) * Scaling + BorderX, Picture1.Height - (Y1 - MinY) * Scaling - BorderY)-((X1 - MinX) * Scaling + BorderX, Picture1.Height - (Y1 - MinY) * Scaling - BorderY)
Exit Sub 'linea terminata: esci
End Select
' Read another code value pair
Codes = ReadCodes
Wend
End Sub
Private Sub DXFText_DrawOnly()
Dim X1, Y1, Text, Rot
Codes = ReadCodes
While Not EOF(1) 'Point ends with next entitie decalration
'sometimes there are problems with decimal point place holder
Codes(1) = Replace(Codes(1), ",", ".")
Select Case Codes(0)
Case 1 'Text
Text = Codes(1)
Case 8 'Layer Name
Case 6 'Line Type
Case 40 'Start width
Case 41 'End width
Case 50 'Text rotation
Rot = Val(Codes(1))
Case 66 'Obsolete (variable attributes flag)
Case 10 'X coordinate value point
X1 = Val(Codes(1))
Case 20 'Y coordinate value point
Y1 = Val(Codes(1))
Case 0 ''Next Entity type --> this one is complete
'let's draw it! non esiste point
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 'linea terminata: esci
End Select
' Read another code value pair
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) 'Arc ends with next entitie declaration
'sometimes there are problems with decimal point place holder
Codes(1) = Replace(Codes(1), ",", ".")
Select Case Codes(0)
Case 8 'Layer Name
Case 6 'Line Type
Case 41 'End width
Case 66 'Obsolete (variable attributes flag)
Case 50 'Start Angle
A1 = Val(Codes(1))
Case 51 'Stop Angle
A2 = Val(Codes(1))
Case 10 'X coordinate value start point
X = Val(Codes(1))
Case 20 'Y coordinate value start point
Y = Val(Codes(1))
Case 40 'Radius
R = Val(Codes(1))
Case 0 'Next Entity type --> this one is complete
'G-code vuole punto di inizio, centro relativo, punto finale
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
'Ho notato dei problemi di notazione scientifica e con la virgola
'quindi devo usare format.
LineStr = "X" & Format(X1, IsoFormat) & " Y" & Format(Y1, IsoFormat)
LineStr = Replace(LineStr, ",", ".")
Print #2, LineNumberStr(LineNumber) & " G00 " & LineStr & ";" 'posizioniamoci senza disegnare
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 & "; " 'traccia l'arco
'let's draw it!
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 'linea terminata: esci
End Select
' Read another code value pair
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) 'Arc ends with next entitie declaration
'sometimes there are problems with decimal point place holder
Codes(1) = Replace(Codes(1), ",", ".")
Select Case Codes(0)
Case 8 'Layer Name
Case 6 'Line Type
Case 41 'End width
Case 66 'Obsolete (variable attributes flag)
Case 50 'Start Angle
A1 = Val(Codes(1))
Case 51 'Stop Angle
A2 = Val(Codes(1))
Case 10 'X coordinate value start point
X = Val(Codes(1))
Case 20 'Y coordinate value start point
Y = Val(Codes(1))
Case 40 'Radius
R = Val(Codes(1))
Case 0 'Next Entity type --> this one is complete
'G-code vuole punto di inizio, centro relativo, punto finale
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
'let's draw it!
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 'linea terminata: esci
End Select
' Read another code value pair
Codes = ReadCodes
Wend
End Sub
Private Sub DXFCircle()
Dim X, Y, X1, Y1, X2, Y2, R, LineStr
Codes = ReadCodes
While Not EOF(1) 'Arc ends with next entitie decalration
'sometimes there are problems with decimal point place holder
Codes(1) = Replace(Codes(1), ",", ".")
Select Case Codes(0)
Case 8 'Layer Name
Case 6 'Line Type
Case 41 'End width
Case 66 'Obsolete (variable attributes flag)
Case 10 'X coordinate value start point
X = Val(Codes(1))
Case 20 'Y coordinate value start point
Y = Val(Codes(1))
Case 40 'Radius
R = Val(Codes(1))
Case 0 'Next Entity type --> this one is complete
'G-code vuole punto di inizio, centro relativo, punto finale
X1 = X + R
Y1 = Y
X2 = X - R
Y2 = Y
'I = -R
'J = 0
'Ho notato dei problemi di notazione scientifica e con la virgola
'quindi devo usare format.
LineStr = "X" & Format(X1, IsoFormat) & " Y" & Format(Y1, IsoFormat)
LineStr = Replace(LineStr, ",", ".")
Print #2, LineNumberStr(LineNumber) & " G00 " & LineStr & ";" 'posizioniamoci senza disegnare
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 & "; " 'traccia l'arco
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 & "; " 'traccia l'arco
'let's draw it!
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 'linea terminata: esci
End Select
' Read another code value pair
Codes = ReadCodes
Wend
End Sub
Private Sub DXFCircle_DrawOnly()
Dim X, Y, X1, Y1, X2, Y2, R, LineStr
Codes = ReadCodes
While Not EOF(1) 'Arc ends with next entitie decalration
'sometimes there are problems with decimal point place holder
Codes(1) = Replace(Codes(1), ",", ".")
Select Case Codes(0)
Case 8 'Layer Name
Case 6 'Line Type
Case 41 'End width
Case 66 'Obsolete (variable attributes flag)
Case 10 'X coordinate value start point
X = Val(Codes(1))
Case 20 'Y coordinate value start point
Y = Val(Codes(1))
Case 40 'Radius
R = Val(Codes(1))
Case 0 'Next Entity type --> this one is complete
'G-code vuole punto di inizio, centro relativo, punto finale
X1 = X + R
Y1 = Y
X2 = X - R
Y2 = Y
'let's draw it!
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 'linea terminata: esci
End Select
' Read another code value pair
Codes = ReadCodes
Wend
End Sub
Private Sub DXFGo2Entities()
Codes = ReadCodes
' we are only interested in the entities section!
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 'skip all other sections
Open LabelGFile.Caption For Output As #2
Print #2, LineNumberStr(LineNumber) & " G90; # absolute coordinates "
Print #2, LineNumberStr(LineNumber) & " G71; # metric programming unit "
' Print #2, LineNumberStr(LineNumber) & " G00 X0 Y0; # contour starting point "
Codes = ReadCodes()
Do While Not EOF(1) ' Loop until end of file.
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 'for block warning
Dim Found3DFace As Boolean 'for block warning
'parse the file for min/max coordinates to autoscale the drawing
FirstX = True: FirstY = True: FirstZ = True
BlockFound = False: Found3DFace = False
DoEvents
Open LabelFileName.Caption For Input As #1
Call DXFGo2Entities ' skip all other sections
Do While Not EOF(1) ' Loop until end of file.
Codes = ReadCodes()
'Codes(0) è un numero (Tag)
'Codes(1) è un nome/dato/...
'Ad esempio:
' 10 X value Startpoint
'sometimes there are problems with decimal point place holder
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 'for example polyline to avoid dummy point
End Select
End If
If GoodEntitie Then 'to avoid dummy point in polyline
Select Case Codes(0)
Case 8
If (InStr(Layers, Codes(1)) > 0) Then
'already collected
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
'Bulge - if the bulge is on the outside/limits of
'the drawing, the scaling won't be exact, some
'clipping may occur!
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
这篇关于如何使用VB6代码在网关之间切换的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!
查看全文