明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 952|回复: 8

[源码] autolisp进度条

  [复制链接]
发表于 2025-6-10 22:29:51 | 显示全部楼层 |阅读模式
本帖最后由 Sring65 于 2025-6-12 19:43 编辑

  1. ;;; ;;(ProgressbarDCL  "c:testDCLbar" "测试");;调用
  2. (defun c:testDCLbar (/ Bar_cplt)
  3.   (setq        i   0
  4.         sum 100000
  5.   )
  6.   (repeat sum
  7.     (ProgressBarText (setq i (1+ i)) sum)
  8.   )
  9.   (princ)
  10. )
  11. (defun c:testbar (/ Bar_cplt obj)
  12.   (setq        i   0
  13.         sum 100000
  14.   )
  15.   (repeat sum
  16.     (setq obj (zc_BarText (setq i (1+ i)) sum))
  17.   )
  18.   (zc_delete obj)
  19.   (princ)
  20. )


  21. (defun ProgressBar (va / bar_dL bar_L msg)
  22.   (if (< va 0)
  23.     (setq va 0)
  24.   )
  25.   (if (>= va 100)
  26.     (setq va 100)
  27.   )
  28.   (if (not Bar_cplt)
  29.     (progn
  30.       (setq
  31.         Bar_cplt "■■■■■■■■■■■■■■■■■■■■■■■■■"
  32.         Bar_uncp "□□□□□□□□□□□□□□□□□□□□□□□□□"
  33.         bar_i         0
  34.         bar_L         0
  35.         msg         "0%"
  36.         barStr         (strcat Bar_uncp " " msg)
  37.       )
  38.       (grtext -1 barStr)
  39.     )
  40.   )
  41.   (if (/= va bar_i)
  42.     (progn
  43.       (setq
  44.         bar_L  (/ va 4)
  45.         barStr (strcat
  46.                  (substr Bar_cplt 1 (* 2 bar_L))
  47.                  (substr Bar_uncp (1+ (* 2 bar_L)))
  48.                  " "
  49.                  (itoa va)
  50.                  "%"
  51.                )
  52.         bar_i  va
  53.       )
  54.       (grtext -1 barStr)
  55.     )
  56.   )
  57. )

  58. ;;;;;;========ZYZC_DCL.DCL===========
  59. ;;;   ProgressBar:dialog{
  60. ;;;  :text_part{
  61. ;;;    label="进度";
  62. ;;;    key="msg";
  63. ;;;    }
  64. ;;;    spacer_1;
  65. ;;;    : boxed_row {
  66. ;;;      :text_part{
  67. ;;;        label="□□□□□□□□□□□□□□□□□□□□□□□□□ 0%  ";
  68. ;;;        height=2;
  69. ;;;          key="listTitleword";
  70. ;;;          }
  71. ;;;         
  72. ;;;      }
  73. ;;;  spacer_1;    //空出一行
  74. ;;;  ok_cancel;      
  75. ;;;}
  76. ;;;;;;========ZYZC_DCL.DCL===========

  77. (defun ProgressbarDCL (funName msg / PrgRunOld dcl_id tilestr dd2)
  78.   (if (not msg)
  79.     (setq msg "是否运行?")
  80.   )
  81.   (setq PrgRunOld 0)
  82.   (setq dcl_id (load_dialog "ZYZC_DCL.DCL"))
  83.   (new_dialog "ProgressBar" dcl_id "" nil)
  84.   (set_tile "msg" msg)
  85.   (setq tilestr (strcat "(" funName ")(done_dialog 22)"))
  86.   (apply 'action_tile (list "accept" tilestr))
  87.   (setq dd2 (start_dialog))
  88. )
  89. (defun ProgressBarText (n sum / Bar_cplt Bar_uncp va barstr PrgRun)
  90.   (setq        Bar_cplt "■■■■■■■■■■■■■■■■■■■■■■■■■"
  91.         Bar_uncp "□□□□□□□□□□□□□□□□□□□□□□□□□"
  92.   )
  93.   (setq va (/ (* 100 n) sum))
  94.   (if (< va 0)
  95.     (setq va 0)
  96.     (if        (> va 100)
  97.       (setq va 100)
  98.     )
  99.   )
  100.   (if (= va 0)
  101.     (setq barstr (strcat Bar_uncp " 0%")
  102.           PrgRun 0
  103.     )
  104.     (setq PrgRun (* 2 (/ va 4))
  105.           barstr (strcat
  106.                    (substr Bar_cplt 1 PrgRun)
  107.                    (substr Bar_uncp (1+ PrgRun))
  108.                    " "
  109.                    (itoa va)
  110.                    "% ["
  111.                    (itoa n)
  112.                    "/"
  113.                    (itoa sum)
  114.                    "]"
  115.                  )
  116.     )
  117.   )
  118.   (if (/= va PrgRunOld)
  119.     (progn (setq PrgRunOld va)
  120.            (VL-CATCH-ALL-APPLY 'set_tile (list "listTitleword" barstr))
  121.     )
  122.   )
  123.   barstr
  124. )

  125. ;;;删除对象
  126. (defun zc_delete (e)
  127.   (if e
  128.     (if        (vlax-erased-p e)
  129.       nil
  130.       (if (= (type e) 'ENAME)
  131.         (entdel e)
  132.         (vla-Delete e)
  133.       )
  134.     )
  135.   )
  136. ) ;_zc_delete

  137. ;;;创建文件
  138. (defun zce_addMtext (/ pt entl doc EPtxt)
  139.   (if (= modelSpace nil)
  140.     (setq acadObj    (vlax-get-acad-object)
  141.     doc       (vla-get-ActiveDocument acadObj)
  142.     modelSpace (vla-get-ModelSpace doc)
  143.     )
  144.   )

  145.   (setq pt '(0 0 0))
  146. ;;;  (setq entl (entlast))
  147.   (entmake
  148.     '((0 . "MTEXT")
  149.       (8 . "TEMP_TOOLS")
  150.       (100 . "AcDbEntity")
  151.       (100 . "AcDbMText")
  152.       (10 . (0 0 0))
  153.       (40 . 0.9)
  154.       (71 . 4)
  155.       (72 . 5)
  156.       (1
  157.        .
  158.        "{\\fSimHei;\\Q0;\\W1;\\C5;=====================\\P\\P=====================}"
  159.       )
  160.       (7 . "STANDARD")
  161.       (50 . 0.0)
  162.       (73 . 1)
  163.       (44 . 1.0)
  164.       (90 . 1)
  165.       (63 . 4)
  166.       (45 . 1.5)
  167.       (441 . 0)
  168.      )
  169.   )
  170.   (setq zce_EntMtext (entlast))
  171.   (command "DRAWORDER" (entlast) "" "F")
  172.   (vlax-ename->vla-object zce_EntMtext)
  173. ) ;_zce_addMtext

  174. (defun zc_BarText (n sum / va barstr PrgRun)
  175.   (if Bar_cplt
  176.     nil
  177.     (setq Bar_cplt "■■■■■■■■■■■■■■■■■■■■■■■■■"
  178.           Bar_uncp "□□□□□□□□□□□□□□□□□□□□□□□□□"
  179.     )
  180.   )
  181.   (if (and n sum)
  182.     (progn
  183.       (if (< n 2)
  184.         (progn
  185.           (zc_delete zc-Bartxt)
  186.           (setq zc-Bartxt nil)
  187.         )
  188.       )
  189.       (setq va (/ (* 100 n) sum))
  190.       (if (< va 0)
  191.         (setq va 2)
  192.         (if (>= va 100)
  193.           (setq va 100)
  194.         )
  195.       )
  196.       (setq PrgRun (/ va 2))
  197.       (if (/= PrgRun zb-PrgRunOld)
  198.         (progn
  199.           (if (= va 100)
  200.             (setq va 99)
  201.           )
  202.           (setq        barstr (strcat
  203.                          (substr Bar_cplt 1 PrgRun)
  204.                          (substr Bar_uncp (1+ PrgRun))
  205.                          " "
  206.                          (itoa va)
  207.                          "%"
  208.                        )
  209.           )
  210.           (setq zb-PrgRunOld PrgRun)
  211.           (zp:BarUpdate barstr)
  212.         )
  213.       )
  214.     )
  215.     (zc_delete zc-Bartxt)
  216.   )
  217.   zc-Bartxt
  218. )
  219. (defun zp:BarUpdate (txt)
  220.   (setq        txt (strcat "{\\fSimHei;\\Q0;\\W1;\\C1;"
  221.                     (zc:strRepeat "" "=" (strlen txt))
  222.                     "\\P\\C5;"
  223.                     txt
  224.                     "\\P\\C1;"
  225.                     (zc:strRepeat "" "=" (strlen txt))
  226.                     "}"
  227.             )
  228.   )
  229.   (if (or (not zc-Bartxt) (vlax-erased-p zc-Bartxt))
  230.     (progn
  231.       (setq zc-Bartxt (zce_addMtext))      
  232.       (zb:movePMcenter zc-Bartxt)
  233.     )
  234.   )
  235.   (if txt
  236.     (vla-put-TextString zc-Bartxt txt)
  237.   )
  238.   (vla-update zc-Bartxt)
  239. )
  240. (defun zc:strRepeat (s a tolen)
  241.   (while (< (strlen s) tolen)
  242.     (setq s (strcat s a))
  243.   )
  244. )

  245. (defun zb:movePMcenter (zce_objtxt /              VIEWSIZEY         SCREENSIZE
  246.                         viewctr           VIEWSIZEX  zce_TextHeight
  247.                         mtY           mtX              x                 y
  248.                         pte           entMT
  249.                        )
  250.   (if (/= 'VLA-OBJECT (type zce_objtxt))
  251.     (setq zce_objtxt (vlax-ename->vla-object zce_objtxt))
  252.   )
  253.   (setq        VIEWSIZEY  (GETVAR "VIEWSIZE")
  254.         SCREENSIZE (GETVAR "SCREENSIZE")
  255.         viewctr           (getvar "viewctr")
  256.         VIEWSIZEX  (* (/ VIEWSIZEY
  257.                          (CADR SCREENSIZE)
  258.                       )
  259.                       (CAR SCREENSIZE)
  260.                    )
  261.   )
  262.   (setq        zce_TextHeight
  263.          (/ (/ VIEWSIZEY (CADR SCREENSIZE))
  264.             0.0735852
  265.          )
  266.   )
  267.   (vla-put-Height zce_objtxt zce_TextHeight) ;重置文字高度   
  268.   (vla-put-AttachmentPoint
  269.     zce_objtxt
  270.     acAttachmentPointMiddleCenter
  271.   )
  272.   (setq pte (vlax-3d-point (trans viewctr 1 0)))
  273.   (vla-put-insertionPoint zce_objtxt pte)
  274. )

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

评分

参与人数 5明经币 +5 金钱 +5 收起 理由
bssurvey + 1 赞一个!
USER2128 + 1 赞一个!
Bao_lai + 1 很给力!
kucha007 + 1 赞一个!
tigcat + 1 + 5 感谢前辈分享。

查看全部评分

回复

使用道具 举报

发表于 2025-6-11 00:37:07 | 显示全部楼层
auto,写错了
回复 支持 反对

使用道具 举报

发表于 2025-6-11 09:09:05 | 显示全部楼层
看着不错,学习一下
回复 支持 反对

使用道具 举报

发表于 2025-6-11 09:32:37 | 显示全部楼层
这样CAD不会卡死了吧
回复 支持 反对

使用道具 举报

发表于 2025-6-11 12:59:45 | 显示全部楼层
很强,就是不知道会不会卡死
回复 支持 反对

使用道具 举报

 楼主| 发表于 2025-6-11 19:22:52 | 显示全部楼层
hn10183051 发表于 2025-6-11 12:59
很强,就是不知道会不会卡死

DCL的会卡死,文本形式的不会卡死
回复 支持 反对

使用道具 举报

发表于 2025-6-11 19:51:17 | 显示全部楼层
Sring65 发表于 2025-6-11 19:22
DCL的会卡死,文本形式的不会卡死

程序运行过程中,很多时候是显示跟不上的,在命令行打印都被抑制掉了,在屏幕写文字估计更加不可能看见,要看见,没准得被迫等待更新吧?
我之前尝试用grdraw做进度条,程序运行中途都来不及不显示的,除非人为干预了,给时间绘图显示;否则直接到结束显示一下完成状态就清掉了。
回复 支持 反对

使用道具 举报

发表于 2025-6-12 15:04:41 | 显示全部楼层
小程序可以,大程序反而增加了运算量,更卡了
回复 支持 反对

使用道具 举报

 楼主| 发表于 2025-6-12 19:40:36 | 显示全部楼层
菜卷鱼 发表于 2025-6-12 15:04
小程序可以,大程序反而增加了运算量,更卡了

小程序没必要,大程序本来就慢再慢点无所谓,有个进度看个乐
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2025-7-14 16:41 , Processed in 0.166520 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表