Popis místnosti
Vytištěno z: CAD Fórum
Kategorie: Autodesk - stavebnictví, strojírenství, CAD/GIS
Název fóra: CAD programování
Popis fóra: Otázky programování - nadstavby a utility pro CAD a GIS aplikace Autodesk (VBA, AutoLISP, ARX/C++, .Net, JavaScript, Python, MEL...)
URL: https://www.cadforum.cz/forum/forum_posts.asp?TID=2194
Datum vytištění: 13.kvě.2026 v 08:53
Téma: Popis místnosti
Odeslal: PepaR
Předmět: Popis místnosti
Datum odeslání: 21.úno.2006 v 20:10
|
Dobrý den, jsem začátečník v LISPu a potřeboval bych pomoci. Potřebuji vložit blok c_mistnosti, kdy se mi před vložením zeptá AutoCAD na křivku, já ji vyberu, nastaví se proměnné obvod, plocha a posléze aby jsem byl vyzván na název místnosti a blok se vložil s tímto názvem a do atributů se zapsal příslušný obvod a plocha zjištěná z vybrané křivky, ve formátu převedeném na m2? Vím, že toho chci hodně, ale nejedná se o žádnou domácí úlohu, snažím se jen ulehčit práci sobě a jiným :)
V příloze přikládám to co jsme zatím vytvořil... děkuji moc za návrhy a případnou pomoc.
http://www.cadforum.cz/forum/uploads/PepaR/2006-02-21_201029_Mistnost.zip - 2006-02-21_201029_Mistnost.zip
-------------
PepaR
https://www.jremes.cz" rel="nofollow - jremes.cz | https://www.stavlab.cz" rel="nofollow - stavlab.cz
|
Odpovědi:
Odeslal: pavelstyl
Datum odeslání: 22.úno.2006 v 09:53
|
Co třeba takhle, není to sice úplně podle mých představ, ale snad to pomůže.
Jo a dejte si pozor na lokální/globální proměnné.
;=========================================================== ==============
; Mistnost.lsp Popis místnosti
; (c) Copyright 2006 PepaR
; from: www.? ? ?.com
;----------------------------------------------------------- --------------
; Description:
;
; Zjistí plochu a obvod místnosti a zapíše jej jako atributy do bloku
;
; Command options:
; "MISTNOST" Výšková kóta
; "VKO" Oprava hodnoty výškové kóty
;=========================================================== =================
(defun prid_poly ()
(command "_area" "_e" en)
(setq celk_obvod (+ celk_obvod (getvar "perimeter")))
(setq celk_plocha (+ celk_plocha (getvar "area")))
(ssdel en ss)
)
(defun mistnost_zjisti (/ celk_obvod celk_plocha)
(setq celk_obvod 0.0)
(setq celk_plocha 0.0)
(prompt "\nVyberte køivku(y) místnosti: ")
(setq ss (ssget))
(while (> (sslength ss) 0)
(setq en (ssname ss 0))
(setq ed (entget en))
(setq e_type (cdr (assoc '0 ed)))
(cond
((= e_type "POLYLINE") (prid_poly))
((= e_type "LWPOLYLINE") (prid_poly))
((or
(/= e_type "POLYLINE")
(/= e_type "LWPOLYLINE")
)
(ssdel en ss)
)
)
)
(setq plocha (rtos (/ celk_plocha (* 1000.0 1000.0)) 2 2)) ;;; Prevod na mm^2 -> m^2
(setq obvod (rtos (/ celk_obvod 1000.0) 2 2)) &nb sp; ;;; Prevod na mm -> m
)
(defun mistnost_zapis (entl naz / e eg)
(setq e (entnext entl))
(while e
(setq eg (entget e))
(if (= (cdr (assoc 0 eg)) "ATTRIB")
(progn
(if (= (cdr (assoc 2 eg)) "PLOCHA")
(progn
(setq eg (subst (cons 1 plocha) (assoc 1 eg) eg))
(entmod eg)
)
)
(if (= (cdr (assoc 2 eg)) "OBVOD")
(progn
(setq eg (subst (cons 1 obvod) (assoc 1 eg) eg))
(entmod eg)
)
)
(if (= (cdr (assoc 2 eg)) "NAZEV")
(progn
(setq eg (subst (cons 1 naz) (assoc 1 eg) eg))
(entmod eg)
)
)
)
)
(setq e (entnext e))
)
(princ)
)
;;; Pozor, entlast za urcitych okolnosti nevraci posledni entitu (je-li jako posledni entita napr. blok s atributy nebo polyline)
(defun entlast1 (/ e en)
(setq en (entlast))
(while en
(setq e en)
(setq en (entnext en))
)
e
)
(defun C:MISTNOST (/ entl entl1 attrq naz)
(setq attrq (getvar "ATTREQ"))
(setvar "ATTREQ" 0)
(setq entl1 (entlast1))
(setq entl (entlast))
(mistnost_zjisti)
(setq naz (getstring "\nNazev mistnosti: "))
(prompt "\nUrèete bod vložení oznaèení místnosti :")
(command "_-INSERT" "c_mistnosti" pause (getvar "dimscale")(getvar "dimscale") pause)
(mistnost_zapis entl1 naz)
(entupd entl)
(setvar "ATTREQ" attrq)
(command "_DDATTE" entl)
(princ)
)
|
|
Odeslal: PepaR
Datum odeslání: 22.úno.2006 v 13:18
|
Dobrý den, lisp mi po vykonání vždy vyvolá editaci atributu, místo toho aby se ukncil, co s tím? Potřeboval bych jěště vyřešit nahrazení . za ,
Šlo by to třeba přes vl-string-subst "," "." ale nevím jak to tam přesně zakomponovat....
Moc děkuji za pomoc
-------------
PepaR
https://www.jremes.cz" rel="nofollow - jremes.cz | https://www.stavlab.cz" rel="nofollow - stavlab.cz
|
Odeslal: Mantlík
Datum odeslání: 22.úno.2006 v 14:10
|
možná to není ideální, já jsem to řešil takhle:
(setq promenna1 (vl-string-subst "," "." promenna2)) ; změna tečky výšky na čárku
-------------
J. Mantlík
|
Odeslal: pavelstyl
Datum odeslání: 22.úno.2006 v 15:30
|
Opravte si tento kousek kódu (výměna "." za ",")
(setq plocha (vl-string-subst "," "." (rtos (/ celk_plocha (* 1000.0 1000.0)) 2 2))) ;;; Prevod na mm^2 -> m^2
(setq obvod (vl-string-subst "," "." (rtos (/ celk_obvod 1000.0) 2 2))) ;;; Prevod na mm -> m
|
Smažte na konci řádek (zrušení dialogu pro editacic atributů)
Pavel Štyl
|
Odeslal: PepaR
Datum odeslání: 22.úno.2006 v 18:05
|
Funguje to baječně, avšak pokud chci přikaz opakovat, tak to vymaže předchozí blok a začíná to odznova...
Přikládám poslední verzi:
http://www.cadforum.cz/forum/uploads/PepaR/2006-02-22_180540_Mistnost5.lsp - 2006-02-22_180540_Mistnost5.lsp
-------------
PepaR
https://www.jremes.cz" rel="nofollow - jremes.cz | https://www.stavlab.cz" rel="nofollow - stavlab.cz
|
Odeslal: pavelstyl
Datum odeslání: 23.úno.2006 v 08:44
|
Já jsem původně chtěl co nejvíce zachovat vašeho kódu a řešil jsem jenom to naplnění atributů hodnotami. Teď jsem to musel trošku přepsat (snad to bude pochopitelné).
Pavel Štyl
;=========================================================== ==============
; Mistnost.lsp Popis místnosti
; (c) Copyright 2006 PepaR
; from: www.? ? ?.com
;----------------------------------------------------------- --------------
; Description:
;
; Zjistí plochu a obvod místnosti a zapíše jej jako atributy do bloku
;
; Command options:
; "MISTNOST" Výšková kóta
; "VKO" Oprava hodnoty výškové kóty
;=========================================================== =================
(defun mistnost_zjisti (/ celk_obvod celk_plocha plocha obvod i ss)
(setq celk_obvod 0.0)
(setq celk_plocha 0.0)
(prompt "\nVyberte křivku(y) místnosti: ")
(setq ss (ssget (list (cons -4 "<OR") (cons 0 "POLYLINE") (cons 0 "LWPOLYLINE") (cons -4 "OR>") )) i 0)
(while (< i (sslength ss))
(command "_area" "_e" (ssname ss i))
(setq celk_obvod (+ celk_obvod (getvar "perimeter")))
(setq celk_plocha (+ celk_plocha (getvar "area")))
(setq i (1+ i))
)
(setq plocha (vl-string-subst "," "." (rtos (/ celk_plocha (* 1000.0 1000.0)) 2 2))) ;;; Prevod na mm^2 -> m^2
(setq obvod (vl-string-subst "," "." (rtos (/ celk_obvod 1000.0) 2 2))) &n bsp; ;;; Prevod na mm -> m
(list plocha obvod)
)
(defun mistnost_zapis (entl naz pl obv / e eg)
(setq e (entnext entl))
(while e
(setq eg (entget e))
(if (= (cdr (assoc 0 eg)) "ATTRIB")
(progn
(if (= (cdr (assoc 2 eg)) "PLOCHA")
(progn
(setq eg (subst (cons 1 pl) (assoc 1 eg) eg))
(entmod eg)
)
)
(if (= (cdr (assoc 2 eg)) "OBVOD")
(progn
(setq eg (subst (cons 1 obv) (assoc 1 eg) eg))
(entmod eg)
)
)
(if (= (cdr (assoc 2 eg)) "NAZEV")
(progn
(setq eg (subst (cons 1 naz) (assoc 1 eg) eg))
(entmod eg)
)
)
)
)
(setq e (entnext e))
)
(princ)
)
;;; Pozor, entlast za urcitych okolnosti nevraci posledni entitu (je-li jako posledni entita napr. blok s atributy nebo polyline)
(defun entlast1 (/ e en)
(setq en (entlast))
(while en
(setq e en)
(setq en (entnext en))
)
e
)
(defun C:MISTNOST (/ entl entl1 attrq naz param)
(setq attrq (getvar "ATTREQ"))
(setvar "ATTREQ" 0)
(setq entl1 (entlast1))
(setq entl (entlast))
(setq param (mistnost_zjisti))
(setq naz (getstring "\nNazev mistnosti: "))
(prompt "\nUrčete bod vložení označení místnosti :")
(command "_-INSERT" "c_mistnosti" pause (getvar "dimscale")(getvar "dimscale") pause)
(mistnost_zapis entl1 naz (car param) (cadr param))
(entupd entl)
(setvar "ATTREQ" attrq)
(princ)
)
|
|
Odeslal: PepaR
Datum odeslání: 23.úno.2006 v 14:32
|
Děkuji moc, jsem Vám všem zavázán. Jen tak pro zajímavost jsem si zkoušel přidat do kódu ještě jednu položku atributu pro zadání a to číslo místnosti. Lisp proběhne v pořádku, ale pro aktualizaci zadaných hodnot (čísla) je nutné výkres regenerovat. Myslel jsem, že to řeší právě entupd avšak asi jsem se mýlil nebo se pletu...
-------------
PepaR
https://www.jremes.cz" rel="nofollow - jremes.cz | https://www.stavlab.cz" rel="nofollow - stavlab.cz
|
Odeslal: pavelstyl
Datum odeslání: 24.úno.2006 v 11:36
|
Aha, možná jsem udělal chybku. Zkuste to entupd opravit takto:
Pavel Štyl
|
Odeslal: PepaR
Datum odeslání: 26.úno.2006 v 21:35
Ano, nyní to již aktualizuje avšak při nezadaní názvu místnosti (tzn. hodnoty parametru) se blok nevloží... každopádně mockrát díky za péči, kterou mi věnujete.
-------------
PepaR
https://www.jremes.cz" rel="nofollow - jremes.cz | https://www.stavlab.cz" rel="nofollow - stavlab.cz
|
Odeslal: pavelstyl
Datum odeslání: 27.úno.2006 v 08:37
|
Mě to funguje tak, že pokud na výzvu "Nazev mistnosti" zadám ENTER (tzn. nezadám název místnosti), tak se blok normálně vloží. Pokud bych dal ESC, tak se program samozřejmě ukončí a blok se nevloží.
Pokud vám to nefunguje ani přes ten ENTER, zkuste opravit řádek
(if (= (cdr (assoc 2 eg)) "NAZEV") |
takto
(if (and (= (cdr (assoc 2 eg)) "NAZEV") naz) |
Pavel Štyl
|
Odeslal: PepaR
Datum odeslání: 28.úno.2006 v 01:50
Bohužel beze změny, jakmile nezadam nazev a číslo, tak se blok vubec nevloží...
-------------
PepaR
https://www.jremes.cz" rel="nofollow - jremes.cz | https://www.stavlab.cz" rel="nofollow - stavlab.cz
|
Odeslal: pavelstyl
Datum odeslání: 28.úno.2006 v 08:09
|
Dejte sem váš aktuální zdroják a přesný popis toho, co na jakou výzvu zmáčknete za klávesu. Pokusím se to nasimulovat.
A co máte za AutoCAD?
Pavel Štyl
|
Odeslal: PepaR
Datum odeslání: 28.úno.2006 v 18:41
|
Testovano na ACADu 2005.
http://www.cadforum.cz/forum/uploads/PepaR/2006-02-28_184122_Mistnost9.lsp - 2006-02-28_184122_Mistnost9.lsp
-------------
PepaR
https://www.jremes.cz" rel="nofollow - jremes.cz | https://www.stavlab.cz" rel="nofollow - stavlab.cz
|
Odeslal: pavelstyl
Datum odeslání: 01.bře.2006 v 13:17
|
Moje úvaha:
Jestliže nezadám název (jediná viditelná entita bloku), tak po vložení bloku nic nevidím. Divné je, že nic nevidím ani po zapnutí QTEXTu. ale jestliže zadám příkaz _EXPLODE _ALL, tak se ten blok rozbije. Tudíž tam musí být.
Jako řešení mě napadá jedině doplnit ten blok třeba nějakou čárou, aby vždycky bylo něco viditené.
Asi to nějak souvisí s problémy typu výběr mimo obrazovku, není nalezen průsečík čárkovaných čar protínajících se v díře, šrafovaná plocha musí být na obrazovce apod. Ale to je jenom můj odhad.
Pavel Štyl
|
Odeslal: PepaR
Datum odeslání: 02.bře.2006 v 19:17
|
To nevadí, i tak děkuji mnohokráte za pomoc a čas který jste mi věnoval. Zkusím to s tou čarou, přijde mi to jako nejschůdnější řešení...
-------------
PepaR
https://www.jremes.cz" rel="nofollow - jremes.cz | https://www.stavlab.cz" rel="nofollow - stavlab.cz
|
|