TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: CincyJeff on January 26, 2016, 01:49:55 PM

Title: Progress Bar
Post by: CincyJeff on January 26, 2016, 01:49:55 PM
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?
Title: Re: Progress Bar
Post by: Lee Mac on January 26, 2016, 02:02:25 PM
See here (http://bit.ly/1ca5JOs) for an explanation of why this happens; as far as I am aware, the only way to avoid this is to obtain some form of user input whilst processing (e.g. include a grread call within your processing loop).
Title: Re: Progress Bar
Post by: CincyJeff on January 26, 2016, 02:13:26 PM
Thanks Lee. That makes sense, but it is annoying. I'll try the dummy (grread) call.
Title: Re: Progress Bar
Post by: Lee Mac on January 26, 2016, 02:22:58 PM
Thanks Lee. That makes sense, but it is annoying. I'll try the dummy (grread) call.

Just be aware that the user will need to move the mouse during processing for the program to continue - though, the slightest mouse movement will suffice.

FWIW, here's an example (http://lee-mac.com/clock.html) of this technique - the RUNCLOCK command works in this way.
Title: Re: Progress Bar
Post by: CincyJeff on January 26, 2016, 03:45:35 PM
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?
Title: Re: Progress Bar
Post by: Lee Mac on January 26, 2016, 03:50:04 PM
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?

Did you include the mouse-tracking argument?

(grread t)
Title: Re: Progress Bar
Post by: CincyJeff on January 26, 2016, 03:56:21 PM
That I did not, however, when I did I found it unacceptable. I don't want to make the users move the mouse just for a progress bar and the program is halted if the mouse is not moved. It can take over a minute to process and it would be nice to inform the user how it is progressing. Thanks any way.
Title: Re: Progress Bar
Post by: Lee Mac on January 26, 2016, 04:22:09 PM
That's the best I could suggest, unless you want to abandon AutoLISP for this task.
Title: Re: Progress Bar
Post by: kdub_nz on January 26, 2016, 04:35:33 PM
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?

Have you reported this to DosLib and provided sufficient information to allow the issue to be reproduced??
I'm sure Dale and co. would treat it with dispatch.
Title: Re: Progress Bar
Post by: MickD on January 26, 2016, 04:39:23 PM
Progress bars can be difficult in any language as it is hard to measure progress on a running routine without interrupting it or getting some sort of feedback somehow.

What about using a GIF in a popup just to let the user know it's busy? You could also show the steps in text if you want to show a bit more information.
Title: Re: Progress Bar
Post by: hmspe on January 26, 2016, 04:51:04 PM
I was never able to make progress bars work well so I went to reports on the command line with code similar to:
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))
Title: Re: Progress Bar
Post by: Lee Mac on January 26, 2016, 04:54:09 PM
Regardless of the chosen display method however, AutoCAD will be rendered non-responsive after 5 seconds of continuous processing in AutoLISP.

