Thanks Lee. That makes sense, but it is annoying. I'll try the dummy (grread) call.
It's a no go. The (grread) seems to prevent the progress bar from progressing. It never updates even if the mouse is moved. Any other ideas?
I'm using DOSLib, specifically dos_getprogress, to display a progress bar to the user while blocks are being processed. Unfortunately, Windows keeps breaking in and adding "(Not Responding)" to the progress bar title and halting the bar even though the program is continuing to process. Does anyone know how to keep focus with the progress bar? Or another method?
(setq spin 0)
;;; get a selection set and convert to a list of enames
(setq total (strcat " of " (itoa (length set1))))
(foreach memb set1
;;; do stuff
(setq spin (1+ spin))
(if (= (rem spin 10) 0)
(cond ( (< spin 100) (princ (strcat "\rProcessing " (itoa spin) total)))
( (< spin 1000) (princ (strcat "\rProcessing " (itoa spin) total)))
( (< spin 10000) (princ (strcat "\rProcessing " (itoa spin) total)))
(t (princ (strcat "\rProcessing " (itoa spin) total)))
)
)
)
(princ (strcat "\rTrimming " total " of " total))
I tested the routine I took the snippet from on a drawing with over 13000 applicable entities. It ran to completion in about 96 seconds on Bricscad, and the command line was updated as expected. I ran the same code in Autocad 2010 (after adding the functions necessary to emulate Bricscad's vle-functions) and it also ran to completion in about 4 minutes. Not sure what I'm doing to avoid the timeout but it works for me.
I was never able to make progress bars work well so I went to reports on the command line with code similar to:In a compiled vlx nothing echoes to the command line until the loop is complete. At least the progress bar is in your face so you know something is happening.Code: [Select]
(setq spin 0)
;;; get a selection set and convert to a list of enames
(setq total (strcat " of " (itoa (length set1))))
(foreach memb set1
;;; do stuff
(setq spin (1+ spin))
(if (= (rem spin 10) 0)
(cond ( (< spin 100) (princ (strcat "\rProcessing " (itoa spin) total)))
( (< spin 1000) (princ (strcat "\rProcessing " (itoa spin) total)))
( (< spin 10000) (princ (strcat "\rProcessing " (itoa spin) total)))
(t (princ (strcat "\rProcessing " (itoa spin) total)))
)
)
)
(princ (strcat "\rTrimming " total " of " total))
In a compiled vlx nothing echoes to the command line until the loop is complete. At least the progress bar is in your face so you know something is happening.
(princ "\r")(prin1 en)
(setq sl (sslength ss)
i 0)
then
(princ (strcat ("\r" (rtos (* (/ i sl) 10.) 2 1)))) "% ")
To anyone interested,
I contacted Dale with DOSLib and he gave me a fix for my problem:
< ... >
(defun MP:String ( char n )
( (lambda ( s n )
(while (< (strlen s) n) (setq s (strcat s s)))
(substr s 1 n)
)
(if (eq 'int (type char)) (chr char) char)
(max 0 (fix n))
)
)
(defun MP:Left ( text n / len )
(if (< (setq n (max (fix n) 0)) (setq len (strlen text)))
(substr text 1 n)
text
)
)
(defun MP:Right ( text n / len )
(if (< (setq n (max (fix n) 0)) (setq len (strlen text)))
(substr text (1+ (- len n)))
text
)
)
(defun MP:Flush ( / cmdecho millisecs ceiling )
(cond
( (null (setq ceiling 2000 millisecs (getvar 'millisecs)))
)
( (/= 'int (type *MP:Flush:MilliSecs*))
(setq *MP:Flush:MilliSecs* millisecs)
)
( (< ceiling (- millisecs *MP:Flush:MilliSecs*))
(setq cmdecho (getvar 'cmdecho))
(setvar 'cmdecho 0)
(vl-cmdf ".delay" 0)
(setvar 'cmdecho cmdecho)
(setq *MP:Flush:MilliSecs* millisecs)
)
)
(princ)
)
(defun MP:Status ( message percent )
;; Use percent arg to:
;;
;; * Initialize (via t) ................ e.g. (MP:Status nil T)
;; * Clean up (via nil) ................ e.g. (MP:Status nil nil)
;; * Specify percent (via 0 - 100) ..... e.g. (MP:Status "Message" 42)
(MP:Flush)
(cond
( (member percent '(nil t))
(princ (strcat "\r" (MP:String " " 80)))
)
( (<= 0 (setq percent (fix percent)) 100)
(if (/= percent *MP:Status:Percent*)
(progn
(princ
(strcat
"\r" (MP:String " " 80)
"\r" message
" [" (MP:Right (strcat "0" (itoa (min 99 percent))) 2) "%] "
(MP:Left
(strcat
(MP:String "•" (/ percent 2.0))
(MP:String "·" 50)
)
50
)
)
)
(setq *MP:Status:Percent* percent)
)
)
)
)
(princ)
)
(defun c:Test ( / i ceiling )
;; initialize
(MP:Status nil t)
(setq i -1)
(repeat (setq ceiling 5000000)
;; display message and percent
(MP:Status "MP:Status Test:" (/ (* 100.0 (setq i (1+ i))) ceiling))
)
;; cleanup
(MP:Status nil nil)
(princ)
)
(defun MP:Status ( message percent )
;; Use percent arg to:
;;
;; * Initialize (via t) ................ e.g. (MP:Status nil T)
;; * Clean up (via nil) ................ e.g. (MP:Status nil nil)
;; * Specify percent (via 0 - 100) ..... e.g. (MP:Status "Message" 42)
(MP:Flush)
(cond
( (eq t percent)
(setq *MP:Status:ModeMacro* (getvar 'modemacro))
(setvar 'modemacro "")
)
( (null percent)
(setvar 'modemacro *MP:Status:ModeMacro*)
)
( (<= 0 (setq percent (fix percent)) 100)
(if (/= percent *MP:Status:Percent*)
(progn
(setvar 'modemacro
(strcat
message
" [" (MP:Right (strcat "0" (itoa (min 99 percent))) 2) "%] ["
(MP:Left
(strcat
(MP:String "|" 100)
(MP:String "·" 100)
)
100
)
"]"
)
)
(setq *MP:Status:Percent* percent)
)
)
)
)
(princ)
)
(defun MP:Echo ( x / cmdecho millisecs ceiling )
(cond
( (null (setq ceiling 2000 millisecs (getvar 'millisecs)))
)
( (/= 'int (type *MP:Echo:MilliSecs*))
(setq *MP:Echo:MilliSecs* millisecs)
)
( (< ceiling (- millisecs *MP:Echo:MilliSecs*))
(setq cmdecho (getvar 'cmdecho))
(setvar 'cmdecho 0)
(vl-cmdf ".delay" 0)
(setvar 'cmdecho cmdecho)
(setq *MP:Echo:MilliSecs* millisecs)
)
)
(if (eq 'str (type x))
(setvar 'modemacro (vl-string-trim "\n\r\t" x))
)
(princ x)
(princ)
)
(progn
(foreach file file_list
(MP:Echo (strcat "\nProcessing [" (vl-filename-base file) ".dwg ..."))
(MP:AbuseDwgViaObjectDBX file report_handle)
;; ... yada ad infinitum ...
)
(MP:Echo "\nFinito")
)
Also (command "_.delay" ... ) might be worth a shot.
I guess it works then :lol:
(defun progress_lgx(current_pcs tatoal current1_pcs tatoal1 / lgx_screenmin_point lgx_screenmax_point width-x_lgx
height-y_lgx half-y_lgx grve_lgx min-x_lgx max-x_lgx y_zl_lgx x_zl_lgx)
;;;By: Liu new
(redraw)
(setq lgx_screenmin_point(list (- (car (getvar "viewctr")) (/ (*(/ (getvar "viewsize") (cadr (getvar "screensize"))) (car (getvar "screensize"))) 2))
(- (cadr (getvar "viewctr")) (/ (getvar "viewsize") 2))))
(setq lgx_screenmax_point(list (+ (car (getvar "viewctr")) (/ (*(/ (getvar "viewsize") (cadr (getvar "screensize"))) (car (getvar "screensize"))) 2))
(+ (cadr (getvar "viewctr")) (/ (getvar "viewsize") 2))))
(setq width-x_lgx (- (car lgx_screenmax_point)(car lgx_screenmin_point)))
(setq height-y_lgx (- (cadr lgx_screenmax_point)(cadr lgx_screenmin_point)))
(setq half-y_lgx (+ (cadr lgx_screenmin_point)(* height-y_lgx 0.5)))
(if (and (/= tatoal nil)(> tatoal 0))
(progn
(setq grve_lgx nil)
(setq min-x_lgx (+ (car lgx_screenmin_point)(* width-x_lgx 0.25)))
(setq max-x_lgx (- (car lgx_screenmax_point)(* width-x_lgx 0.25)))
(if (and (/= tatoal1 nil)(> tatoal1 0))
(progn
(setq min-y_lgx (+ half-y_lgx (* height-y_lgx 0.005)))
(setq max-y_lgx (+ half-y_lgx (* height-y_lgx 0.025)))
)
(progn
(setq min-y_lgx (- half-y_lgx (* height-y_lgx 0.01)))
(setq max-y_lgx (+ half-y_lgx (* height-y_lgx 0.01)))
)
)
(setq grve_lgx (list (list min-x_lgx min-y_lgx)(list min-x_lgx max-y_lgx)
(list min-x_lgx min-y_lgx)(list max-x_lgx min-y_lgx)
(list min-x_lgx max-y_lgx)(list max-x_lgx max-y_lgx)
(list max-x_lgx max-y_lgx)(list max-x_lgx min-y_lgx)))
(grvecs (cons 98 grve_lgx))
(setq grve_lgx nil)
(setq y_zl_lgx (/(* height-y_lgx 0.02) 11.0))
(if (/= current_pcs 0)
(setq x_zl_lgx (* width-x_lgx 0.5 (/ (float current_pcs) (float tatoal))))
(setq x_zl_lgx 0)
)
(setq max-x_lgx (+ min-x_lgx x_zl_lgx))
(repeat 10
(setq min-y_lgx (+ min-y_lgx y_zl_lgx))
(setq max-y_lgx min-y_lgx)
(setq grve_lgx (list (list min-x_lgx min-y_lgx)(list min-x_lgx max-y_lgx)
(list min-x_lgx min-y_lgx)(list max-x_lgx min-y_lgx)
(list min-x_lgx max-y_lgx)(list max-x_lgx max-y_lgx)
(list max-x_lgx max-y_lgx)(list max-x_lgx min-y_lgx)))
(grvecs (cons 1 grve_lgx))
)
)
)
(if (and (/= tatoal1 nil)(> tatoal1 0))
(progn
(setq grve_lgx nil)
(setq min-x_lgx (+ (car lgx_screenmin_point)(* width-x_lgx 0.25)))
(setq max-x_lgx (- (car lgx_screenmax_point)(* width-x_lgx 0.25)))
(setq min-y_lgx (- half-y_lgx (* height-y_lgx 0.025)))
(setq max-y_lgx (- half-y_lgx (* height-y_lgx 0.005)))
(setq grve_lgx (list (list min-x_lgx min-y_lgx)(list min-x_lgx max-y_lgx)
(list min-x_lgx min-y_lgx)(list max-x_lgx min-y_lgx)
(list min-x_lgx max-y_lgx)(list max-x_lgx max-y_lgx)
(list max-x_lgx max-y_lgx)(list max-x_lgx min-y_lgx)))
(grvecs (cons 98 grve_lgx))
(setq grve_lgx nil)
(setq y_zl_lgx (/(* height-y_lgx 0.02) 11.0))
(if (/= current1_pcs 0)
(setq x_zl_lgx (* width-x_lgx 0.5 (/ (float current1_pcs) (float tatoal1))))
(setq x_zl_lgx 0)
)
(setq max-x_lgx (+ min-x_lgx x_zl_lgx))
(repeat 10
(setq min-y_lgx (+ min-y_lgx y_zl_lgx))
(setq max-y_lgx min-y_lgx)
(setq grve_lgx (list (list min-x_lgx min-y_lgx)(list min-x_lgx max-y_lgx)
(list min-x_lgx min-y_lgx)(list max-x_lgx min-y_lgx)
(list min-x_lgx max-y_lgx)(list max-x_lgx max-y_lgx)
(list max-x_lgx max-y_lgx)(list max-x_lgx min-y_lgx)))
(grvecs (cons 1 grve_lgx))
)
)
)
)
(defun c:test()
(setq current 1)
(setq current1 1)
(while (/= (car (apply 'GRREAD '(t 7 0))) 11)
(progress_lgx current 1000 current1 100)
(setq current (+ current 1))
(setq current1 (+ current1 1))
(if (= current 1000) (setq current 1))
(if (= current1 100) (setq current1 1))
)
)
;;;How time can be used to control the progress bar is displayed, for example,
;;;I would like to use the following methods, but shows the process can not be displayed
;;;(progn
;;;(setq current 1)
;;;(repeat 51
;;;(setq time_start (getvar "cdate"))
;;;(while (< (* 1000000 (- (setq time_end (getvar "cdate")) time_start)) 0.03))
;;;(progress_lgx current 100 current 150)
;;;(setq current (+ current 2))
;;;)
;;;)
(defun progress_lgx(current_pcs tatoal current1_pcs tatoal1 / lgx_screenmin_point lgx_screenmax_point width-x_lgx
height-y_lgx half-y_lgx grve_lgx min-x_lgx max-x_lgx y_zl_lgx x_zl_lgx)
;;;(progn ;;;Examples are
;;;(setq current 0)
;;;(repeat 11
;;;(progress_lgx current 100 current 150)
;;;(while (/= (getpoint) nil))
;;;(setq current (+ current 10))
;;;)
;;;(repeat 11
;;;(progress_lgx current 100 current 0)
;;;(while (/= (getpoint) nil))
;;;(setq current (+ current 10))
;;;)
;;;)
;;;??,??: ???
;;;?????
(redraw)
(setq lgx_screenmin_point(list (- (car (getvar "viewctr")) (/ (*(/ (getvar "viewsize") (cadr (getvar "screensize"))) (car (getvar "screensize"))) 2))
(- (cadr (getvar "viewctr")) (/ (getvar "viewsize") 2))))
(setq lgx_screenmax_point(list (+ (car (getvar "viewctr")) (/ (*(/ (getvar "viewsize") (cadr (getvar "screensize"))) (car (getvar "screensize"))) 2))
(+ (cadr (getvar "viewctr")) (/ (getvar "viewsize") 2))))
(setq width-x_lgx (- (car lgx_screenmax_point)(car lgx_screenmin_point)))
(setq height-y_lgx (- (cadr lgx_screenmax_point)(cadr lgx_screenmin_point)))
(setq half-y_lgx (+ (cadr lgx_screenmin_point)(* height-y_lgx 0.5)))
(if (and (/= tatoal nil)(> tatoal 0))
(progn
(setq grve_lgx nil)
(setq min-x_lgx (+ (car lgx_screenmin_point)(* width-x_lgx 0.25)))
(setq max-x_lgx (- (car lgx_screenmax_point)(* width-x_lgx 0.25)))
(if (and (/= tatoal1 nil)(> tatoal1 0))
(progn
(setq min-y_lgx (+ half-y_lgx (* height-y_lgx 0.005)))
(setq max-y_lgx (+ half-y_lgx (* height-y_lgx 0.025)))
)
(progn
(setq min-y_lgx (- half-y_lgx (* height-y_lgx 0.01)))
(setq max-y_lgx (+ half-y_lgx (* height-y_lgx 0.01)))
)
)
(setq grve_lgx (list (list min-x_lgx min-y_lgx)(list min-x_lgx max-y_lgx)
(list min-x_lgx min-y_lgx)(list max-x_lgx min-y_lgx)
(list min-x_lgx max-y_lgx)(list max-x_lgx max-y_lgx)
(list max-x_lgx max-y_lgx)(list max-x_lgx min-y_lgx)))
(grvecs (cons 98 grve_lgx))
(setq grve_lgx nil)
(setq y_zl_lgx (/(* height-y_lgx 0.02) 11.0))
(if (/= current_pcs 0)
(setq x_zl_lgx (* width-x_lgx 0.5 (/ (float current_pcs) (float tatoal))))
(setq x_zl_lgx 0)
)
(setq max-x_lgx (+ min-x_lgx x_zl_lgx))
(repeat 10
(setq min-y_lgx (+ min-y_lgx y_zl_lgx))
(setq max-y_lgx min-y_lgx)
(setq grve_lgx (list (list min-x_lgx min-y_lgx)(list min-x_lgx max-y_lgx)
(list min-x_lgx min-y_lgx)(list max-x_lgx min-y_lgx)
(list min-x_lgx max-y_lgx)(list max-x_lgx max-y_lgx)
(list max-x_lgx max-y_lgx)(list max-x_lgx min-y_lgx)))
(grvecs (cons 1 grve_lgx))
)
)
)
(if (and (/= tatoal1 nil)(> tatoal1 0))
(progn
(setq grve_lgx nil)
(setq min-x_lgx (+ (car lgx_screenmin_point)(* width-x_lgx 0.25)))
(setq max-x_lgx (- (car lgx_screenmax_point)(* width-x_lgx 0.25)))
(setq min-y_lgx (- half-y_lgx (* height-y_lgx 0.025)))
(setq max-y_lgx (- half-y_lgx (* height-y_lgx 0.005)))
(setq grve_lgx (list (list min-x_lgx min-y_lgx)(list min-x_lgx max-y_lgx)
(list min-x_lgx min-y_lgx)(list max-x_lgx min-y_lgx)
(list min-x_lgx max-y_lgx)(list max-x_lgx max-y_lgx)
(list max-x_lgx max-y_lgx)(list max-x_lgx min-y_lgx)))
(grvecs (cons 98 grve_lgx))
(setq grve_lgx nil)
(setq y_zl_lgx (/(* height-y_lgx 0.02) 11.0))
(if (/= current1_pcs 0)
(setq x_zl_lgx (* width-x_lgx 0.5 (/ (float current1_pcs) (float tatoal1))))
(setq x_zl_lgx 0)
)
(setq max-x_lgx (+ min-x_lgx x_zl_lgx))
(repeat 10
(setq min-y_lgx (+ min-y_lgx y_zl_lgx))
(setq max-y_lgx min-y_lgx)
(setq grve_lgx (list (list min-x_lgx min-y_lgx)(list min-x_lgx max-y_lgx)
(list min-x_lgx min-y_lgx)(list max-x_lgx min-y_lgx)
(list min-x_lgx max-y_lgx)(list max-x_lgx max-y_lgx)
(list max-x_lgx max-y_lgx)(list max-x_lgx min-y_lgx)))
(grvecs (cons 1 grve_lgx))
)
)
)
)
(defun c:test2(/ current time_start loop time_end)
(setq current 1)
(repeat 101
(setq time_start (getvar "cdate"))
(setq loop t)
(while loop
(if (> (* 1000000 (- (setq time_end (getvar "cdate")) time_start)) 0.04)
(setq loop nil)
)
(princ)
(progress_lgx current 100 current 150)
)
(setq current (+ current 1))
)
)
(defun c:test1(/ current loop)
(setq current 1)
(setq loop t)
(while loop
(princ)
(progress_lgx current 150 current 100)
(setq current (+ current 0.05))
(if (>= current 100)
(setq loop nil)
)
)
)
(defun c:test(/ current loop)
(setq current 1)
(setq loop t)
(while loop
(princ)
(progress_lgx current 100 nil nil)
(setq current (+ current 0.05))
(if (>= current 100)
(setq loop nil)
)
)
)
(DEFUN c:test (/ i)
(GRTEXT -1 "Testing Process")
(SETQ i -1)
(REPEAT 10000 (progress (SETQ i (1+ i)) 10000 3))
(GRTEXT)
)
(DEFUN progress (i n bit / BOX INTEGER NUM REMAINDER)
(SETQ box (NTH bit
'(("")
("" "▌")
("" "▎" "▌" "▊")
("" "▏" "▎" "▍" "▌" "▋" "▊" "▉")
)
)
)
(SETQ num (EXPT 2 bit))
(SETQ integer (FIX (/ (* 20 num i) n)))
(SETQ remainder (REM integer num))
(GRTEXT -2
(STRCAT (SUBSTR "████████████████████"
1
(* 2 (FIX (/ integer num)))
)
(NTH remainder box)
)
)
)
;-----------------------------------
Function explanation:
1.progress function of bit parameters can be understood as the status line accuracy, and it is hoped the black block "█" subdivided into several Accept 0,1,2,3 four precision value.
2. Use the nth reason to see the following speed test, after all, it is not worth while displaying the progress bar to spend unnecessary time.
3. (GRTEXT -1 "Test Process") statement for an independent, not allowed to join the progress bar function, otherwise the status line frequently flashing, affect the display.
4. "████████████████████" alternative intermittent, such as "▊▊▊▊▊▊▊▊▊▊▊▊▊▊▊▊ needed ▊▊▊▊ "
;----------------------------------------
(DEFUN Box1 (/ BOX I)
(SETQ i -1)
(REPEAT 8
(SETQ i (1+ i))
(SETQ box (NTH i '("" "▏" "▎" "▍" "▌" "▋" "▊" "▉")))
)
)
(DEFUN Box2 (/ BOX I)
(SETQ i -1)
(REPEAT 8
(SETQ i (1+ i))
(COND ((= i 0) (SETQ box ""))
((= i 1) (SETQ box "▏"))
((= i 2) (SETQ box "▎"))
((= i 3) (SETQ box "▍"))
((= i 4) (SETQ box "▌"))
((= i 5) (SETQ box "▋"))
((= i 6) (SETQ box "▊"))
((= i 7) (SETQ box "▉"))
)
)
)
(DEFUN Box3 (/ BOX I)
(SETQ i -1)
(REPEAT 8
(SETQ i (1+ i))
(SETQ box (STRCAT (CHR 168) (CHR (- 136 i))))
)
)
(DEFUN Box4 (/ BOX BOX0 BOX1 BOX2 BOX3 BOX4 BOX5 BOX6 BOX7 I)
(SETQ Box0 "")
(SETQ Box1 "▏")
(SETQ Box2 "▎")
(SETQ Box3 "▍")
(SETQ Box4 "▌")
(SETQ Box5 "▋")
(SETQ Box6 "▊")
(SETQ Box7 "▉")
(setq i -1)
(REPEAT 8
(SETQ i (1+ i))
(setq box (EVAL (READ (STRCAT "Box" (ITOA i)))))
)
)
;;
;;Benchmarking .................Elapsed milliseconds / relative speed for 16384 iteration(s):
;;
;; (BOX1).....1234 / 1.72 <fastest>
;; (BOX2).....1469 / 1.45
;; (BOX3).....1656 / 1.28
;; (BOX4).....2125 / 1 <slowest>
Because of frequent calls grtext write status line affect the efficiency,
It improved again as follows, without prejudice to the progress bar shows the premise of reducing the number of calls grtext reserved posted first purpose is to facilitate the comparison of two ways.
The number of executions has been changed to 100,000, but most call 160 grtext, show the same effect
(DEFUN c:test (/ i)
(GRTEXT -1 "Testing Process")
(SETQ i -1)
(REPEAT 100000 (progress (SETQ i (1+ i)) 100000 3))
(GRTEXT)
)
(DEFUN progress (i n bit / BOX INTEGER NUM REMAINDER)
(SETQ num (EXPT 2 bit))
(IF (OR (<= n (* num 20))
(AND (> n (* num 20)) (= (REM i (FIX (/ n num 20))) 1))
)
(PROGN (SETQ box (NTH bit
'(("")
("" "▌")
("" "▎" "▌" "▊")
("" "▏" "▎" "▍" "▌" "▋" "▊" "▉")
)
)
)
(SETQ integer (FIX (/ (* 20 num i) n)))
(SETQ remainder (REM integer num))
(GRTEXT -2
(STRCAT (SUBSTR "████████████████████"
1
(* 2 (FIX (/ integer num)))
)
(NTH remainder box)
)
)
)
)
)