也谈Lisp生成二维码之调用命令行exe版
本帖最后由 edata 于 2022-5-21 22:31 编辑以前写了一个用于DCL版本基于MFC的二维码生成程序，有人说不能动态生成。
这不动态的他来了。
exe附件,例子解压到D盘，
2022-05-21更新附件，隐蔽运行
代码更新，添加边框，指定左上角点，单个方块大小
(defun c:tt(/ wscript stdout wsreturn outstr pt n k lst ptbase h ptleftdown ptleftup ptrightdown ptrightup size w)
(setq WScript (vlax-get-or-create-object "WScript.Shell"))
(setq WSreturn (vlax-invoke WScript 'exec "\"D:\\QRencodeForLisp.exe\" \"明经通道\r\ncode by edata\r\n\""))
(setq stdout (vlax-get WSreturn 'StdOut))
(setq outstr (vlax-invoke stdout 'Readall))
(setq lst(read outstr))
(if (and lst (setq ptbase(getpoint "\n左上角点:")))
(progn
;(setq ptbase '(0 0))
(setq h(length lst) w(length (car lst)))
;;方块的大小
(setq size 100.0)
(setq ptLeftUp (polar ptbase (* pi 1.75) (* (sqrt 2.0) (* size 0.5))))
(setq ptRightUp(polar ptLeftUp 0 (+ (* w size) size )))
(setq ptLeftDown(polar ptLeftUp (* pi 1.5) (+ (* w size) size )))
(setq ptRightDown(polar ptRightUp(* pi 1.5) (+ (* w size) size )))
(mkFrame ptLeftUp ptLeftDown ptRightDown ptRightUp 16777215 size)
(setq ptbase(polar (polar ptLeftUp 0 (* 0.5 size)) (* pi 1.5) size))
(foreach n lst
(setq pt ptbase)
(foreach k n
(if (= k 1) (mkpline pt 0 size) (mkpline pt 16777215 size))
(setq pt(polar pt 0 size))
)
(setq ptbase(polar ptbase (* pi 1.5) size))
)
)
)
(princ)
)
(defun mkpline(pt col size)
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 420 col) (cons 90 2) (cons 10 pt) (cons 10 (polar pt 0 size))(cons 43 size)))
)
(defun mkFrame(p1 p2 p3 p4 col size / lst pt)
(setq lst(list p1 p2 p3 p4))
(entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 420 col)(cons 90 (length lst))(cons 70 1)(cons 43 size))
(mapcar '(lambda (pt)(cons 10 pt)) lst ))
)
)
效果：
历史版本
2022-05-20更新附件,会有闪现
测试代码
;;例子简单的生成黑白色二维码，可以根据需求。
;;本质上调用就是 exe路径 空格 字符串
;;字符串参数换行可以使用\r\n 符合windows回车换行标准
;;字符串参数建议使用转义包裹 \" ，防止参数中有空格导致参数截断
;;路径建议使用转义包裹 \" ，防止路径中有空格导致参数截断
;;注 源码中原来的链接地址在论坛代码高亮中会被转义，去掉了链接地址
(defun c:tt(/ wscript stdout wsreturn outstr pt n k lst ptbase)
(setq WScript (vlax-get-or-create-object "WScript.Shell"))
(setq WSreturn (vlax-invoke WScript 'exec "\"D:\\QRencodeForLisp.exe\" \"明经通道\r\ncode by edata\r\n\""))
(setq stdout (vlax-get WSreturn 'StdOut))
(setq outstr (vlax-invoke stdout 'Readall))
(setq lst(read outstr))
(if lst
(progn
(setq ptbase '(0 0))
(foreach n lst
(setq pt ptbase)
(foreach k n
(if (= k 1) (mkpline pt 0) (mkpline pt 16777215))
(setq pt(polar pt 0 1))
)
(setq ptbase(polar ptbase (* pi 1.5) 1))
)
)
)
(princ)
)
(defun mkpline(pt col)
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 420 col) (cons 90 2) (cons 10 pt) (cons 10 (polar pt 0 1))(cons 43 1)))
)
生成结果：
识别结果
补充
命令行手工操作生成二维码列表值txt文件,
QRencodeForLisp.exe "建设单位：明经通道\r\n设计单位：edata" >test.txt
自贡黄明儒 发表于 2022-5-20 11:03
等你发个应用示例，我等好照虎画猫。
(defun c:rrt (/ xlien util str strlst )
(vl-load-com)
(setq str (cdr (assoc 1 (entget (car(entsel"点击文本"))))))
(setq WScript (vlax-get-or-create-object "WScript.Shell"))
(setq WSreturn (vlax-invoke WScript 'exec (strcat "\"QRencodeForLisp.exe\" \"" str "\"")))
(setq stdout (vlax-get WSreturn 'StdOut))
(setq outstr (vlax-invoke stdout 'Readall))
(setq strlst (read outstr))
(setq x (length strlst))
(setqlw 1 ll lw pt (getpoint"指定插入点"))
(repeat x
(setq xlist (car strlst))
(setq n x)
(repeat x
(setq ptn (polar pt 0 (* lw n)))
(setq n (1- n))
(setq ptx (rtos (nth n xlist) 2 0 ))
(if (= ptx "1") (Mc:pl1-1fk ptn lw ll))
)
(setq pt (polar pt (* pi 1.5) lw))
(setq strlst (vl-remove (car strlst) strlst))
)
(redraw)
)
;;(Mc:pl1-1fk pt1 lw ll) 多义线起点 宽度 长度
(defun Mc:pl1-1fk (pt lw ll / pta)
(setq pta (polar pt 0 ll))
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 43LW)(cons 90 2) (cons 10 pt) (cons 10 pta)))
)
edata 发表于 2022-5-21 21:32
更新了附件，你试试。。
...
完美。
https://atlisp.cn/stable/qrencode/readme.mp4
qrencode 源代码见：
https://gitee.com/atlisp/atlisp-packages/blob/main/qrencode/qrencode.lsp
vitalgg 发表于 2022-5-20 22:14
https://atlisp.cn/package-info/qrencode-stable.html
屏幕会闪一下。
更新了附件，你试试。。
感谢长老共享资料！ 本帖最后由 guosheyang 于 2022-5-20 08:16 编辑
长老 请问这个具体要咋操作呢QRencodeForLisp.exe 已放在D盘根目录下了。 这句好像运行出错 我用的是win11家庭版 CAD2017 (setq WSreturn (vlax-invoke WScript 'exec "\"D:\\QRencodeForLisp.exe\" \"明经通道\r\n<a href="http://bbs.mjtd.com" target="_blank">http://bbs.mjtd.com</a>\r\ncode by edata\r\n\"")) 谢谢！ 我运行后 QQ 自动生成了一个智能备份文件夹 qqpcmgr_docpro好像是防止勒索病毒加密的 E大，现在是二维码的天下，什么都要扫码。我有过问题，你这程序每次用“明经通道”生成的二维是否相同？假如我的图纸上，用自己的名字，而不是“明经通道”，那么这个二维码怎么同我自己联系起来？ 自贡黄明儒 发表于 2022-5-20 09:23
E大，现在是二维码的天下，什么都要扫码。我有过问题，你这程序每次用“明经通道”生成的二维是否相同？假 ...
https://www.zhihu.com/question/65253283
这里有文章教大家用钛合金眼人工解码;P vectra 发表于 2022-5-20 09:33
https://www.zhihu.com/question/65253283
这里有文章教大家用钛合金眼人工解码
可否用于图纸签名？ 自贡黄明儒 发表于 2022-5-20 09:39
可否用于图纸签名？
一般图纸上用来存储各类信息的，具体运用还要看行业需求，比如有的人用来存储项目信息，电子图档链接。 edata 发表于 2022-5-20 10:39
一般图纸上用来存储各类信息的，具体运用还要看行业需求，比如有的人用来存储项目信息，电子图档链接。
等你发个应用示例，我等好照虎画猫。 guosheyang 发表于 2022-5-20 08:14
长老 请问这个具体要咋操作呢QRencodeForLisp.exe 已放在D盘根目录下了。 这句好像运行出错 我用的是wi ...
lisp源代码中的链接在论坛的代码高亮中会出现了异常，刚刚更新了帖子中的lisp源码，去掉了链接地址。