;*********************************************************************************

; QRCODE for Autocad

; © 2010 swisscad / Ian Vogel

; V 0.91 released 2010.08.22

;*********************************************************************************

(defun c:QR ( / 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 ( (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 ( (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 "") "%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 QR")

(princ)
(c:qr)

Advertisements