<img src="/common/bigicon-diskuze.png" style="vertical-align:middle;height:80px" alt="Diskuze"/> Diskuzní fórum, poradna

CAD/BIM manager

Přihlášen: 01.říj.2004
Lokalita: ČR (PA)
Používám:
Mechanical 2017, Inventor 2017 a starší
Stav: Offline
Bodů: 1662

Zasláno: 21.bře.2007 v 10:39

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")

Vítězslav Seiner

Chrudim

Vladimír Michl Zobrazit panel

Moderátor

Arkance Systems

Přihlášen: 09.zář.2004
Lokalita: ČR (JČ)
Používám:
Implementujeme řešení Autodesk
Stav: Offline
Bodů: 21898

Zasláno: 21.bře.2007 v 11:07

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

Vladimír Michl (moderátor)
ARKANCE CZ - arkance.world
(podpora viz helpdesk.arkance-systems.cz)

Seiner

CAD/BIM manager

Přihlášen: 01.říj.2004
Lokalita: ČR (PA)
Používám:
Mechanical 2017, Inventor 2017 a starší
Stav: Offline
Bodů: 1662

Zasláno: 21.bře.2007 v 12:12

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 ;-)

Vítězslav Seiner

Chrudim

Seiner

CAD/BIM manager

Přihlášen: 01.říj.2004
Lokalita: ČR (PA)
Používám:
Mechanical 2017, Inventor 2017 a starší
Stav: Offline
Bodů: 1662

Zasláno: 21.bře.2007 v 12:25

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.

Vítězslav Seiner

Chrudim

PepaR

CAD/BIM manager

Přihlášen: 29.lis.2004
Lokalita: ČR (ZL)
Používám:
ruky a hlavu (občas ;)
Stav: Offline
Bodů: 6201

Zasláno: 21.bře.2007 v 20:07

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

PepaR
jremes.cz | stavlab.cz

PepaR

CAD/BIM manager

Přihlášen: 29.lis.2004
Lokalita: ČR (ZL)
Používám:
ruky a hlavu (občas ;)
Stav: Offline
Bodů: 6201

Zasláno: 22.bře.2007 v 09:14

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.

Připojené náhledy

Přihlaste se pro zobrazení plné verze - 20070322_091428_VKNULAZPET.jpg

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?

PepaR
jremes.cz | stavlab.cz

Seiner

CAD/BIM manager

Přihlášen: 01.říj.2004
Lokalita: ČR (PA)
Používám:
Mechanical 2017, Inventor 2017 a starší
Stav: Offline
Bodů: 1662

Zasláno: 22.bře.2007 v 09:29

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.

Vítězslav Seiner

Chrudim

PepaR

CAD/BIM manager

Přihlášen: 29.lis.2004
Lokalita: ČR (ZL)
Používám:
ruky a hlavu (občas ;)
Stav: Offline
Bodů: 6201

Zasláno: 22.bře.2007 v 09:31

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

PepaR
jremes.cz | stavlab.cz

Pajda

Diskutér

Přihlášen: 21.pro.2005
Lokalita: Czech Republic
Stav: Offline
Bodů: 13

Zasláno: 22.bře.2007 v 09:34

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

PepaR

CAD/BIM manager

Přihlášen: 29.lis.2004
Lokalita: ČR (ZL)
Používám:
ruky a hlavu (občas ;)
Stav: Offline
Bodů: 6201

Zasláno: 22.bře.2007 v 10:00

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?

(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

PepaR
jremes.cz | stavlab.cz

Seiner

CAD/BIM manager

Přihlášen: 01.říj.2004
Lokalita: ČR (PA)
Používám:
Mechanical 2017, Inventor 2017 a starší
Stav: Offline
Bodů: 1662

Zasláno: 22.bře.2007 v 10:01

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

Vítězslav Seiner

Chrudim

Seiner

CAD/BIM manager

Přihlášen: 01.říj.2004
Lokalita: ČR (PA)
Používám:
Mechanical 2017, Inventor 2017 a starší
Stav: Offline
Bodů: 1662

Zasláno: 22.bře.2007 v 10:22

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)

Vítězslav Seiner

Chrudim

PepaR

CAD/BIM manager

Přihlášen: 29.lis.2004
Lokalita: ČR (ZL)
Používám:
ruky a hlavu (občas ;)
Stav: Offline
Bodů: 6201

Zasláno: 22.bře.2007 v 10:48

Seiner napsal(a):

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)

Díky za tim, nakone jsem to vyřešil pomocí (PRINT)

PepaR
jremes.cz | stavlab.cz

PepaR

uploads/20070322_111722_kotvysk_v1.3_-_.lsp

CAD/BIM manager

Přihlášen: 29.lis.2004
Lokalita: ČR (ZL)
Používám:
ruky a hlavu (občas ;)
Stav: Offline
Bodů: 6201

Zasláno: 22.bře.2007 v 11:17

Seiner napsal(a):

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:

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

Pajda napsal(a):

sledoval jsem toto téma a upravil jsem lisp takto

kod\

(setq x 0)
(setq ko 0)

(srovrovina)

Děkuju za další variantu, bohužel se mi to nepodařilo rozjet. Hlásí to chybu závorky, popř. další chyby.

Připojené soubory lsp

PepaR
jremes.cz | stavlab.cz

Ferdinand

TOP uživatel

Přihlášen: 01.říj.2004
Lokalita: ČR (JM)
Používám:
AutoCAD2004 (EN) na Windows XP
Stav: Offline
Bodů: 1906

Zasláno: 26.bře.2007 v 13:53

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> :"))

-FerTh-

PepaR