Zobrazit plnou verzi příspěvku: Čištění výkresů dle adresáře

PepaR
17.07.2007, 12:46
Dobrý den,potřeboval bych zase pomoc od zkušenějších kolegů programátorů. Často čistím výkresy v zakázke, které se nachází v jednom adresáři. A nechce se mi jeotvírat a plikovat na ně makro. Navíc potřebuji vymazat z razítek, které s enachází v rozvržení nebo modelu bloky podpisů.
 
Nemá prosím někdo LISPík, který by po uměl vyčistit všechny výkresy a vymazat v nih jen určité jména bloků (které jsou samozřejmě dány) a to ve všech výkresech ve vybraném adresáři aniž by bylo nutné otevírat soubroy jednotlivě?
Další problém co se týče těch podpisů je ten, že seznam názvů bloků obsahuje cca 30 jmen a ne všechny jsou v každém výkrese obsaženy, takže by bylo potřeba aby se funkce nepřerušila, když ve výkrese některý z bloků nenalezne.
 
Trošku podobnou funkci má strojařská nadstavba proBlbec, jejíž ukázku přikládám, jen neumí vybrat ten adresář a neumí vymazat ty podpisy. Nicméně ten dialog bych si představoval nějak podobně, tzn aby bylo možné zvolit co všechno se bude čistit.
 
uploads/20070717_123711_pb_cisti.zip
 
Pokud by se našel někdo ochotný to vytvořit nebo poskytnout, byl bych moc rád a myslím, že by se něco podobného hodilo i ostatním.
 
Moc díky

Seiner
17.07.2007, 12:56
Podle mne to jde jen generováním scriptu (demo-souboru).
Jedním očkem jsem se podíval do toho lispu a mám pocit, že si taky vytváří script soubor.
Takže být vámi, bych se soustředil na odladění sekvence příkazů a/nebo lispu, který udělá požadované na jednom výkrese a pak použil generátor scriptu - o tom už se tady psalo několikrát.

PepaR
17.07.2007, 13:16
No jo, ale pokud to udělám jako demo soubro, tak řeším problém přerušení skriptu právě při těch různých podpisech (viz popis výše). O generátoru skriptu vím a znám jej, ale rpoblém je, že to čištění nebudu provádět já,a le druzí a Ti jsou rádi, že otevřou soubor o nějakých pokročilejších souborových operacích nebo skriptech nemůže být ani řeč :) PepaR2007-07-17 13:16:56

Seiner
17.07.2007, 13:38
Já jsem jen chtěl upozornit, že lisp neumí pracovat s více soubory. Takže nic jiného, než vytvořit demo soubor a spustit ho vám nezbyde. Máte možnost to dělat jako v tom lispu, co jste poslal, ale já bych se spíš snažil o univerzálnější řešení. Vytvořit "něco", co vám to udělá na jednom výkrese a pak spouštět pro vybrané výkresy.
  Problém existence mazaných entit musíte IMHO vyřešit tak jako tak.
  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.

PepaR
17.07.2007, 13:47
Ok, takže asi máte pravdu, úpřes skript by to bylo nejlepší. Ale jak vyřešit tu možnou existenci vs absenci v návaznosti na nepřerušení.
 
PS: Nemohle bych Vás poprosit o poskytnutí alespoň části toho o čem se zmiňujete v předchozím příspěvku pro případnou inspiraci?
[QUOTE=Seiner]
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.

[/QUOTE]

Seiner
17.07.2007, 13:58
Úplně jsem nepochopil záměr. Potřebujete bloky mazat a/nebo čistit?
popisovaný generátor je na www.chrudim.cz/seiner.
řádka menu pro jeho spouštění vypadá u nás:
ID_davka         [&Dávkové zpracování]^C^C(startapp "//SBS-TRANSYS/cad/support/Davka2002.exe"  "//SBS-TRANSYS/cad/support/prikazy2.txt")

PepaR
17.07.2007, 14:03
Šikovný generátorek, jen co je pravda, děkuji za odkaz. Já prvně myslle, že máte na mysli program Autodesku ScriptPro - o tomhle jsem neměl páru.
 
Myslíte, že bych mohl být tak moc otravný a požádat Vás ještě o ikonku k té funkci?
 
A další dotaz, funguje Davka2002.exe spolehlivě i když ji na druhé PC jen nakopíruju a neprovedu instalaci? 
 
Ještě jednou díky

Vladimír Michl
17.07.2007, 14:13
Ano, i makro ve ScriptPro se dá spustit "jedním čudlíkem".
 
Chcete-li volitelně mazat určitý blok ve výkresu, dejte do skriptu něco jako:
[CODE]
(if (setq ss (ssget "_X" '((0 . "INSERT")(2 . "MUJBLOK"))))(command"_ERASE" ss ""))
[/CODE]

PepaR
18.07.2007, 08:11
Tuším, že bych to měl přidat na ten řádek co je tučně, ale přesto bych požádal o radu.
[QUOTE=CISTI_VN]
(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:
[/QUOTE] PepaR2007-07-18 08:12:34

Ferdinand
25.07.2007, 15:19
Viz můj starý příspěvek v tématu
http://www.cadforum.cz/forum/forum_posts.asp?TID=4145&KW=defun+S%3A%3ASTARTUP