CISTI_VN napsal(a):
(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:
|