Zobrazit plnou verzi příspěvku: Výměra křivka s reaktorem a pak konečné sečtení

chlebovsky
27.06.2007, 10:58
Zdravím.
Nejprvé uvedu dialog který je zapotřebí pro obě funkce.
 
 
1) soubor
AD-programy-dialog.DCL někde v supportu
a obsahuje :
ROZVRZENI : dialog {  label = "Vyber kam vytvořit výpis";  : popup_list {key = "ROZ";width = 30;fixed_width = true; alignment = top;}  ok_cancel;}
 

2)soubor
Plocha.lsp kdekoliv, ale aby to fungovalo i při znovu otevření tak jej musíte uložit do APPLOAD do obsahu při spuštění
a obsahuje :
(defun c:vymera (/ krivka mtext_vla krv_vla acadApp acadDoc acadModel pl sp reactor dialog roz)  (function area-lwpolyline->text)  (setq dialog (load_dialog "AD-programy-dialog.DCL"))  (princ "\nVyber křivku tvořící hranici :")  (if (setq krivka (entsel))    (progn      (setq krivka (car krivka))      (if (je_krivka krivka) (progn   (uzavri_krivku krivka)   (setq pl (plocha_krivky krivka))          (setq krv_vla (vlax-ename->vla-object krivka))   ;;; mám vybranou křivku a spočítanou plochu
   ;;; teď vyberu rozvržení kam uložit text   (while (setq roz (vyber_rozvrzeni))     (command "_layout" "_s" roz)     (setq sp (getpoint "\nVyber umístění popisu :"))     (setq text (entmakex (list (cons 0 "TEXT")(cons 1 (rtos pl 2 2))(cons 10 (tuw sp))(cons 7 (getvar "TEXTSTYLE"))(cons 40 (getvar "TEXTSIZE"))(cons 50 0.0))))     (setq text_vla (vlax-ename->vla-object text))     (setq reactor (vlr-object-reactor (list krv_vla) text_vla '((:vlr-modified . area-lwpolyline->text))))     (vlr-pers reactor)     (redraw)   ) ) (alert "Vybraný objekt není křivka.")      )    )    (alert "Nebyl vybrán žádný objekt.")  ))(defun tuw (a)  (trans a 1 0))(defun vyber_rozvrzeni (/ vraci roz sez fce)  (setq roz (dictsearch (namedobjdict) "ACAD_LAYOUT"))  (setq sez nil)  (while (assoc 3 roz)(setq sez (append sez (list (cdr (assoc 3 roz)))) roz (cdr (member (assoc 3 roz) roz))))  (setq sez (acad_strlsort sez))  (new_dialog "ROZVRZENI" dialog)  (setq r_akt "0")  (dopln_popuplist "ROZ" sez)  (action_tile "ROZ" "(setq r_akt $value)")  (setq fce (start_dialog))  (if (= fce 1)(setq vraci (nth (atoi r_akt) sez))(setq vraci nil))  vraci)(defun dopln_popuplist (tl sez /)  (if sez    (progn      (start_list tl)      (mapcar 'add_list sez)      (end_list)    )  ))(defun je_krivka (ent /)  (if (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE") ent nil))(defun uzavri_krivku (ent /)  (setq ent (entget ent))  (if (= 0 (cdr (assoc 70 ent)))    (progn      (setq ent (subst (cons 70 1)(assoc 70 ent) ent))      (entmod ent)    )  ))(defun krivka_body (ent / i body)  (setq sez (entget ent))  (setq body nil)  (while (member (assoc 10 sez) sez)    (setq body (append body (list (cdr (car (member (assoc 10 sez) sez))))))    (setq sez (cdr (member (assoc 10 sez) sez)))  )  (setq body (append body (list (cdr (assoc 10 (entget ent))))))  body)(defun plocha_krivky (ent / body plocha i x1 x2 y1 y2)  (setq body (krivka_body krivka))  (setq i 0 plocha 0)  (repeat (1- (length body))    (setq x1 (car (nth i body))   y1 (cadr (nth i body))   x2 (car (nth (1+ i) body))   y2 (cadr (nth (1+ i) body)))    (setq plocha (+ plocha (* (- x2 x1)(+ y1 y2) 0.5)))    (setq i (1+ i))  )  (* (abs plocha) 0.000001))(defun area-lwpolyline->text (notifier reactor arg-list)  (update-mtext-for-area (vlr-data reactor) notifier))(defun update-mtext-for-area (vla_text vla_krivka /)  (if (and (vlax-vla-object->ename vla_krivka) (vlax-vla-object->ename vla_text))    (progn      (setq krivka (vlax-vla-object->ename vla_krivka))      (setq mtext (vlax-vla-object->ename vla_text))      (setq pl (plocha_krivky krivka))      (setq mtext (entget mtext))      (setq mtext (subst (cons 1 (rtos pl 2 2))(assoc 1 mtext) mtext))      (entmod mtext)      (redraw (cdr (assoc -1 mtext)) 1)    )  ))
Tak ten mi krásně funguje. Klidně zkopčete v případě zájmu.
Oč vlastně jde, nakreslete libovolnou křivku třeba obdelník 5000x5000mm.
Napište příkaz "VYMERA" vyberte křivku, určete do jakého rozvržení a klikněte umístění textu, vloží se spočítaná plocha křivky (pozor - zatím bez oblouků). Když změníte křivku tak se plocha přepočte. Celkem dobrý.
 
Ale když to spojím s druhým prográmkem SUMA, tak začne trošku zlobit.
3) soubor

Suma.lsp kdekoliv, ale aby to fungovalo i při znovu otevření tak jej musíte uložit do APPLOAD do obsahu při spuštění
a obsahuje :
(defun c:suma (/ ents dialog roz sou text text_vla i ttt_vla xdata)  (regapp "ARCHDESIGN-SUMA")  (function text-soucet->text)  (princ "\nVyber texty co požaduješ sečíst (musí být TEXT né MTEXT):")  (setq dialog (load_dialog "AD-programy-dialog.DCL"))  (setq ents (ssget '((0 . "TEXT"))))  (if ents    (progn      (setq sou (spocti_sumu ents))      (setq xdata (dej_indexy ents))      (while (setq roz (vyber_rozvrzeni)) (command "_layout" "_s" roz) (setq sp (getpoint "\nVyber umístění popisu :")) (setq text (entmakex (list (cons 0 "TEXT")(cons 1 (rtos sou 2 2))(cons 10 (tuw sp))(cons 7 (getvar "TEXTSTYLE"))(cons 40 (getvar "TEXTSIZE"))(cons 50 0.0)))) (setq text (append (entget text) (list xdata))) (setq text (entmod text)) (setq text (cdr (assoc -1 text))) (setq text_vla (vlax-ename->vla-object text)) (redraw) (setq i 0) (repeat (sslength ents)   (setq ttt_vla (ssname ents i))   (setq ttt_vla (vlax-ename->vla-object ttt_vla))   (setq reactor (vlr-object-reactor (list ttt_vla) text_vla '((:vlr-modified . text-soucet->text))))   (vlr-pers reactor)   (setq i (1+ i)) )      )    )    (alert "Nebyly vybrány žádné texty.")  ))(defun spocti_sumu (ents / i vraci)  (setq i 0 vraci 0)  (repeat (sslength ents)    (setq vraci (+ vraci (atof (cdr (assoc 1 (entget (ssname ents i)))))))    (setq i (1+ i))  )  vraci)(defun dej_indexy (ents / i vraci)  (setq i 0 vraci nil)  (repeat (sslength ents)    (setq vraci (append vraci (list (cons 1000 (cdr (assoc 5 (entget (ssname ents i))))))))    (setq i (1+ i))  )  (setq vraci (list -3 (append (list "ARCHDESIGN-SUMA") vraci)))  vraci)(defun tuw (a)  (trans a 1 0))(defun vyber_rozvrzeni (/ vraci roz sez fce)  (setq roz (dictsearch (namedobjdict) "ACAD_LAYOUT"))  (setq sez nil)  (while (assoc 3 roz)(setq sez (append sez (list (cdr (assoc 3 roz)))) roz (cdr (member (assoc 3 roz) roz))))  (setq sez (acad_strlsort sez))  (new_dialog "ROZVRZENI" dialog)  (setq r_akt "0")  (dopln_popuplist "ROZ" sez)  (action_tile "ROZ" "(setq r_akt $value)")  (setq fce (start_dialog))  (if (= fce 1)(setq vraci (nth (atoi r_akt) sez))(setq vraci nil))  vraci)(defun dopln_popuplist (tl sez /)  (if sez    (progn      (start_list tl)      (mapcar 'add_list sez)      (end_list)    )  ))(defun text-soucet->text (notifier reactor arg-list)  (update-text-for-suma (vlr-data reactor) notifier))(defun update-text-for-suma (vla_text vla_posl / text xdata i sou posl)  (if (vlax-vla-object->ename vla_text)    (progn      (setq posl (vlax-vla-object->ename vla_posl))      (setq text (vlax-vla-object->ename vla_text))      (setq text (entget text (list "ARCHDESIGN-SUMA")))      (if (setq xdata (assoc -3 text))        (progn          (setq xdata (cdadr xdata))          (setq i 0 sou 0)          (repeat (length xdata)     (if (handent (cdr (nth i xdata)))       (progn  (setq sou (+ sou (atof (cdr (assoc 1 (entget (handent (cdr (nth i xdata)))))))))       )     )     (setq i (1+ i))          )          (setq text (subst (cons 1 (rtos sou 2 2))(assoc 1 text) text))          (entmod text)        )      )    )  ))
Když nakreslím třeba 10 křivek, vypíšu jejich výměry, doplním třeba dalších x textů, tak pak je všecky pomoci přikazu "SUMA" sečtu.
A teď k problému :
 
Mám křivky, jejich výměry, ty dohromady sečtu.
A teď změním jednu křivku, tak co nastane. Všecko se přepočítá, tak jak má, ale samotný text výměry od křivky zmyzne.
Musím po ukončení regenerovat výkres.
Nevíte někdo jak z toho ven ?
 
Dík moc.
Martin.

Vladimír Michl
27.06.2007, 11:39
A proč tak složitě? Dynamickou tabulku s jednotlivými plochami či délkami entit i jejich součtem umí i holý AutoCAD - viz příkaz EXTRDATA.
 
Příklad takového výkresu je SumaPloch.dwg v Katalogu bloků. Příkaz umí i pokročilejší triky - viz např.:
http://www.cadforum.cz/cadforum/qaID.asp?tip=5548

chlebovsky
27.06.2007, 13:13
No nějak mi ta sumaploch.dwg nefunguje.... když změním křivku tak se nic nestane. A když nějaké číslo tak taky nic..... dělám asi něco špatně.... nebo to je třeba nějak aktualizovat tu tabulku ??? to je právě to co nechci, potřebuju aby to bylo velmi asociativní. A navíc potřebuju sčítat čísla různě po výkrese. A ten odkaz asi nepoužiju protože mám 2007 

Vladimír Michl
27.06.2007, 13:45
Tabulka je asociativní - AutoCAD zobrazí upozornění při aktualizaci dat - např. změně tvaru křivek (v závislosti na proměnné DXEVAL - implictně při vykreslování a publikování, ale jde nastavit "častěji" nebo automaticky). Čísla nemusejí být nutně v jedné tabulce - lze je použít i samostatně různě po výkrese nebo dokonce posčítat data z různých výkresů.
 
Je to ale pro AutoCAD 2008, ve verzi 2007 vám to asi fungovat nebude.  Pokud ale máte verzi 2007, máte pravděpodobně i subscription, takže povýšení na AutoCAD 2008 už nic nestojí.

chlebovsky
27.06.2007, 14:06
No já jsem jen malý projektantík ve veliké firmě, takže o 2008 nerozhoduju. :-(  Ale stejně i tak bych to potřeboval vyřešit, proč se mi ten text ztrácí, popř, jak to zregenerovat. Tak všeobecně i pro jiné prográmky.
A taky existuje nějaký reaktor nebo funkce, že po provedení všech úkonů se něco provede? Např. kopíruju, bod, bod, bod.... ukončím kopírování a pak něco provede ?

Vladimír Michl
27.06.2007, 14:19
Vhodných reaktorů je řada - viz Nápověda - třeba :vlr-commandEnded

chlebovsky
27.06.2007, 15:02
Tak toto vyřešilo naprosto všechny mé dotazy, dokonce pomohlo i najít jak v lispu vytvořit hladinu bez command.... snad to bude fakčit.
Když tak pak napíšu.
Dík moc.
Martin

chlebovsky
31.07.2007, 10:50
Tak jsem to nakonec rozchodil.
Kdo má zájem je to ke stažení na
www.vchlebovska.eu  ke stažen.
 
Možná je to zbytečně složité, ale funguje.

Robo
01.08.2007, 08:17
Je to fantasticke. Super, zasluzna praca