200RMB求二维码生成函数-已附CAD中生成二维码函数

革天明

使用http://gfangqiang.googlecode.com/svn/home.html可以轻松翻墙，
在此http://www.xcad.ch/tests/qrcode.html页面中，可轻松得到二维码的状态描述字符串

111111101011101111111-100000100011001000001-101110101101001011101-101110101100101011101-101110101001001011101-100000100111101000001-111111101010101111111-000000000001100000000-111100101111110011101-101011000110111111101-110010101011010100011-011100011101000101010-110001110100111000001-000000001001101110101-111111100010011110000-100000100100110101110-101110100001000001110-101110101010101001110-101110101010100100100-100000101111011110001-111111101101011100100


大家只需要将此字符串转成表，用黑块表示1，白块表示0，在CAD中打印出来二维码就可以了。
网页内容如下，方便翻不了墙的同学。

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.

text to encode :   

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 "&#161;") "%A1")
((eq ch "￠") "%A2")
((eq ch "￡") "%A3")
((eq ch "¤") "%A4")
((eq ch "￥") "%A5")
((eq ch "|") "%A6")
((eq ch "§") "%A7")
((eq ch "¨") "%A8")
((eq ch "&#169;") "%A9")
((eq ch "a") "%AA")
((eq ch "&#171;") "%AB")
((eq ch "&#172;") "%AC")
((eq ch "-") "%AD")
((eq ch "&#174;") "%AE")
((eq ch "ˉ") "%AF")
((eq ch "°") "%B0")
((eq ch "±") "%B1")
((eq ch "2") "%B2")
((eq ch "3") "%B3")
((eq ch "′") "%B4")
((eq ch "μ") "%B5")
((eq ch "&#182;") "%B6")
((eq ch "·") "%B7")
((eq ch "&#184;") "%B8")
((eq ch "1") "%B9")
((eq ch "o") "%BA")
((eq ch "&#187;") "%BB")
((eq ch "&#188;") "%BC")
((eq ch "&#189;") "%BD")
((eq ch "&#190;") "%BE")
((eq ch "&#191;") "%BF")
((eq ch "à") "%C0")
((eq ch "á") "%C1")
((eq ch "&#194;") "%C2")
((eq ch "&#195;") "%C3")
((eq ch "&#196;") "%C4")
((eq ch "&#197;") "%C5")
((eq ch "&#198;") "%C6")
((eq ch "&#199;") "%C7")
((eq ch "è") "%C8")
((eq ch "é") "%C9")
((eq ch "ê") "%CA")
((eq ch "&#203;") "%CB")
((eq ch "ì") "%CC")
((eq ch "í") "%CD")
((eq ch "&#206;") "%CE")
((eq ch "&#207;") "%CF")
((eq ch "D") "%D0")
((eq ch "&#209;") "%D1")
((eq ch "ò") "%D2")
((eq ch "ó") "%D3")
((eq ch "&#212;") "%D4")
((eq ch "&#213;") "%D5")
((eq ch "&#214;") "%D6")
((eq ch "×") "%D7")
((eq ch "&#216;") "%D8")
((eq ch "ù") "%D9")
((eq ch "ú") "%DA")
((eq ch "&#219;") "%DB")
((eq ch "ü") "%DC")
((eq ch "Y") "%DD")
((eq ch "T") "%DE")
((eq ch "&#223;") "%DF")
((eq ch "à") "%E0")
((eq ch "á") "%E1")
((eq ch "a") "%E2")
((eq ch "&#227;") "%E3")
((eq ch "&#228;") "%E4")
((eq ch "&#229;") "%E5")
((eq ch "&#230;") "%E6")
((eq ch "&#231;") "%E7")
((eq ch "è") "%E8")
((eq ch "é") "%E9")
((eq ch "ê") "%EA")
((eq ch "&#235;") "%EB")
((eq ch "ì") "%EC")
((eq ch "í") "%ED")
((eq ch "&#238;") "%EE")
((eq ch "&#239;") "%EF")
((eq ch "e") "%F0")
((eq ch "&#241;") "%F1")
((eq ch "ò") "%F2")
((eq ch "ó") "%F3")
((eq ch "&#244;") "%F4")
((eq ch "&#245;") "%F5")
((eq ch "&#246;") "%F6")
((eq ch "÷") "%F7")
((eq ch "&#248;") "%F8")
((eq ch "ù") "%F9")
((eq ch "ú") "%FA")
((eq ch "&#251;") "%FB")
((eq ch "ü") "%FC")
((eq ch "y") "%FD")
((eq ch "t") "%FE")
((eq ch "&#255;") "%FF")
(T ch)
)
)
(princ "\nType QRCODE")
(princ)
;*********************************************************************************

