How to switch between Gateways with VB6 code

Question

0.00/5 (No votes)

See more:

VB6

Windows

Hi !

How to switch between Gateways and set IP with VB6 code ?
Please help me .

Thanks .

Posted 20-Aug-11 20:06pm

Nader Barman

Add a Solution

Comments

Christian Graus 21-Aug-11 2:19am

I doubt this is possible. VB6 is obsolete by a decade and was always horrible. If you can do this, it's probably by calling C++ code to do it through COM.

2 solutions

Add a Solution

Add your solution here

Treat my content as plain text, not as HTML

Preview 0

…

Existing Members

Sign in to your account

...or Join us

Download, Vote, Comment, Publish.

Your Email
Password
Forgot your password?

Your Email
This email is in use. Do you need your password?
Optional Password

I have read and agree to the Terms of Service and Privacy Policy
Please subscribe me to the CodeProject newsletters

When answering a question please:

Read the question carefully.
Understand that English isn't everyone's first language so be lenient of bad spelling and grammar.
If a question is poorly phrased then either ask for clarification, ignore it, or edit the question and fix the problem. Insults are not welcome.
Don't tell someone to read the manual. Chances are they have and don't get it. Provide an answer or move on to the next question.

Let's work to help developers, not make them feel stupid.

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

Aydin Homay · Answer 1 · 2013-07-16T18:42:00

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.

Enfineon · Answer 2 · 2013-07-16T12:04:00

VB

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

How to switch between Gateways with VB6 code

2 solutions

Solution 2

Solution 1

Add your solution here

Preview 0