Dobrý den,
řešil jsme to zde již podobným dotazem,a le nevím jak to zakomponovat do toho LISP souboru neboť s emezi programátory nepočítám :(
 
Mám LISP pro tvorbu výškových kót, ktery odečítá Y-ovou sořadnici o 0,0,0 a tu zapíše do hodnoty atributu vkládaného bloku. Potřebuji, ale nějak udělat aby tento příkaz bral jako 0,000 počátek relativního souřadného systému? Hledal jsem všude možně ale funkce "cadr" zjistí hodnotu y souřadnice jen v globálním systému a nic jiného jsem nenašel. Je to dost nepoužitelné posouvat řezy a tak ve větších výkresech kde jsou i půdorysy. Nebo prostě to jen dočasně nastavit na úroveň, kde zvolím 0 já a pak to vrátit zpět.
 
Budu moc rád za jakoukoli radu, děkuji a přeji hezký den.
PS: V případě zájmu zašlu funkci včetně menu i bloků.
 


uploads/20070319_215819_kotvysk.lspPepaR2007-03-19 22:00:13

Do LSP kódu jsem nekoukal, ale zkuste funkci (trans).

No abych se přiznal a abych to osvětlil, jsem absolutní, ale absolutní neznalec LISPu, proto bych potřeboval radu od Vás vyvolených :)
 