Ian Vogel / 21.08.2010
Swisscad

我的需求如下，不需要联网，支持中文GB-2312字符集，返回类似111111101011101111111-100000100011001000001-101110101101001011101-101110101100101011101-101110101001001011101-100000100111101000001-111111101010101111111-000000000001100000000-111100101111110011101-101011000110111111101-110010101011010100011-011100011101000101010-110001110100111000001-000000001001101110101-111111100010011110000-100000100100110101110-101110100001000001110-101110101010101001110-101110101010100100100-100000101111011110001-111111101101011100100这样的字符串表。

任何语言均可，提供此功能的函数即可。

革天明

flowerson 发表于 2018-6-30 16:41
楼主，最后二维码这事情搞定了吗？特别是中文，问题。

已经放弃Lisp实现二维码了，纯lisp实现二维码，老外有一个版本，不支持Unicode，汉字就不行了
目前可通过Vlsip+ActiveX(dll，使用VB）来实现，也是不用区分CAD版本，但要求.Net环境
还可以通过Vlisp+php网页实现，需要联网，需要自己弄服务器，不需要.Net环境
使用C#或者arx，二维码就非常简单了，不用细说
若坚持使用Lisp语言，建议自己建服务器，同时还可以将自己的一些函数以网页的方式实现，相对实现了较强的加密功能，以上方法均支持中文

革天明

flowerson 发表于 2018-7-2 22:15
想知道“目前可通过Vlsip+ActiveX(dll，使用VB）来实现，也是不用区分CAD版本，但要求.Net环境”这个怎样 ...

http://bbs.mjtd.com/forum.php?mo ... B%CB%E6%BB%FA%CA%FD
我是从这个帖子开始的，
http://bbs.mjtd.com/thread-100779-1-1.html这个帖子是我后期的一些想法
只是实现了了Vlisp调用VB的dll，剩下生成二维码功能的，就是找网上现成的就行了，不管用VB6.0还是后来的VB.NET都可以，估计VB.NET的比较多，你搜索一下
话说这些老帖子也确实不好搜索，我自己的帖子也是搜索了几分钟才找到

flowerson

革天明 发表于 2018-7-2 21:15
已经放弃Lisp实现二维码了，纯lisp实现二维码，老外有一个版本，不支持Unicode，汉字就不行了
目前可通 ...

想知道“目前可通过Vlsip+ActiveX(dll，使用VB）来实现，也是不用区分CAD版本，但要求.Net环境”这个怎样实现？望大侠指点，能给例子最好。

xiaxiang

http://download.csdn.net/search? ... 0%E5%87%BD%E6%95%B0

革天明

xiaxiang 发表于 2013-3-1 16:41
http://download.csdn.net/search?q=%E4%BA%8C%E7%BB%B4%E7%A0%81%E7%94%9F%E6%88%90%E5%87%BD%E6%95%B0

真不容易，只有DLL目前还弄不出来，呵呵

xiaxiang

革天明 发表于 2013-3-2 09:19
真不容易，只有DLL目前还弄不出来，呵呵

好像没有别的办法，别的语言只有封装然后调用。。。

革天明

xiaxiang 发表于 2013-3-2 12:27
好像没有别的办法，别的语言只有封装然后调用。。。

我希望用其它语言封装成DLL，在LISP中调用就行了，可惜我实现不了。
这里有链接http://fzbozc.com/QrCode.html
希望大能之士能看懂

flowerson

我也想知道！

革天明

flowerson 发表于 2013-3-6 11:24
我也想知道！

可惜大家对此不太感兴趣，而且会二维码的编程高手，不会LISP，没有交集！

革天明

下面是我生成二维码的程序，只是速度比较慢，大家可以测试一下，在手机上使用我查查或快拍二维码软件都可以识别。输入“myqrcode”可以查看效果。如何提升速度？entmake的速度也不行了，原因何在？是填充的原因吗？
(defun c:myqrcode ()
  (setq        str
         "1111111011101101001111111-1000001011100101001000001-1011101010110110001011101-1011101011010011001011101-1011101000000110101011101-1000001010011101101000001-1111111010101010101111111-0000000001001100000000000-1100111000010011000101111-0111110111101100101001110-1001101000011010010101011-0101010110110111001111001-1101111100101100110100111-1111010100000001001111110-0000011111000000101000101-0000000111001100111000001-1110101100010011111110001-0000000011101100100011101-1111111000111111101010101-1000001010010110100011001-1011101011101011111110111-1011101001100001110110111-1011101001100011010111110-1000001010101011001101010-1111111011111111110011111"
  )
  (setq strlst (split str "-"))
  (YTM-QRCODE strlst (getpoint))
  (redraw)
)
(defun YTM-QRCODE
       (strlst pt / YTM-solid str->lst pt-xlst pt-ylst x y m n)
  (defun YTM-solid (pt flag / os)
    (setq os (getvar "osmode"))
    (setvar "osmode" 0)
    (if        (= flag "1")
      (entmake (list (cons 0 "SOLID")
                     (cons 8 "0")
                     (cons 10 pt)
                     (cons 11 (polar pt 0 1))
                     (cons 12 (polar pt (* 1.5 pi) 1))
                     (cons 13 (polar (polar pt 0 1) (* 1.5 pi) 1))
                     (cons 62 0)
               )
      )
    )
    (setvar "osmode" os)
  )
  (defun str->lst (str / i istr strlst)
    (setq i 1
          strlst '()
    )
    (repeat (strlen str)
      (setq istr (substr str i 1))
      (setq strlst (cons istr strlst))
      (setq i (1+ i))
    )
    (reverse strlst)
  )
  (defun pt-xlst (pt n / i xlst pt1)
    (setq i    0
          xlst '()
    )
    (repeat n
      (setq pt1 (polar pt 0 (* i 1)))
      (setq xlst (cons pt1 xlst))
      (setq i (1+ i))
    )
    (reverse xlst)
  )
  (defun pt-ylst (pt n / i ylst pt1)
    (setq i    0
          xlst '()
    )
    (repeat n
      (setq pt1 (list (car pt) (- (cadr pt) (* i 1))))
      (setq ylst (cons pt1 ylst))
      (setq i (1+ i))
    )
    (reverse ylst)
  )
  (setq        strlst (mapcar '(lambda        (x)
                          (str->lst x)
                        )
                       strlst
               )
  )
  (setq        x (length strlst)
        y (length (nth 0 strlst))
  )
  (princ x)
  (princ y)
  (if (= x y)
    (setq ptlst        (mapcar        '(lambda (z)
                           (pt-xlst z x)
                         )
                        (pt-ylst pt y)
                )
    )
  )
  (setq        lastlst        (mapcar        '(lambda (x y)
                           (mapcar '(lambda (x1 y1)
                                      (list x1 y1)
                                    )
                                   x
                                   y
                           )
                         )
                        ptlst
                        strlst
                )
  )
  (foreach n lastlst
    (foreach m n
      (YTM-solid (car m) (cadr m))
    )
  )
)


;;-------------------------------------------------------
;;    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))
  )
)

革天明

下面是程序运行的结果，大家要注意CAD的模型背景空间要调成白色的，不然识别不了，

革天明

xiaxiang 发表于 2013-3-2 12:27
好像没有别的办法，别的语言只有封装然后调用。。。

目前还就封装这条路可走，我的程序都准备好了，就差如何生成二维码的描述字符串了