QR code test page

QR CODE FOR AUTOCAD - TEST PAGE

QR code string Generator
This form will return a sequence of 0 and 1 representing each line of the QR code.
It can be easily used to create the QR code image in various applications.
The string always begins with 1111111, representing the upper black border of the upper-left square.

QR code Block symbol
This is a Block sample generated in Autocad with a lisp routine.
It contains optimized Solids.
Cadorg_QRCode.dwg

Plan Sample with QR code
In my AutoCAD document management software, I have implemented QR codes in title blocks.
It has 2 functions :
- Check the validity of a specific plan by scanning its QR code, for example with an Iphone.
- The user will be instantly warned if the plan has been updated and redirected to the online set of PDF plans.

Check it out :

And the Lisp code

;*********************************************************************************
; QRCODE for Autocad
; © 2010 swisscad / Ian Vogel
; V 0.91 released 2010.08.22
;*********************************************************************************
(defun c:QRcode ( / str)
(cond
((not (validstr (setq str (getstring "\nEnter Text to encode :" T))))
(princ "\nNo text entered")
)
((QRcode str (setq name "QRCode") 0)
(command "_REGENALL")
(command "_INSERT" name)
)
)
(princ)
)
(defun QRcode (string ; string to encode
blockname ; name of the block to create
options ; options
; 1 = perform only if block already exists
/ QR x y startx row)
(vl-load-com)
(cond
((not (validstr blockname)))
((or (zerop (logand 1 options))
(tblsearch "BLOCK" blockname)
)
(setq baseurl "www.xcad.ch/tests/getqrcode.php")
(setq QR (valstr (gethttp (strcat baseurl"%3Fstring=" (urlencode (urlencode string))) 0)))
(cond
((eq (substr QR 1 6) "111111");response OK
(setq QR (split QR "-")
y 0)
;create Qrcode block
(entmake (list '(0 . "BLOCK")
(cons 2 blockname)
'(8 . "0")
'(70 . 0)
'(10 0.0 0.0 0.0)
)
)
(foreach row QR
(setq x 0)
(while (< x (strlen row))
(cond
((eq (substr row (1+ x) 1) "1")
;memorize start of filled zone
(if (not startx)(setq startx x))
(if (not (eq (substr row (+ x 2) 1) "1"))
(progn
;draw filled zone
(entmake (list (cons 0 "SOLID")
(cons 8 "0")
(cons 10 (list startx y))
(cons 11 (list (1+ x) y))
(cons 12 (list startx (1- y)))
(cons 13 (list (1+ x)(1- y)))
(cons 62 0)
)
)
(setq startx nil)
))
))
(setq x (1+ x))
)
(setq y (1- y))
)
;end of block
(setq bl_a (entmake '((0 . "ENDBLK"))))
)
)
T
))
)
;-------------------------------------------------------
; Get an URL
;-------------------------------------------------------
(defun gethttp (lien
opt
/ fi line tmp util content)
(setq util (vla-get-Utility
(vla-get-ActiveDocument (vlax-get-acad-object))
)
)
(if (eq (vla-isurl util lien) :vlax-true)
(if (vl-catch-all-error-p
(vl-catch-all-apply
'vla-GetRemoteFile
(list util lien 'tmp :vlax-true)
)
)
(princ "\nError getting http file.")
(progn
(setq fi (open tmp "r")
content "")
(while (setq line (read-line fi))
(setq content (strcat content line))
)
(close fi)
)
)
)
content
)
;-------------------------------------------------------
; Turn any var to a string
;-------------------------------------------------------
(defun valstr (val)
(cond
((eq (type val) 'STR) val)
((eq (type val) 'REAL) (rtos val))
((eq (type val) 'INT) (itoa val))
(T "")
))
;-------------------------------------------------------
; Check that a string is not empty
;-------------------------------------------------------
(defun validstr (str / tmp)
(if (> (strlen (setq tmp (trim (valstr str)))) 0) tmp nil)
)
;-------------------------------------------------------
; Remove blanks from a string
;-------------------------------------------------------
(defun trim ( str / )
(setq str (valstr str))
(while (eq (substr str 1 1) " ")
(setq str (substr str 2))
)
(while (and (> (strlen str) 1)
(eq (substr str (strlen str) 1) " ")
)
(setq str (substr str 1 (- (strlen str) 1)))
)
str
)

;-------------------------------------------------------
; Split a string
;-------------------------------------------------------
(defun split (str ; string to split
cara ; separator
/ n portion xstring seqstart chrcode portion)
(cond
((and (= (type str)(type cara) 'STR)(eq (strlen cara) 1))
(setq n -1 seqstart 1 chrcode (ascii cara))
(while (setq n (vl-string-position chrcode str (+ n 1) nil))
(setq xstring (append xstring (list (substr str seqstart (- n seqstart -1)))) seqstart (+ n 2) )
)
(setq xstring (append xstring (list (substr str seqstart))))
(if xstring xstring (list str))
)
((= (type str)(type cara) 'STR)
(setq portion "" n 1)
(if (<= (strlen cara) (strlen str))
(progn
(while (<= n (strlen str))
(if (eq (substr str n (strlen cara)) cara)
(setq xstring (append xstring (list portion))
portion ""
n (+ n (strlen cara))
)
(setq portion (strcat portion (substr str n 1))
n (+ 1 n)
)
)
)
(if (or (> (strlen portion) 0)
(eq (substr str (abs (- (strlen str)(strlen cara) -1))) cara)
)
(setq xstring (append xstring (list portion)))
)
)
(setq xstring (list str))
)
(if xstring xstring (list ""))
)
(T (list nil))
)
)
;----------------------------------------------------------
; See PHP function
; http://ch2.php.net/manual/fr/function.htmlentities.php
;----------------------------------------------------------
(defun urlencode (str / result n len )
(setq result ""
n 1
len (strlen str))

(while (<= n len)
(setq result (strcat result (urlenc (substr str n 1)))
n (+ 1 n))
)
result
)
(defun urlenc (ch)
(cond
((eq ch " ") " ");+
((eq ch "!") "%21")
((eq ch "\"") "%22")
((eq ch "#") "%23")
((eq ch "$") "%24")
((eq ch "%") "%25")
((eq ch "&") "%26")
((eq ch "'") "%27")
((eq ch "(") "%28")
((eq ch ")") "%29")
((eq ch "*") "%2A")
((eq ch "+") "%2B")
((eq ch ",") "%2C")
((eq ch "/") "%2F")
((eq ch ":") "%3A")
((eq ch ";") "%3B")
((eq ch "<") "%3C")
((eq ch "=") "%3D")
((eq ch ">") "%3E")
((eq ch "?") "%3F")
((eq ch "@") "%40")
((eq ch "[") "%5B")
((eq ch "\\") "%5C")
((eq ch "]") "%5D")
((eq ch "^") "%5E")
((eq ch "`") "%60")
((eq ch "{") "%7B")
((eq ch "|") "%7C")
((eq ch "}") "%7D")
((eq ch "~") "%7E")
((eq ch "‘") "%91")
((eq ch "’") "%92")
((eq ch "¡") "%A1")
((eq ch "¢") "%A2")
((eq ch "£") "%A3")
((eq ch "¤") "%A4")
((eq ch "¥") "%A5")
((eq ch "¦") "%A6")
((eq ch "§") "%A7")
((eq ch "¨") "%A8")
((eq ch "©") "%A9")
((eq ch "ª") "%AA")
((eq ch "«") "%AB")
((eq ch "¬") "%AC")
((eq ch "") "%AD")
((eq ch "®") "%AE")
((eq ch "¯") "%AF")
((eq ch "°") "%B0")
((eq ch "±") "%B1")
((eq ch "²") "%B2")
((eq ch "³") "%B3")
((eq ch "´") "%B4")
((eq ch "µ") "%B5")
((eq ch "¶") "%B6")
((eq ch "·") "%B7")
((eq ch "¸") "%B8")
((eq ch "¹") "%B9")
((eq ch "º") "%BA")
((eq ch "»") "%BB")
((eq ch "¼") "%BC")
((eq ch "½") "%BD")
((eq ch "¾") "%BE")
((eq ch "¿") "%BF")
((eq ch "À") "%C0")
((eq ch "Á") "%C1")
((eq ch "Â") "%C2")
((eq ch "Ã") "%C3")
((eq ch "Ä") "%C4")
((eq ch "Å") "%C5")
((eq ch "Æ") "%C6")
((eq ch "Ç") "%C7")
((eq ch "È") "%C8")
((eq ch "É") "%C9")
((eq ch "Ê") "%CA")
((eq ch "Ë") "%CB")
((eq ch "Ì") "%CC")
((eq ch "Í") "%CD")
((eq ch "Î") "%CE")
((eq ch "Ï") "%CF")
((eq ch "Ð") "%D0")
((eq ch "Ñ") "%D1")
((eq ch "Ò") "%D2")
((eq ch "Ó") "%D3")
((eq ch "Ô") "%D4")
((eq ch "Õ") "%D5")
((eq ch "Ö") "%D6")
((eq ch "×") "%D7")
((eq ch "Ø") "%D8")
((eq ch "Ù") "%D9")
((eq ch "Ú") "%DA")
((eq ch "Û") "%DB")
((eq ch "Ü") "%DC")
((eq ch "Ý") "%DD")
((eq ch "Þ") "%DE")
((eq ch "ß") "%DF")
((eq ch "à") "%E0")
((eq ch "á") "%E1")
((eq ch "â") "%E2")
((eq ch "ã") "%E3")
((eq ch "ä") "%E4")
((eq ch "å") "%E5")
((eq ch "æ") "%E6")
((eq ch "ç") "%E7")
((eq ch "è") "%E8")
((eq ch "é") "%E9")
((eq ch "ê") "%EA")
((eq ch "ë") "%EB")
((eq ch "ì") "%EC")
((eq ch "í") "%ED")
((eq ch "î") "%EE")
((eq ch "ï") "%EF")
((eq ch "ð") "%F0")
((eq ch "ñ") "%F1")
((eq ch "ò") "%F2")
((eq ch "ó") "%F3")
((eq ch "ô") "%F4")
((eq ch "õ") "%F5")
((eq ch "ö") "%F6")
((eq ch "÷") "%F7")
((eq ch "ø") "%F8")
((eq ch "ù") "%F9")
((eq ch "ú") "%FA")
((eq ch "û") "%FB")
((eq ch "ü") "%FC")
((eq ch "ý") "%FD")
((eq ch "þ") "%FE")
((eq ch "ÿ") "%FF")
(T ch)
)
)
(princ "\nType QRCODE")
(princ)
;*********************************************************************************

Ian Vogel / 21.08.2010
Swisscad