(defun c:cisti_vn ( / sezn_soub sez_togg sez_eb p_s CR I adr_es co_cistit KONEC
   vychozi_adresar)

 

****************************
(setq vychozi_adresar "c:/" )
****************************

 

(defun scri_pt ( / Pis_demo I )

 

(setvar "FILEDIA" 0)

 

(setq p_atr (cdr (nth 0 sez_eb)))
(setq Pis_demo (open (strcat adr_es "cisti_vn.scr") "w")) 

 

(write-line (strcat "_purge " co_cistit " * _n" ) Pis_demo)
(write-line "_qsave" Pis_demo)

 

(setq I 1)
(repeat (- (length sezn_soub) 1)

 

    (if (= (cdr (nth I sez_togg)) "1") 
  (progn
  (write-line (strcat "_open \"" adr_es (car (nth I sez_eb)) "\"") Pis_demo)
  (write-line (strcat "_purge " co_cistit " * _n" ) Pis_demo)
  (write-line "_qsave" Pis_demo)
       (if (> (atoi(substr(getvar "ACADVER") 2 1)) 4)
      (write-line "_close" Pis_demo)
         )
        )
 
      )
 (setq I (+ 1 I))
)

 

(write-line "_new " Pis_demo)
(write-line "FILEDIA 1 " Pis_demo)
(write-line "" Pis_demo)

 

(close Pis_demo)

 

(command "_script" (strcat adr_es "cisti_vn.scr"))

 

);defun

 

*************************************************

 

(defun zap_a_n ( j_n czr c_j_r / t_t)

 

(setq t_t (strcat "JM_SOUB" c_j_r))

 

(if (= j_n "1")(mode_tile t_t 0)(mode_tile t_t 1))

 

(setq sez_togg (subst (cons czr j_n) (assoc czr sez_togg) sez_togg))

 

);defun
*********************

 

 

 

************************
(defun MEM_radky ( / )

 

(action_tile "T1" "(zap_a_n $value CR \"1\")")

 

(action_tile "T2" "(zap_a_n $value (+ 1 CR) \"2\")")

 

(action_tile "T3" "(zap_a_n $value (+ 2 CR) \"3\")")

 

(action_tile "T4" "(zap_a_n $value (+ 3 CR) \"4\")")

 

(action_tile "T5" "(zap_a_n $value (+ 4 CR) \"5\")")

 

(action_tile "T6" "(zap_a_n $value (+ 5 CR) \"6\")")

 

(action_tile "T7" "(zap_a_n $value (+ 6 CR) \"7\")")

 

(action_tile "T8" "(zap_a_n $value (+ 7 CR) \"8\")")

 

(action_tile "T9" "(zap_a_n $value (+ 8 CR) \"9\")")

 

(action_tile "T10" "(zap_a_n $value (+ 9 CR) \"10\")")

 

(action_tile "T11" "(zap_a_n $value (+ 10 CR) \"11\")")

 

(action_tile "T12" "(zap_a_n $value (+ 11 CR) \"12\")")

 

(action_tile "T13" "(zap_a_n $value (+ 12 CR) \"13\")")

 

(action_tile "T14" "(zap_a_n $value (+ 13 CR) \"14\")")

 

(action_tile "T15" "(zap_a_n $value (+ 14 CR) \"15\")")

 

);defun
******************************
(defun zobraz_jm_s ( cislo / c_r t_p jed_rad sl_1 t_ps)

 

(if (= cislo 1)(mode_tile "T1" 1)(mode_tile "T1" 0))
(setq c_r 1)

 

(repeat 15
  
 (setq t_ps (strcat "JM_SOUB" (itoa c_r)) )
 (setq jed_rad (nth (- cislo 1) sezn_soub))

 

      (if jed_rad (setq sl_1 jed_rad)(progn
     (setq sl_1 "")
     (mode_tile (strcat "T" (itoa c_r)) 1)
      ))    
        
      (set_tile t_ps sl_1)

 

 (setq t_p (strcat "T" (itoa c_r)) )
 (setq jed_rad (cdr(assoc cislo sez_togg)))

 

      (if jed_rad (setq sl_1 jed_rad)(setq sl_1 "1"))
      (set_tile t_p sl_1)

 

      (if (= sl_1 "0")(mode_tile t_ps 1)(mode_tile t_ps 0))

 

 (setq c_r (+ 1 c_r) cislo (+ 1 cislo))
)

 

);defun

 

************************************
(defun pri_ube_15 ( ktere_t /)

 

(if (< CR 0)(progn
  (setq CR 1)
  (if (= ktere_t 1)(mode_tile "but_1" 1))
  (mode_tile "but_2" 0)
))

 

(if (>= CR (- p_s 14))(progn
   (setq CR (- p_s 14))
   (if (= ktere_t 2)(mode_tile "but_2" 1))
          (mode_tile "but_1" 0)
))

 

(if (and (> CR 1)(< CR (- p_s 14)))(progn
     (mode_tile "but_1" 0)
     (mode_tile "but_2" 0)
))

 

(if (= CR 1)(mode_tile "but_1" 1))

 

(zobraz_jm_s CR)
);;;defun

 

************************************

 

(defun dia_opr_atr ( / Kam_d cdcl)

 

********** CESTA **************************
(setq cdcl (load_dialog "cisti_vn.dcl")) 
(if (not (new_dialog "cisti_vn" cdcl)) (exit)
 )

 

(set_tile "CE_STA" adr_es)
(set_tile "rb_all" "1")
(setq co_cistit "_a")
(mode_tile "but_1" 1)
(mode_tile "T1" 1)
(if (< p_s 16)(mode_tile "but_2" 1))

 

;;;;;;;;
(MEM_radky)
(zobraz_jm_s CR)
;;;;;;;;

 

(action_tile "rb_all" "(setq co_cistit \"_a\")")
(action_tile "rb_block" "(setq co_cistit \"_b\")")
(action_tile "rb_layer" "(setq co_cistit \"_la\")")
(action_tile "but_1" "(setq CR (- CR 15) Kam_d 1)(pri_ube_15  Kam_d)")
(action_tile "but_2" "(setq CR (+ 15 CR) Kam_d 2)(pri_ube_15  Kam_d)")

 

(action_tile "accept" "(done_dialog)(setq KONEC T)")
(action_tile "cancel" "(done_dialog)(setq KONEC nil)")

 

(start_dialog)
(unload_dialog cdcl)

 

);defun
********************************************************
(defun nacti_jmena ( / Cti Radek)
(setq Nazev (getfiled "Vyberte soubor jmena.txt" vychozi_adresar "txt" 8))

 

(if (< (strlen Nazev) 10)(setq Nazev (strcat (getvar "DWGPREFIX") Nazev)))

 

(setq Cti (open Nazev "r") sezn_soub nil adr_es (substr Nazev 1 (- (strlen Nazev) 9) ) )

 

(while
        (setq Radek (read-line Cti))     
 (setq sezn_soub (cons Radek sezn_soub))
)
(close Cti)
(setq sezn_soub (reverse sezn_soub))

 

);defun

 

*****************************************************************

 

 (setq adr_es (getvar "DWGPREFIX"))

 

 (if (> (atoi(substr(getvar "ACADVER") 2 1)) 4)
  (setq sezn_soub (vl-directory-files adr_es "*.dwg"))
  (nacti_jmena)
 )

 

 *!!!!!!!!!!
 (setq sezn_soub (acad_strlsort sezn_soub))
 *!!!!!!!!!!

 

 (setq p_s (length sezn_soub)
  CR 1 I 1 sez_togg nil sez_eb nil
 )

 

 (repeat p_s
  (setq sez_eb (cons (cons (nth (- I 1) sezn_soub) "") sez_eb))
  (setq sez_togg (cons (cons I "1") sez_togg) I (+ 1 I))
 )
 (setq sez_togg (reverse sez_togg) sez_eb (reverse sez_eb))

 

 (dia_opr_atr)

 

(if KONEC
 (scri_pt)
)

 

(princ)

 

);defun c:

Co se týká spouštění skriptů - záleží, jak to uživatelům připravíte. U nás mají tlačítko, kterým spustí generátor, ze seznamu vyberou uloženou akci (třeba "Vytisknout ve formátu A3 na Xerox") a pak dají spustit vytvořený skript příkazem Demo.