Progress bar for looping through foreach section of program

[Travis.Biddle]

I have a program that reads all .txt files from a certain folder and then draws items based off the information found in those .txt files.  Sometimes there may be 5 files, sometimes there may be 250.  Is it possible to implement a progress bar so the impatient users dont think its crashed.  I am able to pull the number of files ahead of time and set a variable "NUMOFTXT".  I have found some progress bar/meter programs, but am having troubles implementing them into the loop.  Below is the code (modified portion of the original code written by @Kent1Cooper) 

(setq numoftxt (vl-directory-files FOLDER "*.txt" 1))
(SETQ NUMOFTXT (LENGTH NUMOFTXT))

(foreach txtfile (vl-directory-files folder "*.txt" 1)
(command "zoom" "w" zoompt1 Zoompt2)
(setq file (open (strcat folder txtfile) "r"))
(while (setq txt (read-line file))
(cond
((wcmatch (vl-string-trim "\t " txt) "'= FILENAME=*")
(setq txt (afterequal) txt (afterequal)); bypass (2) = signs;
(command "layer" "s" "Filename" "")
(command "_.text" "_style" "FILE" "_r" "_none" labeltxtins 0 txt)
); filename-line condition
((wcmatch (vl-string-trim "\t " txt) "TOOL*");;Start of identifying TOOL number
(setq
ToolStr (afterequal); Text string
); setq
); TOOL Number condition---Checks TOOL number in line and sets the # i.e. TOOLNAME=108 will return "108"
((wcmatch (vl-string-trim "\t " txt) "LINE*")
(setq
txt (afterequal) startX (atof (tocomma))
txt (afterequal) startY (atof (tocomma))
txt (afterequal) startZ (atof (tocomma))
txt (afterequal) endX (atof (tocomma))
txt (afterequal) endy (atof (tocomma))
endZ (atof (afterequal))
); setq
(command "layer" "s" toolstr "")
(command "_.line"
"_none" (setq lstart (list (+ startX shift) startY startZ))
"_none" (setq lend (list (+ endX shift) endY endZ))
""
); command
(setq toolstr nil)
(if part ; in a part box?
(if (= lineNo 0); then [outer] -- drew first Line of part box
(setq ; then [inner]
p1 lstart
p2 lend
lineNo 1 ; triggers part Text after next Line
); setq
(progn ; else [inner] -- second Line of part box
(setq ; then
p3 lstart
p4 lend
); setq
(command
"_.text" "_style" "PART" "_none" "_mc"
(mapcar '/ (mapcar '+ (mapcar 'min p1 p2 p3 p4) (mapcar 'max p1 p2 p3 p4)) '(2 2))
0 partStr
); command
(setq part nil); [other 2 part-box Lines ordinary]
); progn
); if [which Line just drawn]
); if [in part box]
); LINE condition

((wcmatch (vl-string-trim "\t " txt) "POINT*")
(setq
txt (afterequal) ptX (atof (tocomma))
txt (afterequal) ptY (atof (tocomma))
ptZ (atof (afterequal))
); setq
(command "layer" "s" toolstr "");;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(command "_.point" "_none" (list (+ ptX shift) ptY ptZ))
); POINT condition

((wcmatch (vl-string-trim "\t " txt) "ARC*")
(setq
txt (afterequal) startX (atof (tocomma))
txt (afterequal) startY (atof (tocomma))
txt (afterequal) ; bypass Z
txt (afterequal) endX (atof (tocomma))
txt (afterequal) endY (atof (tocomma))
txt (afterequal) ; bypass Z
txt (afterequal) ctrX (atof (tocomma))
txt (afterequal) ctrY (atof (tocomma))
); setq
(command "layer" "s" toolstr "");;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(command "_.arc"
"_none" (list (+ startX shift) startY)
"_c" "_none" (list (+ ctrX shift) ctrY)
"_none" (list (+ endX shift) endY)
); command
); ARC condition

((wcmatch (vl-string-trim "\t " txt) "PART*")
(setq
part T ; triggers use of next 2 Line specs to locate part Text
partStr (afterequal); Text string
lineNo 0
); setq
); PART-line condition

;; [no none-of-the-above condition; do nothing with other lines]
); cond
); while [lines in file]
(command "zoom" "w" zoompt1 Zoompt2)
(command "mirror" "w" mirrpt1 mirrpt2 "" midpt3 midpt4 "y")
(command "layer" "s" "customer" "")
(setq ; to shift next results over
shift (+ shift shiftinc)
labeltxtins (polar labeltxtins 0 shiftinc)
mirrpt1 (polar mirrpt1 0 shiftinc)
mirrpt2 (polar mirrpt2 0 shiftinc)
midpt1 (polar midpt1 0 shiftinc)
midpt2 (polar midpt2 0 shiftinc)
midpt3 (polar midpt3 0 shiftinc)
midpt4 (polar midpt4 0 shiftinc)
zoomt1 (polar midpt1 0 shiftinc)
zoomt2 (polar midpt2 0 shiftinc)
); setq
); foreach