FWIW, you can verify this using the following simple function -
Code - Auto/Visual Lisp: [Select]
  1. (defun foo ( n / x )
  2.     (setq x (getvar 'millisecs))
  3.     (while (< (- (getvar 'millisecs) x) n))
  4. )
Code - Auto/Visual Lisp: [Select]
  1. (foo 2000) ;; no problem
  2. (foo 6000) ;; non-responsive for 1s
Title: Re: Progress Bar
Post by: VovKa on January 26, 2016, 06:03:09 PM
https://www.theswamp.org/index.php?topic=49381.msg544927#msg544927
Title: Re: Progress Bar
Post by: hmspe on January 26, 2016, 06:10:58 PM
Lee,

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.
Title: Re: Progress Bar
Post by: Lee Mac on January 26, 2016, 06:40:38 PM
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.

The program will still run to completion, but Windows will render the AutoCAD application as non-responsive after 5 seconds of processing; note that an application window being marked as non-responsive will not halt the processing, but is simply an automatic Windows response when not receiving any feedback from the application's GUI processor thread for 5 seconds.
Title: Re: Progress Bar
Post by: CincyJeff on January 27, 2016, 07:29:11 AM
hmspe,
I was never able to make progress bars work well so I went to reports on the command line with code similar to:
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.
Title: Re: Progress Bar
Post by: hmspe on January 27, 2016, 08:45:47 AM
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.

That could well be.  I don't compile to vlx.  Uncompiled lisp is fast enough for my purposes.  Lee is probably correct about Windows considering programs unresponsive after 5 seconds, but I see no signs of that with this code.  The command line continues to update and there is no "Not Responding" banner in the title bar or dimming of the screen.  The code works for me and meets my expectations.  YMMV. 
Title: Re: Progress Bar
Post by: ymg on January 27, 2016, 09:04:08 AM
CincyJeff,

Did you try with the Express tools one (acet-ui-progress).

You update it in your long loop.  Works for me

I also ran a test with (dos_getprogress) it also works for me
under win 7.  You do need to update the box with (dos_getprogress -1)
within 5 seconds as demonstrated by Lee.

Code - Auto/Visual Lisp: [Select]
  1. (defun c:test ()
  2.    (setq x (getvar 'millisecs)
  3.          y 10000  ;will run 10 seconds)
  4.    )
  5.    (dos_getprogress "Testing" "Testing, please wait..." y)
  6.    (while (< (- (getvar 'millisecs) x) y) (dos_getprogress -1))
  7.    (dos_getprogress t)
  8.    
  9. )
  10.  


ymg
Title: Re: Progress Bar
Post by: David Bethel on January 27, 2016, 10:20:02 AM
I gave up on progress bars a long time ago.

For simple activity indicator
Code: [Select]
(princ "\r")(prin1 en)



For a percentage indicator ( untested)
Code: [Select]
(setq sl (sslength ss)
         i 0)

then

(princ (strcat ("\r" (rtos (* (/ i sl) 10.) 2 1)))) "%      ")


Or simply princ the incremental on decremental counter.

My $0.02  -David
Title: Re: Progress Bar
Post by: CincyJeff on January 27, 2016, 12:27:24 PM
David Bethel,
It looks like the problem is compiling into a vlx. Nothing is echoed to the command line until completion and using the (prin1 en) in a loop produces a single 0 on completion. It looks like my choices come down to uncompiled with working progress bar or compiled with partial progress bar. Thanks for the input.
Title: Re: Progress Bar
Post by: CincyJeff on January 27, 2016, 12:45:00 PM
To anyone interested,
I contacted Dale with DOSLib and he gave me a fix for my problem:
During a long, time consuming task, if AutoCAD does not not have a chance to "peek and pump" it's Windows message queue, then Windows might think the application has hung. So, in your time consuming task, you might want to sprinkle a call to DOS_PAUSE, which will force AutoCAD to flush its message queue, thus keeping the UI alive. Something as simple as this might help:

(dos_pause 0)


Thanks Dale and everyone else that contributed.
Title: Re: Progress Bar
Post by: roy_043 on January 27, 2016, 12:55:30 PM
Would using acet-sys-sleep also work?
Title: Re: Progress Bar
Post by: Lee Mac on January 27, 2016, 12:56:49 PM
Also (command "_.delay" ... ) might be worth a shot.
Title: Re: Progress Bar
Post by: kdub_nz on January 27, 2016, 05:20:10 PM
To anyone interested,
I contacted Dale with DOSLib and he gave me a fix for my problem:
< ... >

I thought that would be the case.

I applaud your efforts to keep your users advised regarding what is happening and your attempts to stop them panicking when your app is running a processor intensive process.

Title: Re: Progress Bar
Post by: MP on January 27, 2016, 06:29:53 PM
Quick & dirty conceptual solution code for those that use the command line for status:

Code: [Select]
(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))
    )

)

Code: [Select]
(defun MP:Left ( text n / len )

    (if (< (setq n (max (fix n) 0)) (setq len (strlen text)))
        (substr text 1 n)
        text
    )

)

Code: [Select]
(defun MP:Right ( text n / len )

    (if (< (setq n (max (fix n) 0)) (setq len (strlen text)))
        (substr text (1+ (- len n)))
        text
    )

)

Code: [Select]
(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)

)

Code: [Select]
(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)

)

Code: [Select]
(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)

)

MP:Status Test: [42%] •••••••••••••••••••••·····························

Cheers.

Edit: Changed to vanilla {code} ... {/code} tags as the {code=cadlisp-7} ... {/code} tags make it highly inconvenient to copy the code.
Title: Re: Progress Bar
Post by: kdub_nz on January 27, 2016, 06:55:43 PM
As nice as that is, quite a few people/firms have the commandline turned off ... or can have.

It's a pity AutoCAD doesn't have an  in-built modeless dialog that is accessible from lisp.
Title: Re: Progress Bar
Post by: MP on January 27, 2016, 06:57:31 PM
Truth. That said, can easily embellish code to abuse modemacro.
Title: Re: Progress Bar
Post by: MP on January 27, 2016, 07:05:35 PM
To wit:

Code: [Select]
(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)

)

Cheers.

Edit: Changed to vanilla {code} ... {/code} tags as the {code=cadlisp-7} ... {/code} tags make it highly inconvenient to copy the code.
Title: Re: Progress Bar
Post by: kdub_nz on January 27, 2016, 07:07:01 PM
yep, modemacro is accustomed to abuse.
Title: Re: Progress Bar
Post by: kdub_nz on January 27, 2016, 07:12:57 PM

It's tempting to put together a lisp callable method using
Autodesk.AutoCAD.Runtime.ProgressMeter in dotNet




Title: Re: Progress Bar
Post by: MP on January 28, 2016, 02:53:14 PM
I scanned over 5000 dwgs today (via objectdbx). AutoCAD didn't "ghost" once.

Using this simple function:

Code: [Select]
(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)

)

i.e.

Code: [Select]
(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")
)

If one just wanted to use MP:Echo as a "DoEvents" type function merely call it with a nil, i.e. (MP:Echo nil).

Cheers.
Title: Re: Progress Bar
Post by: Lee Mac on January 28, 2016, 03:07:51 PM
Also (command "_.delay" ... ) might be worth a shot.

I guess it works then  :lol:
Title: Re: Progress Bar
Post by: GDF on January 28, 2016, 08:26:27 PM
example:
(ACET-UI-PROGRESS-INIT
           "Please Wait while the Program is Running"
           (length DwgList))

(ACET-UI-PROGRESS-SAFE n)
(setq n (+ n 1))
(ACET-UI-PROGRESS-DONE)
Title: Re: Progress Bar
Post by: MP on June 30, 2016, 03:24:22 PM
I guess it works then  :lol:

Sorry -- I missed this post -- it does indeed. :)
Title: Re: Progress Bar
Post by: Lee Mac on June 30, 2016, 07:08:06 PM
 :-)
Title: Re: Progress Bar
Post by: mailmaverick on July 05, 2016, 02:59:04 PM
Out of  (command "_.delay" 0) and (MP:Echo nil), which is better to use ?
Title: Re: Progress Bar
Post by: MP on July 05, 2016, 07:11:26 PM
(command "_.delay" 0)
Title: Re: Progress Bar
Post by: Sam on July 06, 2016, 06:32:40 AM
this is chinese version
author :- lgx
Code: [Select]
(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))
;;;)
;;;)
Title: Re: Progress Bar
Post by: Sam on July 06, 2016, 06:44:02 AM
this is final version
by lgx
Code: [Select]
(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)
)
)
)
Title: Re: Progress Bar
Post by: Sam on July 06, 2016, 06:58:37 AM
one more
Code: [Select]
(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>


Quote
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

Code: [Select]
(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)
                   )
           )
    )
  )
)