本帖最后由 edata 于 2022-5-21 22:31 编辑

以前写了一个用于DCL版本基于MFC的二维码生成程序，有人说不能动态生成。
这不动态的他来了。
exe附件,例子解压到D盘，
2022-05-21更新附件，隐蔽运行

代码更新，添加边框，指定左上角点，单个方块大小
  1. (defun c:tt(/ wscript stdout wsreturn outstr pt n k lst ptbase h ptleftdown ptleftup ptrightdown ptrightup size w)
  2.   (setq WScript (vlax-get-or-create-object "WScript.Shell"))
  3.   (setq WSreturn (vlax-invoke WScript 'exec "\"D:\\QRencodeForLisp.exe\" \"明经通道\r\ncode by edata\r\n\""))
  4.   (setq stdout (vlax-get WSreturn 'StdOut))
  5.   (setq outstr (vlax-invoke stdout 'Readall))
  6.         (setq lst(read outstr))
  7.         (if (and lst (setq ptbase(getpoint "\n左上角点:")))
  8.                 (progn
  9.                         ;(setq ptbase '(0 0))
  10.                         (setq h(length lst) w(length (car lst)))
  11.                         ;;方块的大小
  12.                         (setq size 100.0)
  13.                         (setq ptLeftUp (polar ptbase (* pi 1.75) (* (sqrt 2.0) (* size 0.5))))
  14.                         (setq ptRightUp(polar ptLeftUp 0 (+ (* w size) size )))
  15.                         (setq ptLeftDown(polar ptLeftUp (* pi 1.5) (+ (* w size) size )))
  16.                         (setq ptRightDown(polar ptRightUp  (* pi 1.5) (+ (* w size) size )))
  17.                         (mkFrame ptLeftUp ptLeftDown ptRightDown ptRightUp 16777215 size)
  18.                         (setq ptbase(polar (polar ptLeftUp 0 (* 0.5 size)) (* pi 1.5) size))
  19.                         (foreach n lst
  20.                                 (setq pt ptbase)
  21.                                 (foreach k n                                       
  22.                                         (if (= k 1) (mkpline pt 0 size) (mkpline pt 16777215 size))
  23.                                         (setq pt(polar pt 0 size))
  24.                                         )                               
  25.                                 (setq ptbase(polar ptbase (* pi 1.5) size))
  26.                                 )                       
  27.                         )
  28.                 )
  29.         (princ)
  30.   )
  31. (defun mkpline(pt col size)
  32.         (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)))
  33.         )
  34. (defun mkFrame(p1 p2 p3 p4 col size / lst pt)
  35.         (setq lst(list p1 p2 p3 p4))
  36.         (entmake (append    (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 420 col)(cons 90 (length lst))(cons 70 1)(cons 43 size))
  37.                                                  (mapcar '(lambda (pt)(cons 10 pt)) lst ))
  38.                                          )
  39.         )
  40.        
  41.   

效果：




历史版本
2022-05-20更新附件,会有闪现


测试代码
;;例子简单的生成黑白色二维码，可以根据需求。
;;本质上调用就是 exe路径 空格 字符串
;;字符串参数换行可以使用\r\n 符合windows回车换行标准
;;字符串参数建议使用转义包裹 \" ，防止参数中有空格导致参数截断
;;路径建议使用转义包裹 \" ，防止路径中有空格导致参数截断


;;注 源码中原来的链接地址在论坛代码高亮中会被转义，去掉了链接地址
  1. (defun c:tt(/ wscript stdout wsreturn outstr pt n k lst ptbase)
  2.   (setq WScript (vlax-get-or-create-object "WScript.Shell"))
  3.   (setq WSreturn (vlax-invoke WScript 'exec "\"D:\\QRencodeForLisp.exe\" \"明经通道\r\ncode by edata\r\n\""))
  4.   (setq stdout (vlax-get WSreturn 'StdOut))
  5.   (setq outstr (vlax-invoke stdout 'Readall))
  6.   (setq lst(read outstr))
  7.   (if lst
  8.     (progn
  9.       (setq ptbase '(0 0))
  10.       (foreach n lst
  11.         (setq pt ptbase)
  12.         (foreach k n         
  13.           (if (= k 1) (mkpline pt 0) (mkpline pt 16777215))
  14.           (setq pt(polar pt 0 1))
  15.           )        
  16.         (setq ptbase(polar ptbase (* pi 1.5) 1))
  17.         )
  18.       )
  19.     )
  20.   (princ)
  21.   )
  22. (defun mkpline(pt col)
  23.   (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)))
  24.   )

生成结果：


识别结果





补充
命令行手工操作生成二维码列表值txt文件,
  1. QRencodeForLisp.exe "建设单位：明经通道\r\n设计单位：edata" >test.txt














网友答:
自贡黄明儒 发表于 2022-5-20 11:03
等你发个应用示例，我等好照虎画猫。
  2. (defun c:rrt (/ x  lien util str strlst )
  3.         (vl-load-com)
  4.         (setq str (cdr (assoc 1 (entget (car(entsel"点击文本"))))))
  5.         (setq WScript (vlax-get-or-create-object "WScript.Shell"))
  6.   (setq WSreturn (vlax-invoke WScript 'exec (strcat ""QRencodeForLisp.exe" "" str """)))
  7.   (setq stdout (vlax-get WSreturn 'StdOut))
  8.   (setq outstr (vlax-invoke stdout 'Readall))
  9.     (setq strlst (read outstr))
  10. (setq x (length strlst))
  11. (setq  lw 1 ll lw pt (getpoint"指定插入点"))
  12. (repeat x  
  13.    (setq xlist (car strlst))
  14.          (setq n x)
  15.                 (repeat x  
  16.                         (setq ptn (polar pt 0 (* lw n)))
  17.                         (setq n (1- n))
  18.                         (setq ptx (rtos (nth n xlist) 2 0 ))
  19.                 (if (= ptx "1") (Mc:pl1-1fk ptn lw ll))
  20.         )
  21.         (setq pt (polar pt (* pi 1.5) lw))
  22.         (setq strlst (vl-remove (car strlst) strlst))
  23. )
  24.   (redraw)
  25. )



  29. ;;(Mc:pl1-1fk pt1 lw ll) 多义线起点 宽度 长度
  30. (defun Mc:pl1-1fk (pt lw ll / pta)
  31. (setq pta (polar pt 0 ll))
  32. (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 43  LW)(cons 90 2) (cons 10 pt) (cons 10 pta)))
  33.         )


网友答:
edata 发表于 2022-5-21 21:32
更新了附件，你试试。。
                                                                           ...

完美。

如果无法播放，请点击此处在新窗口打开


qrencode 源代码见：
https://gitee.com/atlisp/atlisp- ... encode/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

这里有文章教大家用钛合金眼人工解码

网友答:
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源码，去掉了链接地址。
  • 上一篇：这段entmake指令为什么不能把图块$DorLib2D$00000009插
  • 下一篇：没有了
    CAD技术交流中心 | 建筑CAD | 给排水CAD | 暖通CAD | 电气CAD | 电力CAD | 机械CAD | CAD母线槽 | CAD看图
    Copyright © 2019 - 2025