[Moshe-A · Accepted solution]

@Travis.Biddle ,

check this, express tools provide us (acet-ui-progress) function. search the web for help on it

enjoy

Moshe

(defun c:pgbar ()

; init meter, numoftxt can not be more than (expt 2 15) = 32767
 (if (and (setq lstFiles (vl-directory-files FOLDER "*.txt" 1))
          (< (setq numoftxt (vl-list-length lstFiles)) 32767)
     )
  (acet-ui-progress "Working: " 32767)
  (acet-ui-progress "Working: " numoftxt)
 )
  
; (foreach txtfile (vl-directory-files folder "*.txt" 1)
 (foreach txtfile lstFiles
  (command "zoom" "w" zoompt1 Zoompt2)
  (setq file (open (strcat folder txtfile) "r"))
  
  (while (setq txt (read-line file))
   (cond
    ((wcmatch (vl-string-trim "\t " txt) "'= FILENAME=*")
     (setq txt (afterequal) txt (afterequal)); bypass (2) = signs;
     (command "._layer" "_set" "Filename" "")
     (command "_.text" "_style" "FILE" "_r" "_none" labeltxtins 0 txt)
    ); filename-line condition
    ((wcmatch (vl-string-trim "\t " txt) "TOOL*");;Start of identifying TOOL number
     (setq ToolStr (afterequal)); Text string
    ); TOOL Number condition---Checks TOOL number in line and sets the # i.e. TOOLNAME=108 will return "108"
    ((wcmatch (vl-string-trim "\t " txt) "LINE*")
     (setq txt (afterequal) startX (atof (tocomma))
           txt (afterequal) startY (atof (tocomma))
           txt (afterequal) startZ (atof (tocomma))
           txt (afterequal) endX   (atof (tocomma))
           txt (afterequal) endy   (atof (tocomma))
           endZ (atof (afterequal))
     ); setq
     (command "._layer" "_set" toolstr "")
     (command "_.line" "_none" (setq lstart (list (+ startX shift) startY startZ))
		       "_none" (setq lend (list (+ endX shift) endY endZ)) "")
     (setq toolstr nil)
     (if part ; in a part box?
      (if (= lineNo 0); then [outer] -- drew first Line of part box
       (setq ; then [inner]
             p1 lstart
             p2 lend
             lineNo 1 ; triggers part Text after next Line
       ); setq
       (progn ; else [inner] -- second Line of part box
        (setq ; then
              p3 lstart
              p4 lend
        ); setq
        (command "_.text" "_style" "PART" "_none" "_mc"
                 (mapcar '/ (mapcar '+ (mapcar 'min p1 p2 p3 p4) (mapcar 'max p1 p2 p3 p4)) '(2 2))0 partStr); command
        (setq part nil); [other 2 part-box Lines ordinary]
       ); progn
      ); if [which Line just drawn]
     ); if [in part box]
    ); LINE condition
    ((wcmatch (vl-string-trim "\t " txt) "POINT*")
     (setq txt (afterequal) ptX (atof (tocomma))
           txt (afterequal) ptY (atof (tocomma))
           ptZ (atof (afterequal))
     ); setq
     (command "._layer" "_set" toolstr "");;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     (command "_.point" "_none" (list (+ ptX shift) ptY ptZ))
    ); POINT condition
    ((wcmatch (vl-string-trim "\t " txt) "ARC*")
     (setq txt (afterequal) startX (atof (tocomma))
           txt (afterequal) startY (atof (tocomma))
           txt (afterequal) ; bypass Z
           txt (afterequal) endX (atof (tocomma))
           txt (afterequal) endY (atof (tocomma))
           txt (afterequal) ; bypass Z
           txt (afterequal) ctrX (atof (tocomma))
           txt (afterequal) ctrY (atof (tocomma))
     ); setq
     (command "._layer" "_set" toolstr "");;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     (command "_.arc"
              "_none" (list (+ startX shift) startY)
              "_c" "_none" (list (+ ctrX shift) ctrY)
              "_none" (list (+ endX shift) endY)
     ); command
    ); ARC condition
    ((wcmatch (vl-string-trim "\t " txt) "PART*")
     (setq part T ; triggers use of next 2 Line specs to locate part Text
           partStr (afterequal); Text string
           lineNo 0)
    ); PART-line condition

;; [no none-of-the-above condition; do nothing with other lines]
   ); cond
  ); while [lines in file]
  
  (command "._zoom" "_w" zoompt1 Zoompt2)
  (command "._mirror" "_w" mirrpt1 mirrpt2 "" midpt3 midpt4 "_y")
  (command "._layer" "_set" "customer" "")
  (setq ; to shift next results over
       shift (+ shift shiftinc)
       labeltxtins (polar labeltxtins 0 shiftinc)
       mirrpt1 (polar mirrpt1 0 shiftinc)
       mirrpt2 (polar mirrpt2 0 shiftinc)
       midpt1 (polar midpt1 0 shiftinc)
       midpt2 (polar midpt2 0 shiftinc)
       midpt3 (polar midpt3 0 shiftinc)
       midpt4 (polar midpt4 0 shiftinc)
       zoomt1 (polar midpt1 0 shiftinc)
       zoomt2 (polar midpt2 0 shiftinc)
  ); setq
   
  ; update meter 
  (acet-ui-progress -1)
 ); foreach

 ; close meter
 (acet-ui-progress)
  
); c:pgbar

[Sea-Haven]

A couple of speed suggestions, I went from 30 mins to 10 mins, to 2 mins max for a task. Took like 5 versions.

If you look at your "(command" in the code when possible replace with entmake function or better is VL-add function, for setting layer  (setvar 'clayer layername) I found "Point" "Text" "Arc" "Zoom" "Line" all command functions.

Insert a 1000 blocks is like 4 seconds.

Using (vla-InsertBlock mspace (vlax-3d-point bpt) blockname 0.001 0.001 1.0 0.0)

I found acet-progress good but complicated, maybe just use (Princ (strcat "\n" filename)) so see something on the command line. It should just scroll if reduced use of Command

[Travis.Biddle]

Great tips, thank you so much.  I will work on this tomorrow and see how it goes. Thanks again!!

[Travis.Biddle]

I tried this code and nothing happens.  I am getting "ADS request error"

[Moshe-A]

@Travis.Biddle ,

the code is yours and you did not post the all stuff  😀  

your request this time was progress bar - no?!

here i isolate it and it works at least for me. 

"ADS request error" means something is wrong with (acet-ui-progress) function as said the max init value is 32767

make sure you do not have more than that number of files.

Moshe

(defun c:pgbar ()

 (acet-ui-progress "Working: " 32767)
  
 (repeat 32767

  ; update meter 
  (acet-ui-progress -1)
   
 ); foreach

 ; close meter
 (acet-ui-progress)
  
)