Do LISPu jsem samozřejmě nahlížel a předpokládám, že pro zjištění výšky z y-ové souřadnice slouží tento fragment:
[QUOTE=kotvysk.lsp]
(defun zjisti_vysku (/ k y)  (setq y (/ (cadr (cdr (assoc 10 (entget ko)))) 1000))  (cond    ((> y 0) (setq text (strcat "+" (rtos y 2 3))))    ((= y 0) (setq text "0,000"))    ((< y 0) (setq text (rtos y 2 3)))  ) ; cond
 
  (setq k (entnext ko))  (setq k (entget k))  (setq k (subst (cons '1 (vl-string-subst "," "." text)) (assoc 1 k) k))  (entmod k)  (entupd ko)) ; defun
[/QUOTE]
Nicméně netuším, kde dát ten TRANS, říkal jsme si, že by to mohlo být tak, ale je to jen domněnka
 

[QUOTE=kotvysk.lsp]
(defun zjisti_vysku (/ k y)  (setq y1 (/ (cadr (cdr (assoc 10 (entget ko)))) 1000))  (setq y (trans něco něco......) )  (cond    ((> y 0) (setq text (strcat "+" (rtos y 2 3))))    ((= y 0) (setq text "0,000"))    ((< y 0) (setq text (rtos y 2 3)))  ) ; cond
 
  (setq k (entnext ko))  (setq k (entget k))  (setq k (subst (cons '1 (vl-string-subst "," "." text)) (assoc 1 k) k))  (entmod k)  (entupd ko)) ; defun
[/QUOTE]
 
Pomůžete prosím?

Mohlo by to byt napriklad takhle. Nezapomente, ze pri zmene USS se muzete hodne seknout pri aktualizaci koty (prikaz VKO) (defun zjisti_vysku (/ k y)  (setq y (cdr (assoc 10 (entget ko)))) ;nacte do y hodnotu bodu  (setq y (trans y 0 1)) ; prevede z globalniho do aktualniho USS  (setq y (/ (cadr y) 1000))  ;(setq y (/ (cadr (cdr (assoc 10 (entget ko)))) 1000)) ; zakomentovany puvodni prikaz    (cond    ((> y 0) (setq text (strcat "+" (rtos y 2 3))))    ((= y 0) (setq text "0,000"))    ((< y 0) (setq text (rtos y 2 3)))  ) ; cond  (setq k (entnext ko))  (setq k (entget k))  (setq k (subst (cons '1 (vl-string-subst "," "." text)) (assoc 1 k) k))  (entmod k)  (entupd ko)) ; defunalfred2007-03-20 14:46:51

Děkuju moc za pomoc.
Tak aktualizace mi bohužel nikdy nefungovala? Vám snad ano? PepaR2007-03-20 18:46:29

Aktualizaci jsem nezkousel. Ptal jste se na TRANS.... Jen tak do toho souboru letmo koukam (nesedim u AutoCadu) a zda se mi ze by to melo fungovat. Co Vam to pise pri aktualizaci?

Vámi provedená úprava s trans funguje výtečně, ještě jednou mockrát děkuji.
 
Při příkazu VKO mi to vypíše následující:
[QUOTE=]
Příkaz: vko
 
Ukaž výškovou kótu :Není vyšková kota.Ukaž výškovou kótu :
[/QUOTE]

utilita si kontroluje jestli je vybrana entita blok (INSERT) a jak se blok jmenuje. Blok se musi jmenovat presne dle definovanych nazvu - pozor na VELKA PISMENA! Nazvy jsou definovany v nasledujici casti kodu:                                  (=   (fld 2) "KOTAVYSK")                 (= (fld 2) "VK1")                 (= (fld 2) "VK2")                 (= (fld 2) "VK3")                 (= (fld 2) "VK4")                 (= (fld 2) "VK5")                 (= (fld 2) "VK6")                 (= (fld 2) "VK7")                 (= (fld 2) "VK8")alfred2007-03-21 06:54:57

Tak to s tou velikostí písmen mě nenapadlo. Stejně je to zajimavé,  blok se jmenuje VK1.dwg, tak bych předpokládal, že název po vložení bude VK1, ale ouha je to právě vk1, takže zakopaný pes je tam. Děkuji.
 
Vyřešil jsem to následovně:
[QUOTE]
(defun C:VKO ()    ;  oprava hodnoty u výšk. kot  (k-start)    (while (setq ko (car (entsel "\nUkaž výškovou kótu :")))    (setq d (entget ko))    (if (and (= (fld 0) "INSERT")             (or (= (fld 2) "KOTAVYSK")                 (= (fld 2) "vk1")                 (= (fld 2) "vk2")                 (= (fld 2) "vk3")                 (= (fld 2) "vk4")                 (= (fld 2) "vk5")                 (= (fld 2) "vk6")                 (= (fld 2) "vk7")                 (= (fld 2) "vk8")                 (= (fld 2) "VK1")                 (= (fld 2) "VK2")                 (= (fld 2) "VK3")                 (= (fld 2) "VK4")                 (= (fld 2) "VK5")                 (= (fld 2) "VK6")                 (= (fld 2) "VK7")                 (= (fld 2) "VK8")             ) ; or        ) ; and     (zjisti_vysku)     (prompt "\nNení vyšková kota.")    ) ; if  ) ; while
[/QUOTE]
 
 
 

Prosím Vás a nepomohli byste mi ješte s jedním problémem,
pořeboval bych definovat funkci, která nastaví počátek 0,0,0 na zvolený bod, uloží jej do nějaké proměnné. To by šlo provést pomocí standardního příkazu v AutoCADu, ale nevím jak s tou proměnnou. A následně by byla druhá funkce, která by pomocí obsahu té proměnné vrátila nastavení 0 zpět.
 
Předem děkuji.

A USS Předchozí nebo poJMenovaný by nestačil?
Kdyžtak sekvence příkazů na tlačítko.

No mě by ty klasické příkazy pro USS nebo i pojmenované pohledy stačily, ale jelikož to chci zapracovat do LISPu s těmi výškovými kótami, tak bych to potřeboval nadefinovat výš popsaným způsobem neboť tuto funkci používají mí kamarádi, kteří USS neznají a jsem rád když výkresy od nich drží 0.

No tak to zapracujte do toho lispu pomocí příkazu command.
 
Co myslíte tím "drží 0".

Ta sekvence s command mě napadla, ale nevím jak to zapsat do proměnné a pak to z ní obnovit.
 
Myslím jako 0,0,0 v celém projektu na stejném místě.

Představuji si to asi nějak takhle:
 
(setq P1 (getpoint "Vyber nový počátek"))
(command "_UCS" "JM" "V" "*")(command "_UCS" "JM" "U" "AA")(command "_UCS" P1 "")
(Getstring "Vrátit.")
(command "_UCS" "JM" "B" "AA")

Zkušel jsem to, ale JM je pravděpodobně neplatným klíčovým slovem:
 
uploads/20070321_100430_kotvysk_v4.lsp
 
[QUOTE]
Vyber nový počátekNeplatné klíčové slovo.
 
"Funkce přerušena"Zadejte volbu [Nový/poSun/ortograF/Předchozí/oBnov/Ulož/Vymaž/použíT/?/Glob] <Glob>: *Storno*

[/QUOTE]

No já to zkoušel na 2007Cz. Zřejmě došlo ke změnám v zadávání.
To je dost nepříjemné kdvůli přechodům mezi verzemi. Není asi problém to pro 2006 upravit, ale pak by se to muselo předělávat, až si pořídíte 2008 atd. Takže asi opravdu čistě v lispu.
  A co to má dělat? Má ten souřadný systém zůstat uložený s výkresem, nebo stačí jen po dobu vykonávání lispu?

Tak toje nepříjemné, nechápu proč se to neustále mění dle verzí.
 
No zamýšlel jsem dobu uložení te proměnné jen po dobu práce s výkresem. Tzn. dal bych si do menu 2 tlačítka pro nastavení nuly a poté vrácení zpět, vím je to nešikovné z toho důvodu, že při zavření výkresu a nestiknutí tlačítka by to nastavení zůstalo, ale v tom případě by uživatel měl při znovuotevření výkresu zadní vrátka v podobně Globalního souř. systému.
 PepaR2007-03-27 22:34:46

BTW pro 2006 Cz by to vypadalo:
(setq P1 (getpoint "Vyber nový počátek"))
(command "_UCS" "V" "*")(command "_UCS"  "U" "AA")(command "_UCS" "N" P1)
(Getstring "Vratit.")
(command "_UCS" "B" "AA")

Nové verze mají v příkazech nové volby, ale kompatibilita starých skriptů a maker je zachovávána. Platí to i v tomto případě.
Musíte však používat správný zápis - např. _UCS U AA je chybně - není žádná volba "U", je jen volba Ulož (správněji _Save), která měla shodou okolností v verzi 2006 zkratku "U". Pokud použijete standardní zápis _UCS _Save AA, bude makro chodit verzi 2006, 2007 i 2008 správně.

Samozřejmě máte pravdu - z lenosti a ve spěchu jsem použil české zkratky.
   Problém ale je v tom, že jsem to tvořil v 2007 a tudíž i při korektním použití "mezinározních" voleb to IMHO v 2006 chodit nebude, protože tyto volby 2006 nezná. Takže by to chtělo přepsat do korektních voleb tu verzi pro 2006 a ta by snad měla fungovat i v budoucnu. Ruku do vohně bych ale za to nedal ;-)

Pak by to tedy vypadalo:
(setq P1 (getpoint "Vyber nový počátek"))
(command "_UCS" "_DELETE" "*")(command "_UCS"  "_SAVE" "AA")(command "_UCS" "_New" P1)
(Getstring "Vratit.")
(command "_UCS" "_restore" "AA")
 
a vskutku to chodí na 2006 i 2007.

Děkují pánové mnohokráte, zítra vyzkouším.

Takže právě jsme to odzkoušel, ale je tu malý zádrhel, při pokud o navrácení 0 na původní hodnotu se mě to v příkazovém řádku zeptá Vratit. a musím to potvrdit Enterem. Jak by vypadala prosím varianta, kdy by to jen vypsalo text Počátek byl vrácen.
 

 
A nyní snad již poslední problém, jak ve funkci zprovoznit při opravě kóty VKO, aby se nevybírali výškové kóty jednotlivě, ale aby šlo vybrat vybíracím rámečkem? Je to moc složité pro zakomponování do LISPu?

Ale to si nějak nerozumíme. Já jsem nedodal hotový produkt, ale jen ukázku, jak si myslím, že by to mohlo fungovat. Takže lispík se optá na nové umístění počátku a přesune tam počátek USS. Druhá půlka ho zase vrátí zpátky. A aby bylo vůbec vidět, co se děje, vložil jsem tam ten getstring, na kterém se to zarazí a čeká na jakýkoliv vstup.
JINAK TEN ŘÁDEK NEMÁ ŽÁDNÝ VÝZNAM a předpokládám, že v definitivním kódu nebude.

OK, to jsme chtěl vědět. Děkuju mockrát.

sledoval jsem  toto téma a upravil jsem lisp takto
kod\
(setq x 0)  (setq ko 0)
  (srovrovina)  (setq sset (SSGET))  (while (/= ko nil)    (setq ko (ssname sset x))
    (setq d (entget ko))    (if (and (= (fld 0) "INSERT")      (or (= (fld 2) "KOTAVYSK")   (= (fld 2) "vk1")   (= (fld 2) "vk2")   (= (fld 2) "vk3")   (= (fld 2) "vk4")   (= (fld 2) "vk5")   (= (fld 2) "vk6")   (= (fld 2) "vk7")   (= (fld 2) "vk8")   (= (fld 2) "VK1")   (= (fld 2) "VK2")   (= (fld 2) "VK3")   (= (fld 2) "VK4")   (= (fld 2) "VK5")   (= (fld 2) "VK6")   (= (fld 2) "VK7")   (= (fld 2) "VK8")   (= (fld 2) "vhp")   (= (fld 2) "VHP")      )    ; or )    ; and      (zjisti_vysku)      (prompt "\nNení vyšková kota.")    )     ; if    (setq x (+ x 1))  )     ;while  (command "_ucs" "p")  (command "_ucs" "p"))
\kod
 pridal jsem funkci srovrovina
kod\
(defun srovrovina (/ usecka ucs1 ucs2 ucs11 ucs22 ucs111 ucs222)  (while (/= usecka "LINE")    (setq srov (entsel "\nUkaž srovnavací rovinu"))    (setq line (car srov))    (setq usecka (cdr (assoc 0 (entget line))))  )
  (setq vys vyska)  (if (= vys nil)    (setq vys 0)  )  (setq vysk (rtos vys 2 3))  (setq text (strcat vysk ">: "))  (setq text (strcat "\nZadej výšku srovnavací roviny <" text))
  (setq vyska (getreal text))  (if (= vyska nil)    (setq vyska vys)  )  (setq line (car srov))  (setq ucs1 (cdr (assoc 10 (entget line))))  (setq ucs2 (cdr (assoc 11 (entget line))))  (setq znam1  (getreal    "\nZadejnatočení srovnavací roviny vůči globálnímu sopuřadnýmuz systému (1) natočeni 270-90, (2) naočení 90,1-269,9 <1> : "  )  )  (if (= znam1 2.0)    (progn
      (if (< (car ucs2) (car ucs1)) (progn   (setq ucs11 ucs1)   (setq ucs22 ucs2) )
 (progn   (setq ucs22 ucs1)   (setq ucs11 ucs2) )      )    )    (progn      (if (>= (car ucs2) (car ucs1)) (progn   (setq ucs11 ucs1)   (setq ucs22 ucs2) )
 (progn   (setq ucs22 ucs1)   (setq ucs11 ucs2) )      )    )  )
  (command "_ucs" "W")  (command "_ucs" "n" "3" ucs11 ucs22 ""))
\kod
a ješte upravil funkci "zjisti vysku"
kod\
(setq y (cdr (assoc 10 (entget ko)))) ;nacte do y hodnotu bodu  (setq y (trans y 0 1))  ; prevede z globalniho do aktualniho USS  (setq y (/ (cadr y) 1000))     ;(setq y (/ (cadr (cdr (assoc 10 (entget ko)))) 1000)) ; puvodni prikaz  (setq y (+ y vyska))  (cond
.....
\kod
 
 
 

Ještě bych se chtěl zeptat pravděpodobně na základní věc, u řešení dle pana Seinera mi při anstavování funkce vše proběhne v pořádku, ale při volbě počátku mi to za textovou hláškou vypíše text nil.
 
Příklad: Zvolte nový počátek (0,000)nil
 
Jak to prosím vyrušit?
 
[QUOTE]
(defun C:VKNULA ()    ;  nastavení počátku pro kótování  (setq P1 (getpoint "Zvolte nový počátek (0,000) :"))  (command "_UCS" "_DELETE" "*")  (command "_UCS"  "_SAVE" "NULAVK")  (command "_UCS" "_New" P1)) ; defun
 
(defun C:VKNULAZPET ()    ;  vrátí zpět původní počátek  (command "_UCS" "_restore" "NULAVK")  (princ "Počátek (0,0,0) byl vrácen an původní hodnotu.")  (print)) ; defun
[/QUOTE]

Ke druhé části otázky:
- místo entsel je nutno použít výběrovou množinu a úpravu dělat v cyklu.
Třeba takhle to vypadá pro vymazání téměř nulových úseček:
 
(setq V (ssget "X"(list(cons 0 "line"))))(setq n (sslength v) i 0 j 0)(while (< i n)   (setq  u (entget (ssname V i))l (distance (cdr(assoc 10 u)) (cdr(assoc 11 u))))(if (< l 1)(progn(setq j(+ 1 j))(entdel (ssname V i))))(setq i(+ 1 i)))(write-line (strcat "Vynazano " (itoa j) " prvku delky 0"))(write-line (strcat "Celkem " (itoa i) " prvku"))(princ)
 
Pokud chcete vybírat opravdu oknem, použijete ..(setq V(ssget)).
 

k té návratové hodnotě:
lisp vrací vždy odezvu poslední funkce. Takže tam dejte na konec nějakou, která vrací prázdný řádek. Třeba (PRINC)
 

[QUOTE=Seiner]k té návratové hodnotě:
lisp vrací vždy odezvu poslední funkce. Takže tam dejte na konec nějakou, která vrací prázdný řádek. Třeba (PRINC)
[/QUOTE]
 
Díky za tim, nakone jsem to vyřešil pomocí (PRINT)
 
[QUOTE]
(defun C:VKNULA ()    ;  nastavení počátku pro kótování  (setq P1 (getpoint "Zvolte nový počátek (0,000) :"))  (command "_UCS" "_DELETE" "*")  (command "_UCS"  "_SAVE" "NULAVK")  (command "_UCS" "_New" P1)  (print)) ; defun
[/QUOTE]

[QUOTE=Seiner]Ke druhé části otázky:
- místo entsel je nutno použít výběrovou množinu a úpravu dělat v cyklu.
Třeba takhle to vypadá pro vymazání téměř nulových úseček:
[/QUOTE]
Tak tady už musím sklopit hlavu a smeknout před těmi co jim jdou programovací jazyky, ja su na to prostě levý. Viz třeba toto naťuknutí od pana Seinera
 
[QUOTE=Pajda]
sledoval jsem  toto téma a upravil jsem lisp takto
kod\
(setq x 0)  (setq ko 0)
  (srovrovina)[/QUOTE]
Děkuju za další variantu, bohužel se mi to nepodařilo rozjet. Hlásí to chybu závorky, popř. další chyby.
uploads/20070322_111722_kotvysk_v1.3_-_.lsp

Myslím, že ta forma zápisu defaultní hodnoty  (setq P1 (getpoint "Zvolte nový počátek (0,000) :"))by něla být spíše  (setq P1 (getpoint "Zvolte nový počátek <0,000> :"))

Díky za připomínku, ale myslel jsem to tak, že 0,000 je myšleno jako plusminus nula v projektu. Nicméně, lze to interpretovat i tak, že potvrzení nastaví jako hodnotu 0,0,0 jak píšete Vy: <0,000>.