TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Mark on October 08, 2009, 08:21:20 AM
-
Using PLINES create a barcode generator.
http://en.wikipedia.org/wiki/Code_128
Good luck!! 8-)
-
Interesting read Mark.
Thanks 8-)
-
Using PLINES create a barcode generator.
http://en.wikipedia.org/wiki/Code_128
Good luck!! 8-)
Hello Mark! :)
You wished to tell, code in the width lwpolyline?
The program should make a columns of vertical polylines of different width?
-
I found this interesting too. Although not the 128 code still a good read.
http://www.barcodeisland.com/code39.phtml
-
This will give you an idea of options needing to be addressed.
http://www.morovia.com/free-online-barcode-generator/
-
Using PLINES create a barcode generator.
http://en.wikipedia.org/wiki/Code_128
Good luck!! 8-)
Hello Mark! :)
You wished to tell, code in the width lwpolyline?
The program should make a columns of vertical polylines of different width?
Yes, to both questions.
-
Well I played with this long enough. I actually have work to do this morning
****NOT FULLY TESTED***
;;; ------------------------------------------------------------------------
;;; BARCODE.LSP
;;;
;;; Copyright © October, 2009
;;; Timothy G. Spangler
;;;
;;; Permission to use, copy, modify, and distribute this software
;;; for any purpose and without fee is hereby granted, provided
;;; that the above copyright notice appears in all copies and
;;; that both that copyright notice and the limited warranty and
;;; restricted rights notice below appear in all supporting
;;; documentation.
;;;
;;; Description:
;;; Creates a barcode from a piece of text
;;; ------------------------------------------------------------------------
(defun C:BARCODE (/ BarCodeText BarCodeList BarList TextLength Counter Char Bar OldLunits)
;; Set units to decimal
(setq OldLunits (getvar "LUNITS"))
(setvar "LUNITS" 2)
;; Get string to barcode
(if (= "" (setq BarCodeText (getstring "\n Enter text to barcode:<TEST>")))
(setq BarCodeText "TEST")
)
;; Set the barcode list 128B
(setq BarCodeList
(list
(cons "" 212222 )(cons "!" 222122)(cons "\"" 222221)(cons "#" 121223)
(cons "$" 121322)(cons "%" 131222)(cons "&" 122213)(cons "\'" 122312)
(cons "\(" 132212)(cons "\)" 221213)(cons "*" 221312)(cons "\+" 231212)
(cons "\," 112232)(cons "\-" 122132)(cons "\." 122231)(cons "\/" 113222)
(cons "0" 123122)(cons "1" 123221)(cons "2" 223211)(cons "3" 221132)
(cons "4" 221231)(cons "5" 213212)(cons "6" 223112)(cons "7" 312131)
(cons "8" 311222)(cons "9" 321122)(cons "\:" 321221)(cons "\;" 312212)
(cons "\<" 322112)(cons "\=" 322211)(cons "\>" 212123)(cons "\?" 212321)
(cons "@" 232121)(cons "A" 111323)(cons "B" 131123)(cons "C" 131321)
(cons "D" 112313)(cons "E" 132113)(cons "F" 132311)(cons "G" 211313)
(cons "H" 231113)(cons "I" 231311)(cons "J" 112133)(cons "K" 112331)
(cons "L" 132131)(cons "M" 113123)(cons "N" 113321)(cons "O" 133121)
(cons "P" 313121)(cons "Q" 211331)(cons "R" 231131)(cons "S" 213113)
(cons "T" 213311)(cons "U" 213131)(cons "V" 311123)(cons "W" 311321)
(cons "X" 331121)(cons "Y" 312113)(cons "Z" 312311)(cons "[" 332111)
(cons "\\" 314111)(cons "\]" 221411)(cons "^" 431111)(cons "_" 111224)
(cons "`" 111422)(cons "a" 121124)(cons "b" 121421)(cons "c" 141122)
(cons "d" 141221)(cons "e" 112214)(cons "f" 112412)(cons "g" 122114)
(cons "h" 122411)(cons "i" 142112)(cons "j" 142211)(cons "k" 241211)
(cons "l" 221114)(cons "m" 413111)(cons "n" 241112)(cons "o" 134111)
(cons "p" 111242)(cons "q" 121142)(cons "r" 121241)(cons "s" 114212)
(cons "t" 124112)(cons "u" 124211)(cons "v" 411212)(cons "w" 421112)
(cons "x" 421211)(cons "y" 212141)(cons "z" 214121)(cons "{" 412121)
(cons "|" 111143)(cons "}" 111341)(cons "~" 131141)
)
)
;; Start Barcode
(setq BarList (cons 211214 BarList))
;; Start Counter
(setq Counter 1)
;; Step throught text and create barcode list from it
(repeat (strlen BarCodeText)
(setq Char (substr BarCodeText Counter 1))
(setq Bar (cdr(assoc Char BarCodeList)))
(setq BarList (cons Bar BarList))
(setq Counter (1+ Counter))
)
;; End Barcode
(setq BarList (cons 2331112 BarList))
;; Reverse bar list
(setq BarList (reverse BarList))
;; Draw Bar
(DRAW_BAR BarList)
;; Reet units
(setvar "LUNITS" OldLunits)
;; Echo to the command line
(princ (strcat "\n Bar Code create for \"" BarCodeText "\""))
;; Quiet exit
(princ)
)
(defun DRAW_BAR (BarList / StartPoint BarPoint Counter BarCodeGroup Loop DrawBar BarChr )
;; Define start pont for barcode
(setq StartPoint (getpoint "\n Define starting point for barcode:"))
;; Start Counter
(setq Counter 0)
;; Step through barlist and draw barcodes
(repeat (length BarList)
;; Convert number to string
(setq BarCodeGroup (rtos (nth Counter BarList)2 0))
;; Start loop counter
(setq Loop 1)
;; Start with a bar
(setq DrawBar T)
;; Step through the bar code group
(repeat (strlen BarCodeGroup)
;; Break the bargroup down into bars
(setq BarChr (substr BarCodeGroup Loop 1))
;; Set the first point of charater
(setq BarPoint (polar StartPoint 0.0 (* 0.5 (atoi BarChr))))
(setq StartPoint (polar StartPoint 0.0 (atoi BarChr)))
;; Draw Bar
(if DrawBar
(progn
;; Draw the pline
(BAR_PLINE (list BarPoint (polar BarPoint (/ pi 2.0) 60.0)) (atoi BarChr))
;; Turn off draw bar
(setq DrawBar nil)
)
;; Turn on draw bar
(setq DrawBar T)
)
;; Add to the loop
(setq Loop (1+ Loop))
)
;; Add to the counter
(setq Counter (1+ Counter))
)
)
;; Draw pline for bar code
(defun BAR_PLINE (PointList Width / Group10List PolyLineList)
(setq PolyLineList
(list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 6 "Continuous")
(cons 8 "0")
(cons 43 Width)
(cons 90 (length PointList))
(cons 70 0)
)
)
(setq Group10List (mapcar '(lambda (Coord) (cons 10 Coord)) PointList))
(setq PolyLineList (append PolyLineList Group10List))
(entmakex PolyLineList)
)
;;;
;;; Echos to the command line
(princ "\nBarCode v1.0© \n Timothy Spangler, \n October, 2009....loaded.")
(print)
;;; End echo
*** Fixed Protected symbol error
-
Well I played with this long enough. I actually have work to do this morning
****NOT FULLY TESTED****
That is awesome Tim. 8-)
-
Just found that it only does single words, ie NO SPACES.
I will fix it later, after some other entries arrive :evil:
-
Hi Tim...Nice one !
I just found an protected function error..
....(/ BarCodeText BarCodeList BarList TextLength Counter Chr Bar OldLunits)
I have change the variable names.. and it work great.
-
Thanks Andrea,
Updated code above.
-
my version:
(defun c:barcod ( / A I L S X Y)
;; By ElpanovEvgeniy
;; barcod-128
(setq l '((32 . 212222) (33 . 222122) (34 . 222221) (35 . 121223) (36 . 121322)
(37 . 131222) (38 . 122213) (39 . 122312) (40 . 132212) (41 . 221213)
(42 . 221312) (43 . 231212) (44 . 112232) (45 . 122132) (46 . 122231) (47 . 113222)
(48 . 123122) (49 . 123221) (50 . 223211) (51 . 221132) (52 . 221231) (53 . 213212)
(54 . 223112) (55 . 312131) (56 . 311222) (57 . 321122) (58 . 321221) (59 . 312212)
(60 . 322112) (61 . 322211) (62 . 212123) (63 . 212321) (64 . 232121) (65 . 111323)
(66 . 131123) (67 . 131321) (68 . 112313) (69 . 132113) (70 . 132311) (71 . 211313)
(72 . 231113) (73 . 231311) (74 . 112133) (75 . 112331) (76 . 132131) (77 . 113123)
(78 . 113321) (79 . 133121) (80 . 313121) (81 . 211331) (82 . 231131) (83 . 213113)
(84 . 213311) (85 . 213131) (86 . 311123) (87 . 311321) (88 . 331121) (89 . 312113)
(90 . 312311) (91 . 332111) (92 . 314111) (93 . 221411) (94 . 431111) (95 . 111224)
(96 . 111422) (97 . 121124) (98 . 121421) (99 . 141122) (100 . 141221) (101 . 112214)
(102 . 112412) (103 . 122114) (104 . 122411) (105 . 142112) (106 . 142211) (107 . 241211)
(108 . 221114) (109 . 413111) (110 . 241112) (111 . 134111) (112 . 111242) (113 . 121142)
(114 . 121241) (115 . 114212) (116 . 124112) (117 . 124211) (118 . 411212) (119 . 421112)
(120 . 421211) (121 . 212141) (122 . 214121) (123 . 412121) (124 . 111143) (125 . 111341)
(126 . 131141) (0 . 211214) (128 . 2331112))
s (apply
(function strcat)
(cons (itoa (cdr (assoc 0 l)))
(reverse (cons (itoa (cdr (assoc 128 l)))
(reverse (mapcar (function (lambda (a) (itoa (cdr (assoc a l)))))
(vl-string->list (getstring "\n Enter text:\t"))
) ;_ mapcar
) ;_ reverse
) ;_ cons
) ;_ reverse
) ;_ cons
) ;_ apply
y (getpoint "\n Start point")
x (car y)
y (cadr y)
i nil
) ;_ setq
(while (/= (setq a (substr s 1 1)) "")
(if (setq a (atoi a)
i (not i)
) ;_ setq
(entmakex (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 43 a)
'(90 . 2)
(list 10 (+ x (/ a 2.)) y)
(list 10 (+ x (/ a 2.)) (+ y 50))
) ;_ list
) ;_ entmakex
) ;_ if
(setq x (+ a x)
s (substr s 2)
) ;_ setq
) ;_ while
)
-
well....nice ElpanovEvgeniy ..and Tim..
but we got diffrent result on start code..
-
That is a differance in either 128A - Elpanov and 128B - Me
-
From the Wiki
128A - ASCII characters 00 to 95 (0-9, A-Z and control codes) and special characters
128B - ASCII characters 32 to 127 (0-9, A-Z, a-z) and special characters
128C - 00-99 (double density encoding of numeric only data) and FNC1
-
oh ..I see..
thanks.
Now,..I'll try to make a barcode reader. (if (not (already done))....
:|
-
well....nice ElpanovEvgeniy ..and Tim..
but we got diffrent result on start code..
It is my error!
I as used barcod-128b, but by mistake, the beginning code has put barcod-128a
The code has already been corrected, but you have written the answer earlier.
-
Here is my 128B with the check character.
;|
Specification
A Code 128 barcode will have six sections:
* Quiet Zone
* Start Character
* Encoded Data
* Check Character
* Stop Character
* Quiet Zone
The check character is calculated from a weighted sum (modulo 103) of all the characters.
|;
;; CAB 10.08.09 Code 128B
(defun c:BarCode (/
str
;BarWidthUnits
;BarHeight
QuietZoneWidth
pt
)
(and
(setq str (getstring t "\nEnter text for Barcode: "))
;; may need to trim leading & trailing spaces or tabs?
(or BarWidthUnits
(setq BarWidthUnits (getint "\nEnter Unit width for each one Bar: "))
)
(or BarHeight (setq BarHeight (getdist "\nEnter Height of Barcode: ")))
(setq QuietZoneWidth 0.25)
(setq pt (getpoint "\nPick insert point, lower left."))
(AddBarCode str BarWidthUnits BarHeight QuietZoneWidth pt)
)
(princ)
)
(defun AddBarCode (str BarWidthUnits BarHeight QuietZoneWidth pt /
code letter codelist CheckDigitW CheckDigit BCdata idx )
(setq BCdata
'((" " 212222)("!" 222122)("\"" 222221)("#" 121223)("$" 121322)("%" 131222)("&" 122213)
("\'" 122312)("(" 132212)(")" 221213)("*" 221312)("+" 231212)("," 112232)("-" 122132)
("\." 122231)("/" 113222)("0" 123122)("1" 123221)("2" 223211)("3" 221132)("4" 221231)
("5" 213212)("6" 223112)("7" 312131)("8" 311222)("9" 321122)(":" 321221)(";" 312212)
("<" 322112)("=" 322211)(">" 212123)("?" 212321)("@" 232121)("A" 111323)("B" 131123)
("C" 131321)("D" 112313)("E" 132113)("F" 132311)("G" 211313)("H" 231113)("I" 231311)
("J" 112133)("K" 112331)("L" 132131)("M" 113123)("N" 113321)("O" 133121)("P" 313121)
("Q" 211331)("R" 231131)("S" 213113)("T" 213311)("U" 213131)("V" 311123)("W" 311321)
("X" 331121)("Y" 312113)("Z" 312311)("[" 332111)("\\" 314111)("]" 221411)("^" 431111)
("_" 111224)("`" 111422)("a" 121124)("b" 121421)("c" 141122)("d" 141221)("e" 112214)
("f" 112412)("g" 122114)("h" 122411)("i" 142112)("j" 142211)("k" 241211)("l" 221114)
("m" 413111)("n" 241112)("o" 134111)("p" 111242)("q" 121142)("r" 121241)("s" 114212)
("t" 124112)("u" 124211)("v" 411212)("w" 421112)("x" 421211)("y" 212141)("z" 214121)
("{" 412121)("|" 111143)("}" 111341)("~" 131141) (95 114113) (96 114311) (97 411113)
(98 411311)(99 113141) (100 114131) (101 311141)(102 411131) ))
(setq CodeList (mapcar (function(lambda(x)
(setq CheckDigitW (cons (vl-position (assoc (chr x) BCdata) BCData) CheckDigitW))
(cadr(assoc (chr x) BCdata)) )) (vl-string->list str)))
(defun MakeBar (letter / width code BarFlag)
(setq BarFlag t)
(foreach code (vl-string->list (itoa Letter))
(setq code (atoi (chr code))
width (* code BarWidthUnits))
(if BarFlag
(entmakex
(list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 43 width)
'(90 . 2)
(cons 10 (polar pt 0 (/ width 2.)))
(cons 10 (polar (polar pt 0 (/ width 2.)) (/ pi 2) BarHeight))
))
)
(setq pt (polar pt 0 width)
BarFlag (not BarFlag)
)
)
)
(setq CheckDigitW (reverse CheckDigitW))
(makebar 211214) ; Start 128B
(setq CheckDigit 104) ; Start 128B
(setq idx 1)
(foreach letter CodeList
(makebar letter)
(setq CheckDigit (+ CheckDigit (* idx (nth (1- idx) CheckDigitW))))
(setq idx (1+ idx))
)
(setq CheckDigit (rem CheckDigit 103))
(makebar (cadr (nth CheckDigit BCdata))) ; add the Check Character
(makebar 2331112) ; Stop
(princ)
)
<edit: bug in check character fixed, I think>
-
Gymnastics with a cup of morning coffee... :-)
(defun c:b2 (/ A S X Y)
;; By ElpanovEvgeniy
;; barcod-128-B
(setq s '(212222 222122 222221 121223 121322 131222 122213 122312
132212 221213 221312 231212 112232 122132 122231 113222
123122 123221 223211 221132 221231 213212 223112 312131
311222 321122 321221 312212 322112 322211 212123 212321
232121 111323 131123 131321 112313 132113 132311 211313
231113 231311 112133 112331 132131 113123 113321 133121
313121 211331 231131 213113 213311 213131 311123 311321
331121 312113 312311 332111 314111 221411 431111 111224
111422 121124 121421 141122 141221 112214 112412 122114
122411 142112 142211 241211 221114 413111 241112 134111
111242 121142 121241 114212 124112 124211 411212 421112
421211 212141 214121 412121 111143 111341 131141
)
s (strcat "211214"
(apply (function strcat)
(mapcar (function (lambda (a) (itoa (nth (- a 32) s))))
(vl-string->list (getstring "\n Enter text: "))
) ;_ mapcar
) ;_ apply
"2331112"
) ;_ strcat
y (getpoint "\n Start point: ")
x (car y)
y (cadr y)
) ;_ setq
(repeat (1+ (/ (strlen s) 2))
(if (setq a (atoi (substr s 1 1)))
(entmakex (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 43 a)
'(90 . 2)
(list 10 (+ x (/ a 2.)) y)
(list 10 (+ x (/ a 2.)) (+ y 50))
) ;_ list
) ;_ entmakex
) ;_ if
(setq x (+ a x (atoi (substr s 2 1)))
s (substr s 3)
) ;_ setq
) ;_ repeat
)
-
Has added Check Digit Calculation
(defun c:b2 (/ A S X Y)
;; By ElpanovEvgeniy
;; barcod-128-B
;; add check character
(setq s '(212222 222122 222221 121223 121322 131222 122213 122312
132212 221213 221312 231212 112232 122132 122231 113222
123122 123221 223211 221132 221231 213212 223112 312131
311222 321122 321221 312212 322112 322211 212123 212321
232121 111323 131123 131321 112313 132113 132311 211313
231113 231311 112133 112331 132131 113123 113321 133121
313121 211331 231131 213113 213311 213131 311123 311321
331121 312113 312311 332111 314111 221411 431111 111224
111422 121124 121421 141122 141221 112214 112412 122114
122411 142112 142211 241211 221114 413111 241112 134111
111242 121142 121241 114212 124112 124211 411212 421112
421211 212141 214121 412121 111143 111341 131141 114113
114311 411113 411311 113141 114131 311141 411131
)
x 104
y 0
s (strcat "211214"
(apply (function strcat)
(mapcar (function (lambda (a / i)
(setq i (if (< a 145)
32
145
) ;_ if
y (1+ y)
x (+ x (* (- a i) y))
) ;_ setq
(itoa (nth (- a i) s))
) ;_ lambda
) ;_ function
(vl-string->list (getstring "\n Enter text: "))
) ;_ mapcar
) ;_ apply
(itoa (nth (rem x 103) s))
"2331112"
) ;_ strcat
y (getpoint "\n Start point: ")
x (car y)
y (cadr y)
) ;_ setq
(repeat (1+ (/ (strlen s) 2))
(if (setq a (atoi (substr s 1 1)))
(entmakex (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 43 a)
'(90 . 2)
(list 10 (+ x (/ a 2.)) y)
(list 10 (+ x (/ a 2.)) (+ y 50))
) ;_ list
) ;_ entmakex
) ;_ if
(setq x (+ a x (atoi (substr s 2 1)))
s (substr s 3)
) ;_ setq
) ;_ repeat
)
-
Here is my 128B with the check character.
In your code a bug.
It in check ' Check Digit Calculation.
The good help (http://freebarcodefonts.dobsonsw.com/Code128Transformation.htm)
-
Some amazing code Evgeniy. 8-)
As for the check character, I thought I followed this correctly but I'll go back a review my code.
Thanks
Code 128
The check character calculation method is described in the article Code128
Specification. We assume that you want to find the check digits of string
MRV9012. Here is how it works:
Step One: Start with the first character in the message, assign weight starting
with 1. The start character also has a weight of 1. since the actual encoding is
(START-A)(M)(R)(V)(CODE-C)(90)(12), we have total 7 characters in the message.
Move from the left to right, and increment the weight by one. The value of each
character can be found here.
Index N/A 1 2 3 4 5 6
character START-A M R V CODE-C 90 12
value 103 45 50 54 99 90 12
weight 1 1 2 3 4 5 6
Step Two: Multiply the character value by weight and add the results together. (103*1+45*1+50*2+54*3+99*4+90*5+12*6)=1328
Step Three: Divide the total result by 103; get the remainder: 1328 mod 103 = 92
Step Four: Reverse look up the Code128 encoding table; since the second part is
encoded in character C, we should look up on the character C set. The result is
character (92).
-
OK I think I found my mistake. Added where I should multiply & Multiplied where I should add.
More testing before I correct the code. 8-)
-
My code does not agree with you code. :-o
I updated my code.
-
OK, found another error, code corrected.
Should never have doubted you. :oops:
I'd like to have some of that coffee you're drinking. :-)
-
I'd like to have some of that coffee you're drinking. :-)
Main not quality, but quantity!
My size - 1.5 litres :-)
For comparison, background - a disk dvd
-
Main not quality, but quantity!
My size - 1.5 litres :-)
that could be the first doping scandal among programmers :)
-
Now that's a Man Size cup. :-)
-
Using PLINES create a barcode generator.
http://en.wikipedia.org/wiki/Code_128
Good luck!! 8-)
Hello, Mark! :)
Show your decision...