Block counting lsp, please help with edit

[Oriann8]

Hello



Please I need help with my very very old lsp program.

It has been made with my colleague in around 1998-1999.

Now after a long time we need to edit it to add new block tags and make it count block we specify.

We have been working on it almost a week but we really dont have a clue how to edit program after that time.

I am asking for a help from some good programmer to help us solve this.



All help is appreciated.



Lisp file content:

(defun f1 ()
 (setq pocs 1)
 (pp)
 (if (/= aaa "") (f1a) (setq pocs 0)))
(defun f1a ()
 (setq pol (assoc aaa sez))
 (if (= pol nil) (f1a2) (f1a1)))
(defun f1a1 ()
 (setq cis (cdr pol))
 (setq cis (+ pocs cis))
 (setq pom (cons aaa cis))
 (setq sez (subst pom pol sez)))
(defun f1a2 ()
 (setq sez (cons (cons aaa pocs) sez))
 (setq nav nil))

(defun f2 ()
 (setq poc (length sez))
 (if (> poc 0) (fl))
 (while (> poc 0)
  (setq prv (nth (- poc 1) sez))
  (setq zna (car prv))
  (setq ccc (cdr prv))
  (setq spc (- 16 (strlen zna)))
  (setq zna (strcat zna (substr "                " 1 spc) (itoa ccc)))
  (write-line zna s2)
  (write-line zna)
  (setq poc (- poc 1))))

(defun f3 ()
 (setq pocs 0)
 (pp)
 (if (/= aaa "") (f3a)))

(defun f3a ()
 (setq pocs 1 pozn (strlen aaa))
 (if (= pozn 1) (f1a) (f3b)))

(defun f3b ()
 (setq pzn (substr aaa 1 1))
 (if (and (>= pzn "0") (<= pzn "9")) (f4a) (f6))
 (f1a))

(defun f4a ()
 (fc)
 (setq pzn (substr aaa 1 1))
 (if (>= pzn "A") (setq pocs ccc) (f5)))

(defun f5 ()
 (setq aaa (substr aaa 2) pzn (substr aaa 1 1))
 (if (>= pzn "A") (setq aaa pzn) (f6)))

(defun f6 ()
 (fd)
 (setq pzn (substr aaa 1 1))
 (if (and (>= pzn "0") (<= pzn "9")) (f7) (setq aaa pzn)))

(defun f7 ()
 (fc)
 (setq aaa (substr aaa 1 1) pocs ccc))

(defun fd ()
 (setq pzn "x")
 (while (and (/= pzn "(") (> pzn ""))
  (setq pzn (substr aaa 1 1))
  (setq aaa (substr aaa 2))))

(defun fc ()
 (setq zn "0" bbb "")
 (while (and (>= zn "0") (<= zn "9"))
  (setq bbb (strcat bbb (substr aaa 1 1)))
  (setq aaa (substr aaa 2))
  (setq zn (substr aaa 1 1)))
 (setq ccc (atoi bbb)))

(defun fl ()
 (write-line nadpis)
 (write-line nadpis s2))

(defun fp ()
 (setq inp (open vyso "r"))
 (setq out (open "lpt1" "w"))
 (setq q (read-line inp))
 (while (/= q nil)
  (write-line q out)
  (setq q (read-line inp)))
 (write-line " " out)
 (close inp)
 (close out))

(defun pp ()
 (setq n 0 zn nil)
 (while (/= zn " ")
  (setq n (+ 1 n))
  (setq zn (substr aaa n 1)))
 (setq pzn (- n 1))
 (setq aaa (substr aaa 1 pzn)))

(defun f8 ()
 (setq nadpis "*****   Svitidla dle symbolu  *****")
 (setq sez sez6)
 (f2))


(defun c:vypis ()
 (textscr)
 (command "attext" "s" "c:/blok/vypis/material" "c:/blok/vypis/pracovni")
 (setq pre (getvar "dwgprefix") nam (getvar "dwgname"))
 (setq n (strlen nam) nn 0)
 (while (> n 1)
  (setq zn (substr nam n 1))
  (if (= zn "\\") (setq nn n n 2))
  (setq n (- n 1)))
 (setq nam (substr nam (+ nn 1)))
 (setq zxc (strcat pre nam ".PRN"))
 (princ (strcat "\nJmeno vysledneho souboru <" zxc ">\n"))
 (setq vyso (getstring))
 (if (= vyso "") (setq vyso zxc)) 
 (write-line " ")
 (setq sez1 () sez2 () sez3 () sez4 () sez5 () sez9 () sez6 () c3 0 c6 0)
 (setq sou (open "c:/blok/vypis/pracovni.txt" "r"))
 (setq rad (read-line sou))
 (while (/= rad nil)
  (setq sez sez1)
  (setq aaa (substr rad 1 15))
  (f1)
  (setq sez1 sez sez sez2)
  (setq aaa (substr rad 16 15))
  (f1)
  (setq sez2 sez sez sez3)
  (setq aaa (substr rad 31 15))
  (f3)
  (setq c3 (+ c3 pocs))
  (setq sez3 sez sez sez4)
  (setq aaa (substr rad 46 15))
  (f1)
  (setq sez4 sez sez sez5)
  (setq aaa (substr rad 61 15))
  (f1)
  (setq sez9 sez sez sez9)
  (setq aaa (substr rad 76 15))
  (f1)
  (setq sez5 sez sez sez6)
  (setq aaa (substr rad 91 15))
  (f1)
  (setq c6 (+ c6 pocs))
  (setq sez6 sez)
  (setq rad (read-line sou)))
 (close sou)
 (setq s2 (open vyso "w"))
 (setq nadpis (strcat "    Vykres: " nam)) (fl)
 (setq nadpis "--------------Zasuvky-------------")
 (setq sez sez1)
 (f2)
 (setq nadpis "--------------Spinace-------------")
 (setq sez sez2)
 (f2)
 (setq nadpis "--------Svitidla dle popisu-------")
 (setq sez sez3)
 (f2)
 (setq nadpis "--------------Ostatni-------------")
 (setq sez sez4)
 (f2)
 (setq nadpis "--------------Ostatni-------------")
 (setq sez sez9)
 (f2)
 (setq nadpis "----------Ulozeni vedeni----------")
 (setq sez sez5)
 (f2)
 (if (/= c3 c6) (f8))
 (setq nadpis "----------------------------------") (fl)
 (close s2)
 (write-line "Vytisknout na tiskarne? (A/N)")
 (setq ano (grread))
 (if (or (equal ano '(2 65)) (equal ano '(2 97))) (fp))
 (read (chr (car (cdr ano)))))

Then lisp have two templates

All files in attachment