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.
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.