autolisp进度条

Sring65 · 发表于 2025-6-10 22:29:51

本帖最后由 Sring65 于 2025-6-12 19:43 编辑

;;; ;;(ProgressbarDCL "c:testDCLbar" "测试");;调用
(defun c:testDCLbar (/ Bar_cplt)
(setq i 0
sum 100000
)
(repeat sum
(ProgressBarText (setq i (1+ i)) sum)
)
(princ)
)
(defun c:testbar (/ Bar_cplt obj)
(setq i 0
sum 100000
)
(repeat sum
(setq obj (zc_BarText (setq i (1+ i)) sum))
)
(zc_delete obj)
(princ)
)
(defun ProgressBar (va / bar_dL bar_L msg)
(if (< va 0)
(setq va 0)
)
(if (>= va 100)
(setq va 100)
)
(if (not Bar_cplt)
(progn
(setq
Bar_cplt "■■■■■■■■■■■■■■■■■■■■■■■■■"
Bar_uncp "□□□□□□□□□□□□□□□□□□□□□□□□□"
bar_i 0
bar_L 0
msg "0%"
barStr (strcat Bar_uncp " " msg)
)
(grtext -1 barStr)
)
)
(if (/= va bar_i)
(progn
(setq
bar_L (/ va 4)
barStr (strcat
(substr Bar_cplt 1 (* 2 bar_L))
(substr Bar_uncp (1+ (* 2 bar_L)))
" "
(itoa va)
"%"
)
bar_i va
)
(grtext -1 barStr)
)
)
)
;;;;;;========ZYZC_DCL.DCL===========
;;; ProgressBar:dialog{
;;; :text_part{
;;; label="进度";
;;; key="msg";
;;; }
;;; spacer_1;
;;; : boxed_row {
;;; :text_part{
;;; label="□□□□□□□□□□□□□□□□□□□□□□□□□ 0% ";
;;; height=2;
;;; key="listTitleword";
;;; }
;;;
;;; }
;;; spacer_1; //空出一行
;;; ok_cancel;
;;;}
;;;;;;========ZYZC_DCL.DCL===========
(defun ProgressbarDCL (funName msg / PrgRunOld dcl_id tilestr dd2)
(if (not msg)
(setq msg "是否运行？")
)
(setq PrgRunOld 0)
(setq dcl_id (load_dialog "ZYZC_DCL.DCL"))
(new_dialog "ProgressBar" dcl_id "" nil)
(set_tile "msg" msg)
(setq tilestr (strcat "(" funName ")(done_dialog 22)"))
(apply 'action_tile (list "accept" tilestr))
(setq dd2 (start_dialog))
)
(defun ProgressBarText (n sum / Bar_cplt Bar_uncp va barstr PrgRun)
(setq Bar_cplt "■■■■■■■■■■■■■■■■■■■■■■■■■"
Bar_uncp "□□□□□□□□□□□□□□□□□□□□□□□□□"
)
(setq va (/ (* 100 n) sum))
(if (< va 0)
(setq va 0)
(if (> va 100)
(setq va 100)
)
)
(if (= va 0)
(setq barstr (strcat Bar_uncp " 0%")
PrgRun 0
)
(setq PrgRun (* 2 (/ va 4))
barstr (strcat
(substr Bar_cplt 1 PrgRun)
(substr Bar_uncp (1+ PrgRun))
" "
(itoa va)
"% ["
(itoa n)
"/"
(itoa sum)
"]"
)
)
)
(if (/= va PrgRunOld)
(progn (setq PrgRunOld va)
(VL-CATCH-ALL-APPLY 'set_tile (list "listTitleword" barstr))
)
)
barstr
)
;;;删除对象
(defun zc_delete (e)
(if e
(if (vlax-erased-p e)
nil
(if (= (type e) 'ENAME)
(entdel e)
(vla-Delete e)
)
)
)
) ;_zc_delete
;;;创建文件
(defun zce_addMtext (/ pt entl doc EPtxt)
(if (= modelSpace nil)
(setq acadObj (vlax-get-acad-object)
doc (vla-get-ActiveDocument acadObj)
modelSpace (vla-get-ModelSpace doc)
)
)
(setq pt '(0 0 0))
;;; (setq entl (entlast))
(entmake
'((0 . "MTEXT")
(8 . "TEMP_TOOLS")
(100 . "AcDbEntity")
(100 . "AcDbMText")
(10 . (0 0 0))
(40 . 0.9)
(71 . 4)
(72 . 5)
(1
.
"{\\fSimHei;\\Q0;\\W1;\\C5;=====================\\P\\P=====================}"
)
(7 . "STANDARD")
(50 . 0.0)
(73 . 1)
(44 . 1.0)
(90 . 1)
(63 . 4)
(45 . 1.5)
(441 . 0)
)
)
(setq zce_EntMtext (entlast))
(command "DRAWORDER" (entlast) "" "F")
(vlax-ename->vla-object zce_EntMtext)
) ;_zce_addMtext
(defun zc_BarText (n sum / va barstr PrgRun)
(if Bar_cplt
nil
(setq Bar_cplt "■■■■■■■■■■■■■■■■■■■■■■■■■"
Bar_uncp "□□□□□□□□□□□□□□□□□□□□□□□□□"
)
)
(if (and n sum)
(progn
(if (< n 2)
(progn
(zc_delete zc-Bartxt)
(setq zc-Bartxt nil)
)
)
(setq va (/ (* 100 n) sum))
(if (< va 0)
(setq va 2)
(if (>= va 100)
(setq va 100)
)
)
(setq PrgRun (/ va 2))
(if (/= PrgRun zb-PrgRunOld)
(progn
(if (= va 100)
(setq va 99)
)
(setq barstr (strcat
(substr Bar_cplt 1 PrgRun)
(substr Bar_uncp (1+ PrgRun))
" "
(itoa va)
"%"
)
)
(setq zb-PrgRunOld PrgRun)
(zp:BarUpdate barstr)
)
)
)
(zc_delete zc-Bartxt)
)
zc-Bartxt
)
(defun zp:BarUpdate (txt)
(setq txt (strcat "{\\fSimHei;\\Q0;\\W1;\\C1;"
(zc:strRepeat "" "=" (strlen txt))
"\\P\\C5;"
txt
"\\P\\C1;"
(zc:strRepeat "" "=" (strlen txt))
"}"
)
)
(if (or (not zc-Bartxt) (vlax-erased-p zc-Bartxt))
(progn
(setq zc-Bartxt (zce_addMtext))
(zb:movePMcenter zc-Bartxt)
)
)
(if txt
(vla-put-TextString zc-Bartxt txt)
)
(vla-update zc-Bartxt)
)
(defun zc:strRepeat (s a tolen)
(while (< (strlen s) tolen)
(setq s (strcat s a))
)
)
(defun zb:movePMcenter (zce_objtxt / VIEWSIZEY SCREENSIZE
viewctr VIEWSIZEX zce_TextHeight
mtY mtX x y
pte entMT
)
(if (/= 'VLA-OBJECT (type zce_objtxt))
(setq zce_objtxt (vlax-ename->vla-object zce_objtxt))
)
(setq VIEWSIZEY (GETVAR "VIEWSIZE")
SCREENSIZE (GETVAR "SCREENSIZE")
viewctr (getvar "viewctr")
VIEWSIZEX (* (/ VIEWSIZEY
(CADR SCREENSIZE)
)
(CAR SCREENSIZE)
)
)
(setq zce_TextHeight
(/ (/ VIEWSIZEY (CADR SCREENSIZE))
0.0735852
)
)
(vla-put-Height zce_objtxt zce_TextHeight) ;重置文字高度
(vla-put-AttachmentPoint
zce_objtxt
acAttachmentPointMiddleCenter
)
(setq pte (vlax-3d-point (trans viewctr 1 0)))
(vla-put-insertionPoint zce_objtxt pte)
)

;;; ;;(ProgressbarDCL  "c:testDCLbar" "测试");;调用 
(defun c:testDCLbar (/ Bar_cplt) 
  (setq        i   0 
        sum 100000 
  ) 
  (repeat sum 
    (ProgressBarText (setq i (1+ i)) sum) 
  ) 
  (princ) 
) 
(defun c:testbar (/ Bar_cplt obj) 
  (setq        i   0 
        sum 100000 
  ) 
  (repeat sum 
    (setq obj (zc_BarText (setq i (1+ i)) sum)) 
  ) 
  (zc_delete obj) 
  (princ) 
) 
 
 
(defun ProgressBar (va / bar_dL bar_L msg) 
  (if (< va 0) 
    (setq va 0) 
  ) 
  (if (>= va 100) 
    (setq va 100) 
  ) 
  (if (not Bar_cplt) 
    (progn 
      (setq 
        Bar_cplt "■■■■■■■■■■■■■■■■■■■■■■■■■" 
        Bar_uncp "□□□□□□□□□□□□□□□□□□□□□□□□□" 
        bar_i         0 
        bar_L         0 
        msg         "0%" 
        barStr         (strcat Bar_uncp " " msg) 
      ) 
      (grtext -1 barStr) 
    ) 
  ) 
  (if (/= va bar_i) 
    (progn 
      (setq 
        bar_L  (/ va 4) 
        barStr (strcat 
                 (substr Bar_cplt 1 (* 2 bar_L)) 
                 (substr Bar_uncp (1+ (* 2 bar_L))) 
                 " " 
                 (itoa va) 
                 "%" 
               ) 
        bar_i  va 
      ) 
      (grtext -1 barStr) 
    ) 
  ) 
) 
 
;;;;;;========ZYZC_DCL.DCL=========== 
;;;   ProgressBar:dialog{ 
;;;  :text_part{ 
;;;    label="进度"; 
;;;    key="msg"; 
;;;    } 
;;;    spacer_1; 
;;;    : boxed_row { 
;;;      :text_part{ 
;;;        label="□□□□□□□□□□□□□□□□□□□□□□□□□ 0%  "; 
;;;        height=2; 
;;;          key="listTitleword"; 
;;;          } 
;;;          
;;;      } 
;;;  spacer_1;    //空出一行 
;;;  ok_cancel;       
;;;} 
;;;;;;========ZYZC_DCL.DCL=========== 
 
(defun ProgressbarDCL (funName msg / PrgRunOld dcl_id tilestr dd2) 
  (if (not msg) 
    (setq msg "是否运行？") 
  ) 
  (setq PrgRunOld 0) 
  (setq dcl_id (load_dialog "ZYZC_DCL.DCL")) 
  (new_dialog "ProgressBar" dcl_id "" nil) 
  (set_tile "msg" msg) 
  (setq tilestr (strcat "(" funName ")(done_dialog 22)")) 
  (apply 'action_tile (list "accept" tilestr)) 
  (setq dd2 (start_dialog)) 
) 
(defun ProgressBarText (n sum / Bar_cplt Bar_uncp va barstr PrgRun) 
  (setq        Bar_cplt "■■■■■■■■■■■■■■■■■■■■■■■■■" 
        Bar_uncp "□□□□□□□□□□□□□□□□□□□□□□□□□" 
  ) 
  (setq va (/ (* 100 n) sum)) 
  (if (< va 0) 
    (setq va 0) 
    (if        (> va 100) 
      (setq va 100) 
    ) 
  ) 
  (if (= va 0) 
    (setq barstr (strcat Bar_uncp " 0%") 
          PrgRun 0 
    ) 
    (setq PrgRun (* 2 (/ va 4)) 
          barstr (strcat 
                   (substr Bar_cplt 1 PrgRun) 
                   (substr Bar_uncp (1+ PrgRun)) 
                   " " 
                   (itoa va) 
                   "% [" 
                   (itoa n) 
                   "/" 
                   (itoa sum) 
                   "]" 
                 ) 
    ) 
  ) 
  (if (/= va PrgRunOld) 
    (progn (setq PrgRunOld va) 
           (VL-CATCH-ALL-APPLY 'set_tile (list "listTitleword" barstr)) 
    ) 
  ) 
  barstr 
) 
 
;;;删除对象 
(defun zc_delete (e) 
  (if e 
    (if        (vlax-erased-p e) 
      nil 
      (if (= (type e) 'ENAME) 
        (entdel e) 
        (vla-Delete e) 
      ) 
    ) 
  ) 
) ;_zc_delete 
 
;;;创建文件 
(defun zce_addMtext (/ pt entl doc EPtxt) 
  (if (= modelSpace nil) 
    (setq acadObj    (vlax-get-acad-object) 
    doc       (vla-get-ActiveDocument acadObj) 
    modelSpace (vla-get-ModelSpace doc) 
    ) 
  ) 
 
  (setq pt '(0 0 0)) 
;;;  (setq entl (entlast)) 
  (entmake 
    '((0 . "MTEXT") 
      (8 . "TEMP_TOOLS") 
      (100 . "AcDbEntity") 
      (100 . "AcDbMText") 
      (10 . (0 0 0)) 
      (40 . 0.9) 
      (71 . 4) 
      (72 . 5) 
      (1 
       . 
       "{\\fSimHei;\\Q0;\\W1;\\C5;=====================\\P\\P=====================}" 
      ) 
      (7 . "STANDARD") 
      (50 . 0.0) 
      (73 . 1) 
      (44 . 1.0) 
      (90 . 1) 
      (63 . 4) 
      (45 . 1.5) 
      (441 . 0) 
     ) 
  ) 
  (setq zce_EntMtext (entlast)) 
  (command "DRAWORDER" (entlast) "" "F") 
  (vlax-ename->vla-object zce_EntMtext) 
) ;_zce_addMtext 
 
(defun zc_BarText (n sum / va barstr PrgRun) 
  (if Bar_cplt 
    nil 
    (setq Bar_cplt "■■■■■■■■■■■■■■■■■■■■■■■■■" 
          Bar_uncp "□□□□□□□□□□□□□□□□□□□□□□□□□" 
    ) 
  ) 
  (if (and n sum) 
    (progn 
      (if (< n 2) 
        (progn 
          (zc_delete zc-Bartxt) 
          (setq zc-Bartxt nil) 
        ) 
      ) 
      (setq va (/ (* 100 n) sum)) 
      (if (< va 0) 
        (setq va 2) 
        (if (>= va 100) 
          (setq va 100) 
        ) 
      ) 
      (setq PrgRun (/ va 2)) 
      (if (/= PrgRun zb-PrgRunOld) 
        (progn 
          (if (= va 100) 
            (setq va 99) 
          ) 
          (setq        barstr (strcat 
                         (substr Bar_cplt 1 PrgRun) 
                         (substr Bar_uncp (1+ PrgRun)) 
                         " " 
                         (itoa va) 
                         "%" 
                       ) 
          ) 
          (setq zb-PrgRunOld PrgRun) 
          (zp:BarUpdate barstr) 
        ) 
      ) 
    ) 
    (zc_delete zc-Bartxt) 
  ) 
  zc-Bartxt 
) 
(defun zp:BarUpdate (txt) 
  (setq        txt (strcat "{\\fSimHei;\\Q0;\\W1;\\C1;" 
                    (zc:strRepeat "" "=" (strlen txt)) 
                    "\\P\\C5;" 
                    txt 
                    "\\P\\C1;" 
                    (zc:strRepeat "" "=" (strlen txt)) 
                    "}" 
            ) 
  ) 
  (if (or (not zc-Bartxt) (vlax-erased-p zc-Bartxt)) 
    (progn 
      (setq zc-Bartxt (zce_addMtext))       
      (zb:movePMcenter zc-Bartxt) 
    ) 
  ) 
  (if txt 
    (vla-put-TextString zc-Bartxt txt) 
  ) 
  (vla-update zc-Bartxt) 
) 
(defun zc:strRepeat (s a tolen) 
  (while (< (strlen s) tolen) 
    (setq s (strcat s a)) 
  ) 
) 
 
(defun zb:movePMcenter (zce_objtxt /              VIEWSIZEY         SCREENSIZE 
                        viewctr           VIEWSIZEX  zce_TextHeight 
                        mtY           mtX              x                 y 
                        pte           entMT 
                       ) 
  (if (/= 'VLA-OBJECT (type zce_objtxt)) 
    (setq zce_objtxt (vlax-ename->vla-object zce_objtxt)) 
  ) 
  (setq        VIEWSIZEY  (GETVAR "VIEWSIZE") 
        SCREENSIZE (GETVAR "SCREENSIZE") 
        viewctr           (getvar "viewctr") 
        VIEWSIZEX  (* (/ VIEWSIZEY 
                         (CADR SCREENSIZE) 
                      ) 
                      (CAR SCREENSIZE) 
                   ) 
  ) 
  (setq        zce_TextHeight 
         (/ (/ VIEWSIZEY (CADR SCREENSIZE)) 
            0.0735852 
         ) 
  ) 
  (vla-put-Height zce_objtxt zce_TextHeight) ;重置文字高度    
  (vla-put-AttachmentPoint 
    zce_objtxt 
    acAttachmentPointMiddleCenter 
  ) 
  (setq pte (vlax-3d-point (trans viewctr 1 0))) 
  (vla-put-insertionPoint zce_objtxt pte) 
)

你有种再说一遍 · 发表于 2025-6-11 00:37:07

auto,写错了

锋十七 · 发表于 2025-6-11 09:09:05

看着不错，学习一下

言戲無軍 · 发表于 2025-6-11 09:32:37

这样CAD不会卡死了吧

hn10183051 · 发表于 2025-6-11 12:59:45

很强，就是不知道会不会卡死

Sring65 · 发表于 2025-6-11 19:22:52

hn10183051 发表于 2025-6-11 12:59
很强，就是不知道会不会卡死

DCL的会卡死，文本形式的不会卡死

kozmosovia · 发表于 2025-6-11 19:51:17

Sring65 发表于 2025-6-11 19:22
DCL的会卡死，文本形式的不会卡死

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

菜卷鱼 · 发表于 2025-6-12 15:04:41

小程序可以，大程序反而增加了运算量，更卡了

Sring65 · 发表于 2025-6-12 19:40:36

菜卷鱼发表于 2025-6-12 15:04
小程序可以，大程序反而增加了运算量，更卡了

小程序没必要，大程序本来就慢再慢点无所谓，有个进度看个乐

账号		自动登录	找回密码
密码			注册

[源码] autolisp进度条

本帖子中包含更多资源

评分