Lisp loop not working as thought

Hi guys, I have the following lisp I am trying to complete. My problem starts on line 68 or so. What this basically does is inserts
attribute defined blocks in a stack or line as directed by the user. Then requests the type for the highest number down to the lowest number (decrements). The loop is not subtracting the first time thru and then fails to loop the last time. Can someone help me out please? NOTE: un-numbered lines are wraps from the line above.
bang.lsp

1- (defun C:banc ( / ANCR BLKDIST BLKDST BLKPNT BPATH BUBBS HLEV HRV INLAYER ORTH P1 P1X P1Y P2 P2X P2Y SNAPIT TEXTSTR XDIR YDIR) 2- 3- ;;This is the block and path 4- (setq BPATH "J:\/ADT Develop\/User Content\/richard\/blocks\/anc_hex") 5- ;;This is the block data X width Y width X/2 width 6- (setq BLKDIST (list (/ 5.00000 16) (/ 9.00000 32) (/ 5.00000 32))) 7- 8- ;;Get the users settings 9- (setq INLAYER (getvar "clayer")) 10- (setq ORTH (getvar "orthomode")) 11- (setq SNAPIT (getvar "osmode")) 12- 13- ;;Re-set settings to what I need 14- (setvar "orthomode" 0) 15- (setvar "osmode" 1) 16- (command "layer" "m" "Obj-01-Hevy" "c" "1" "" "lw" "0.50" "" "ps" "Heavy" "" "") 17- (command "layer" "m" "S-Symb" "c" "4" "" "lw" "0.35" "" "ps" "Medium" "" "") 18- (command "layer" "m" "S-Anno" "c" "4" "" "lw" "0.35" "" "ps" "Medium" "" "") 19- (command "layer" "m" "S-Text" "c" "4" "" "lw" "0.35" "" "ps" "Medium" "" "") 20- (setvar "clayer" "S-Text") 21- 22- (setq P1 (osnap (getpoint "\nSelect end of bracing wall to anchor. ") "end")) 23- (setq P1X (nth 0 P1)) 24- (setq P1Y (nth 1 P1)) 25- (setq P1 (list P1X P1Y)) 26- (setvar "osmode" 0) 27- (setq P2 (getpoint P1 "\nIndicate direction of leader. ")) 28- (setq P2X (nth 0 P2)) 29- (setq P2Y (nth 1 P2)) 30- (setq P2 (list P2X P2Y)) 31- (initget 7 "Horizontal Vertical") 32- (setq HRV (getkword "\nIndicate either a Horizontal or Vertical bubble stack. ")) 33- (setq BUBBS (getint "\nEnter number of anchor bubbles place. ")) 34- (setq HLEV (getint "\nEnter the highest level anchor to place. ")) 35- 36- (setq XDIR (- P2X P1X)) 37- (setq YDIR (- P2Y P1Y)) 38- 39- (if (and (< 0 XDIR) (< 0 YDIR))(progn 40-     (command "pline" P1 "w" "0" "0" "@.2,.2" "@.1<<0" "") 41-     (setq BLKPNT (list (+ (nth 0 P1) 0.3 (nth 2 BLKDIST)) (+ (nth 1 P1) 0.2))) 42-     (if (equal HRV "Horizontal")(progn 43-         (setq BLKPNT (list (+ (nth 0 BLKPNT) (* (1- BUBBS) (nth 0 BLKDIST))) (nth 1 BLKPNT))) 44-     )) 45- )) 46- (if (and (< 0 XDIR) (> 0 YDIR)) ( progn ;; Quad 2 47-     (command "pline" P1 "w" "0" "0" "@.2,-0.2" "@.1<<0" "") 48-     (setq BLKPNT (list (+ (nth 0 P1) 0.3 (nth 2 BLKDIST)) (- (nth 1 P1) 0.2) )) 49-     (prompt "\nIn loop 2.\n") 50-     (if (= HRV "Horizontal")(progn 51-         (setq BLKPNT (list (+ (nth 0 BLKPNT) (* (1- BUBBS) (nth 0 BLKDIST))) (nth 1 BLKPNT))) 52-     )) 53- )) 54- (if (and (> 0 XDIR) (> 0 YDIR)) (progn ;; Quad 3 55-     (command "pline" P1 "w" "0" "0" "@-0.2,-0.2" "@-0.1<<0" "") 56-     (setq BLKPNT (list (- (nth 0 P1) 0.3 (nth 2 BLKDIST)) (- (nth 1 P1) 0.2) )) 57- )) 58- (if (and (> 0 XDIR) (< 0 YDIR)) (progn ;; Quad 4 59-     (command "pline" P1 "w" "0" "0" "@-0.2,.2" "@-0.1<<0" "") 60-     (setq BLKPNT (list (- (nth 0 P1) 0.3 (nth 2 BLKDIST)) (+ (nth 1 P1) 0.2) )) 61- )) 62- 63- (if (= HRV "Horizontal") 64- (setq BLKDST (list (- (nth 0 BLKDIST)) 0))) 65- (if (= HRV "Vertical") 66- (setq BLKDST (list 0 (- (nth 1 BLKDIST)) ))) 67- 68- (setq TEXTSTR (strcat "\nEnter anchor type for level " (rtos HLEV 2 0) ". ")) 69- (setq ANCR (getstring TEXTSTR)) 70- (command "insert" BPATH BLKPNT "1" "1" "0" ANCR HLEV) 71- 72- (setq HLEV (- HLEV 1)) 73- (setq BUBBS (1- BUBBS)) 74- 75- ;;Start loop for remaining anchors 76- (while (< 1 BUBBS)( 77-     (setq HLEV (- HLEV 1)) 78-     (prompt (strcat "\n" (rtos HLEV 2 0))) 79-     (setq BLKPNT (list (+ (nth 0 BLKPNT) (nth 0 BLKDST)) (+ (nth 1 BLKPNT) (nth 1 BLKDST)))) 80-     (setq TEXTSTR (strcat "\nEnter anchor type for level " (rtos HLEV 2 0) ". ")) 81-     (setq ANCR (getstring TEXTSTR)) 82-     (command "insert" BPATH BLKPNT "1" "1" "0" ANCR HLEV) 83-     (setq BUBBS (1- BUBBS)) 84- )) 85- ;(princ) 86- )
Add pictures here
<% if( /^image/.test(type) ){ %>
<% } %>
<%-name%>
Add image file
Upload

Polytechforum.com is a website by engineers for engineers. It is not affiliated with any of manufacturers or vendors discussed here. All logos and trade names are the property of their respective owners.