Bar Codin' Blues

Other Versions
Spanish
A Visual Basic script can generate bar codes for inputting CNC instructions. April 10, 2005

Question
I’ve written an application in Visual Basic that will generate the code to mill my parts for beaded face frames. The problem is, while the code gets generated in a heart beat, getting an average of 100 individual files loaded into the control is a tedious as ever.

The obvious answer is bar coding. Unfortunately, I’m completely clueless about how to proceed so I’m asking for help. The programs are written using Alpha CAM Advanced Router. The machine itself is an Anderson Stratos SUP with a Fanuc 210i control (PC front end) which is networked to the office. Thanks in advance.

Forum Responses
(CNC Forum)
From contributor A:
Stiles has new product called Scan manager that looks like it might do the job for you.



From contributor B:
Seeing as how you have used VB to create your machining, you might try this bit of VBA to create bar codes.

Option Compare Database 'Use database order for string comparisons

Option Explicit

Function MD_Barcode39(Ctrl As Control, Rpt As Report)

On Error GoTo ErrorTrap_BarCode39

Dim Nbar As Single, Wbar As Single, Qbar As Single, NextBar As Single

Dim CountX As Single, CountY As Single, CountR As Single

Dim Parts As Single, Pix As Single, Color As Long, BarStamp As Variant

Dim Stripes As String, OneStripe As String, BARCODE As String

Dim Mx As Single, my As Single, Sx As Single, Sy As Single

Const White = 16777215: Const Black = 0

Const Nratio = 20, Wratio = 55, Qratio = 35

Sx = Ctrl.Left: Sy = Ctrl.Top: Mx = Ctrl.Width: my = Ctrl.Height

BARCODE = Ctrl

Parts = (Len(BARCODE) + 2) * ((6 * Nratio) + (3 * Wratio) + (1 * Qratio))

Pix = (Mx / Parts):

Nbar = (20 * Pix): Wbar = (55 * Pix): Qbar = (35 * Pix)

NextBar = Sx

Color = White

BarStamp = "*" & UCase(BARCODE) & "*"

For CountX = 1 To Len(BarStamp)

Stripes = MD_BC39(Mid$(BarStamp, CountX, 1))

For CountY = 1 To 9

OneStripe = Mid$(Stripes, CountY, 1)

If Color = White Then Color = Black Else Color = White

Select Case OneStripe

Case "1"

Rpt.Line (NextBar, Sy)-Step(Wbar, my), Color, BF

NextBar = NextBar + Wbar 'WideBar

Case "0"

Rpt.Line (NextBar, Sy)-Step(Nbar, my), Color, BF

NextBar = NextBar + Nbar 'NarrowBar

End Select

Next CountY

If Color = White Then Color = Black Else Color = White

Rpt.Line (NextBar, Sy)-Step(Qbar, my), Color, BF

NextBar = NextBar + Qbar 'Intermediate Quiet Bar

Next CountX

Exit_BarCode39:

Exit Function

ErrorTrap_BarCode39:

Resume Exit_BarCode39

End Function

Function BatchPrint()

DoCmd.SetWarnings False

DoCmd.OpenReport "Labels TBL_UNIT", acNormal

DoCmd.OpenQuery "QRY_DELETE_TEMP_PRINT", acNormal, acEdit

DoCmd.SetWarnings True

End Function

Function MD_BC39(CharCode As String) As String

On Error GoTo ErrorTrap_BC39

ReDim BC39(90)

BC39(32) = "011000100" ' space

BC39(36) = "010101000" ' $

BC39(37) = "000101010" ' %

BC39(42) = "010010100" ' * Start/Stop

BC39(43) = "010001010" ' +

BC39(45) = "010000101" ' |

BC39(46) = "110000100" ' .

BC39(47) = "010100010" ' /

BC39(48) = "000110100" ' 0

BC39(49) = "100100001" ' 1

BC39(50) = "001100001" ' 2

BC39(51) = "101100000" ' 3

BC39(52) = "000110001" ' 4

BC39(53) = "100110000" ' 5

BC39(54) = "001110000" ' 6

BC39(55) = "000100101" ' 7

BC39(56) = "100100100" ' 8

BC39(57) = "001100100" ' 9

BC39(65) = "100001001" ' A

BC39(66) = "001001001" ' B

BC39(67) = "101001000" ' C

BC39(68) = "000011001" ' D

BC39(69) = "100011000" ' E

BC39(70) = "001011000" ' F

BC39(71) = "000001101" ' G

BC39(72) = "100001100" ' H

BC39(73) = "001001100" ' I

BC39(74) = "000011100" ' J

BC39(75) = "100000011" ' K

BC39(76) = "001000011" ' L

BC39(77) = "101000010" ' M

BC39(78) = "000010011" ' N

BC39(79) = "100010010" ' O

BC39(80) = "001010010" ' P

BC39(81) = "000000111" ' Q

BC39(82) = "100000110" ' R

BC39(83) = "001000110" ' S

BC39(84) = "000010110" ' T

BC39(85) = "110000001" ' U

BC39(86) = "011000001" ' V

BC39(87) = "111000000" ' W

BC39(88) = "010010001" ' X

BC39(89) = "110010000" ' Y

BC39(90) = "011010000" ' Z

MD_BC39 = BC39(Asc(CharCode))

Exit_BC39:

Exit Function

ErrorTrap_BC39:

MD_BC39 = ""

Resume Exit_BC39

End Function



From the original questioner:
To contributor B: Wow! Thanks. That's another aspect of the process I knew I'd have to tackle. I'll try your function when I get to the shop on Monday morning! To contributor A: Thanks for the lead about Stiles. They're a bit steep in price $2,500 plus of course I've got to pay a guy to come and plug it in for me. If I can't find it cheaper, I'll be getting it from them though.