Diskuzní fórum a databáze tipů a utilit pro AutoCAD, Inventor, Revit a další produkty Autodesk - od firmy Arkance Systems [www.cadforum.cz]
CZ | SK | EN | DE
Přihlášení
či registrace
   právě nás čte: 4053 
Arkance Systems CZ
FB TW YT LN Blog
PORTÁLY PRODUKTŮ
AutoCAD AutoCAD a LT
Inventor Inventor
Revit Revit
Civil 3D Civil 3D
Fusion 360 Fusion 360
RSS kanál - CAD tipy RSS tipy
RSS diskuze

Diskuze Diskuzní fórum, poradna

 

NápovědaCAD diskuze, rady, výměna zkušeností

 
CAD Fórum - Homepage Veřejné diskuzní fórum k CAD aplikacím - ptejte se na libovolné otázky týkající se oboru CAx, podělte se o vaše znalosti a zkušenosti s programy AutoCAD, Inventor, Revit, Fusion 360, 3ds Max a s dalšími CAD aplikacemi. Zaregistrujte se nebo se přihlašte a zašlete váš příspěvek do odpovídajícího fóra. Viz další informace o CAD Fóru. Nechcete se registrovat? Zeptejte se v naší Facebook poradně.
Fórum nenahrazuje technický support firmy Arkance Systems (CAD Studio) - přímá podpora pro zákazníky funguje na helpdesk.cadstudio.cz
  FAQ FAQ  Prohledat fórum   Události   Registrovat Registrovat  Přihlásit Přihlásit

Téma uzavřenoVýměra křivka s reaktorem a pak konečné sečtení
 Odpovědět Odpovědět archiv
Autor
  Najít Téma Najít Téma  Možnosti tématu Možnosti tématu
chlebovsky Zobrazit panel
Zasloužilý člen
Zasloužilý člen
Avatar

Přihlášen: 18.čer.2007
Lokalita: ČR (JM)
Používám:
Autocad R9 - 2022
Stav: Offline
Bodů: 112
 Přímý odkaz na tuto zprávu Téma: Výměra křivka s reaktorem a pak konečné sečtení
    Zasláno: 27.čer.2007 v 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.
Zpět nahoru
Vladimír Michl Zobrazit panel
Moderátor
Moderátor
Avatar
Arkance Systems

Přihlášen: 09.zář.2004
Lokalita: ČR (JČ)
Používám:
Dodáváme produkty Autodesk
Stav: Offline
Bodů: 21493
 Přímý odkaz na tuto zprávu Zasláno: 27.čer.2007 v 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ř.:
Vladimír Michl (moderátor)
Arkance Systems s.r.o. - www.arkance-systems.cz
(podpora viz hd.cads.cz)
Zpět nahoru
chlebovsky Zobrazit panel
Zasloužilý člen
Zasloužilý člen
Avatar

Přihlášen: 18.čer.2007
Lokalita: ČR (JM)
Používám:
Autocad R9 - 2022
Stav: Offline
Bodů: 112
 Přímý odkaz na tuto zprávu Zasláno: 27.čer.2007 v 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 
Zpět nahoru
Vladimír Michl Zobrazit panel
Moderátor
Moderátor
Avatar
Arkance Systems

Přihlášen: 09.zář.2004
Lokalita: ČR (JČ)
Používám:
Dodáváme produkty Autodesk
Stav: Offline
Bodů: 21493
 Přímý odkaz na tuto zprávu Zasláno: 27.čer.2007 v 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í.
Vladimír Michl (moderátor)
Arkance Systems s.r.o. - www.arkance-systems.cz
(podpora viz hd.cads.cz)
Zpět nahoru
chlebovsky Zobrazit panel
Zasloužilý člen
Zasloužilý člen
Avatar

Přihlášen: 18.čer.2007
Lokalita: ČR (JM)
Používám:
Autocad R9 - 2022
Stav: Offline
Bodů: 112
 Přímý odkaz na tuto zprávu Zasláno: 27.čer.2007 v 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 ?
Zpět nahoru
Vladimír Michl Zobrazit panel
Moderátor
Moderátor
Avatar
Arkance Systems

Přihlášen: 09.zář.2004
Lokalita: ČR (JČ)
Používám:
Dodáváme produkty Autodesk
Stav: Offline
Bodů: 21493
 Přímý odkaz na tuto zprávu Zasláno: 27.čer.2007 v 14:19
Vhodných reaktorů je řada - viz Nápověda - třeba :vlr-commandEnded
Vladimír Michl (moderátor)
Arkance Systems s.r.o. - www.arkance-systems.cz
(podpora viz hd.cads.cz)
Zpět nahoru
chlebovsky Zobrazit panel
Zasloužilý člen
Zasloužilý člen
Avatar

Přihlášen: 18.čer.2007
Lokalita: ČR (JM)
Používám:
Autocad R9 - 2022
Stav: Offline
Bodů: 112
 Přímý odkaz na tuto zprávu Zasláno: 27.čer.2007 v 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
Zpět nahoru
chlebovsky Zobrazit panel
Zasloužilý člen
Zasloužilý člen
Avatar

Přihlášen: 18.čer.2007
Lokalita: ČR (JM)
Používám:
Autocad R9 - 2022
Stav: Offline
Bodů: 112
 Přímý odkaz na tuto zprávu Zasláno: 31.čvc.2007 v 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.
Zpět nahoru
Robo Zobrazit panel
Zasloužilý člen
Zasloužilý člen

Přihlášen: 02.led.2006
Stav: Offline
Bodů: 120
 Přímý odkaz na tuto zprávu Zasláno: 01.srp.2007 v 08:17
Je to fantasticke. Super, zasluzna praca Clap 
Zpět nahoru

Pro technickou podporu CAD
kontaktujte Helpdesk

Příbuzné CAD tipy:
Tip 4952:Výkaz výměr ploch v AutoCADu LT.
Tip 9211:Jak vybrat křivky kratší než X metrů nebo plochy menší než Y m2?
Tip 6149:VIPJak provést MKP/FEM výpočet celé sestavy Inventoru?
Tip 578:Jak posčítat délku vybraných úseček, křivek, oblouků, kružnic, elips a multičar ve výkresu?
Tip 577:Jak posčítat délku vybraných čar ve výkresu AutoCADu LT?
Tip 3718:Jak převést obecné křivky na parcely Land Desktopu?


 Odpovědět Odpovědět

Přejít na fórum Oprávnění fóra Zobrazit panel



Stránka byla vygenerována za 1,924 sekund.
CF
CAD Fórum - tipy, triky, podpora, pomoc a rady pro AutoCAD, LT, Inventor, Revit, Map, Civil 3D, 3ds Max, Fusion 360 a další Autodesk aplikace (support firmy Arkance Systems)
ARKANCE (CAD Studio) - Autodesk Platinum Partner & Training Center & Services Partner
KONTAKT:
webmaster.cz@arkance-systems.com
tel. +420 910 970 111
  Copyright ©2024 | Web reklama na tomto serveru | Ochrana soukromí, podmínky
FB TW YT LN Blog
TOPlist
img