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: 14810 
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řenoPorovnanie zoznamov

 Odpovědět Odpovědět archiv
Autor
michaelflyer Zobrazit panel
Zasloužilý člen
Zasloužilý člen

Přihlášen: 05.úno.2007
Lokalita: Slovensko
Používám:
AutoCAD
Stav: Offline
Bodů: 105
Přímý odkaz na tuto zprávu Téma: Porovnanie zoznamov
    Zasláno: 05.říj.2014 v 17:33

Dobrý deň.

Potreboval by som pomôcť so zoznamom.  Aj napriek tomu že som už použil viacero spôsobov tak mi rutina nefunguje:

 

(setq n 0)

(repeat (length BOD_X_list)

      (setq i 0)

      (setq BOD_X (nth n BOD_X_list))

      (repeat (length suradnice_BODOV)

         (setq bod_X_zapis nil)

;;;      (setq bod_X_zapis (equal (nth i suradnice_BODOV) BOD_X ));;; PRVY SPôSOB

         (if (= (nth i suradnice_BODOV) BOD_X) (setq bod_X_zapis T));;; DRUHÝ SPôSOB

         (setq i (1+ i))

         )

      (setq BOD_Z (last suradnice_BODOV))

      (if (/= bod_X_zapis T) (setq suradnice_BODOV (append suradnice_BODOV (list BOD_X))))

      (setq n (1+ n))

      )

 

BOD_X_list => zoznam súradníc 1 xyz.

suradnice_BODOV=> zoznam súradníc  2 xyz.

 

účelom tohto programu malo byť to, že porovná zoznam každý s každým prvkom a ak sa nezhoduje so zoznamom " suradnice_BODOV" tak súradnicu xyz zapíše do tohto zoznamu. Problém však bol, že aj keď súradnice boli úplne totožné:

(155236.0 21027.1 0.0) =>suradnice_BODOV

(155236.0 21027.1 0.0)=>BOD_X 

 tak mi danú súradnicu zapísalo do zoznamu a už to bolo v nekonečnej smičke... Poprípade ak by má niekto jednoduchší zápis, tak si nechám poradiť.

 

Ešte by som vá chcel poprosiť či neexistuje nejaký program, ktorý by našiel všetky quadranty na polilajne, či kruhu, alebo oblúku cez aktiveX? Priesečníky, koncové body síce viem nájsť, ale s quadrantami mám problém.

 

Vopred ďakujem.



Upravil michaelflyer - 05.říj.2014 v 17:38
Michal MUCHA
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ů: 21434
Přímý odkaz na tuto zprávu Zasláno: 05.říj.2014 v 20:02
Jak ty body vznikaly, resp. podle čeho soudíte že souřadnice jsou úplně totožné? Ověřte si pro jistotu toto tvrzení např. výpisem hodnoty:
 
(rtos (car BOD_X) 2 10)
 
Vladimír Michl (moderátor)
Arkance Systems s.r.o. - www.arkance-systems.cz
(podpora viz hd.cads.cz)
Zpět nahoru
michaelflyer Zobrazit panel
Zasloužilý člen
Zasloužilý člen

Přihlášen: 05.úno.2007
Lokalita: Slovensko
Používám:
AutoCAD
Stav: Offline
Bodů: 105
Přímý odkaz na tuto zprávu Zasláno: 05.říj.2014 v 21:13
Ďakujem za odpoveď ale rtos mi to asi nerieši...
Posielam celý kód:

(defun C:phs ( / ent1 ss2 BOD_X) 
    
  (while (= (setq ent_s_bodom (entsel "Vyber polilajnu v bode výstupu:")) nil))
  (setq dlzka_naslapu (getdist "Napíš dlžku nášlapu (hlbku stupoa):"))

  (setq i 0
suradnice nil
suradnice_BODOV nil
bod_X_zapis nil)
  (setq ent_zoznam (entget (car ent_s_bodom)))
  (repeat (length  ent_zoznam)
    (if (= (car (nth i ent_zoznam)) 10)
      (setq suradnice (append suradnice (list (cdr (nth i ent_zoznam))))))
    (setq i (1+ i))
    )
  
  (setq ent_bod (cadr ent_s_bodom))
  (setq PRVY_bod_pline (car suradnice))
  (setq END_bod_pline (last suradnice)) ;posledny clen v zozname
  (setq vzdialnost_1 (distance ent_bod PRVY_bod_pline))
  (setq vzdialnost_2 (distance ent_bod END_bod_pline))
  (if (< vzdialnost_1 vzdialnost_2) (setq ZACIATOK_pline PRVY_bod_pline))
  (if (< vzdialnost_2 vzdialnost_1) (setq ZACIATOK_pline END_bod_pline suradnice (reverse suradnice)))

  (setq BOD_X ZACIATOK_pline)
  (if (= (length BOD_X) 2) (setq BOD_X (append BOD_X (list 0.0)))) 
  (setq ent1 (car ent_s_bodom))
  (setq suradnice_BODOV (list BOD_X))
  
    
  (while (/= bod_X_zapis T)
    (setq ent_x (entmake (list '(0 . "CIRCLE")
      (cons 10 BOD_X)
      (cons 40 dlzka_naslapu))))
    
    (setq ss2 (ssget "_L"))
    (setq ent_x (ssname ss2 0))
    (setq BOD_X_list (mm:priesecnikOBJEKTY ent1 ss2))
;;;    (entdel ent_x)
    (setq n 0
 bod_X_zapis nil) 
    
    (repeat (length BOD_X_list)
      (setq i 0)
      (setq BOD_X (nth n BOD_X_list))
      (repeat (length suradnice_BODOV)
(setq bod_X_zapis nil)
;;; (setq bod_X_zapis (equal (nth i suradnice_BODOV) BOD_X ))
(if (= (nth i suradnice_BODOV) BOD_X) (setq bod_X_zapis T))
(setq i (1+ i))
)
      (setq BOD_Z (last suradnice_BODOV))
      (if (/= bod_X_zapis T) (setq suradnice_BODOV (append suradnice_BODOV (list BOD_X))))
      (setq n (1+ n))
      )
    (setq BOD_X (last suradnice_BODOV))
    (if (= BOD_X BOD_Z) (setq bod_X_zapis T))
    )
  )


(defun mm:priesecnik (obj1 obj2 mode / l r)
  (setq l (vlax-invoke obj1 'intersectwith obj2 mode))
  (repeat (/ (length l) 3)
    (setq r (cons (list (car l) (cadr l) (caddr l)) r)
 l (cdddr l)
    )
  )
  (reverse r)
)

(defun mm:priesecnikOBJEKTY (E1 s2 / a b i j l)
  (setq a (vlax-ename->vla-object E1))
  (repeat (setq j (sslength s2))
    (setq b (vlax-ename->vla-object (ssname s2 (setq j (1- j))))
 l (cons (mm:priesecnik a b acextendnone) l)
    )
  )
  (apply 'append (reverse l))
)


suradnice_BODOV => ((155236.0 21027.1 0.0) (155450.0 21479.0 0.0) (155770.0 21863.1 0.0) (155236.0 21027.1 0.0))
BOD_X => (155236.0 21027.1 0.0) 
Michal MUCHA
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ů: 21434
Přímý odkaz na tuto zprávu Zasláno: 05.říj.2014 v 21:44
Nezkoumal jsem přesně logiku kódu, ale na to porovnání raději používejte (equal), možná dokonce:
 
(setq bod_X_zapis (equal (nth i suradnice_BODOV) BOD_X 0.001))

Neměla by být logika testu na bod_X_zapis spíš obráceně, v tomto tvaru?
 
(if bod_X_zapis (setq suradnice_BODOV (append suradnice_BODOV (list BOD_X))))
Vladimír Michl (moderátor)
Arkance Systems s.r.o. - www.arkance-systems.cz
(podpora viz hd.cads.cz)
Zpět nahoru
michaelflyer Zobrazit panel
Zasloužilý člen
Zasloužilý člen

Přihlášen: 05.úno.2007
Lokalita: Slovensko
Používám:
AutoCAD
Stav: Offline
Bodů: 105
Přímý odkaz na tuto zprávu Zasláno: 05.říj.2014 v 22:35
s príkazom equal a toleranciou 0.0001 som skúšal a nefungovalo mi to. Ale s toleranciou 0.001 sa mi vidí, že to asi funguje-pozriemto podrobne ajtra.

a s píkazom (if bod_X_zapis (... máte pravdu. To som si neuvedomil. 

Ďakuejm za rady.
Michal MUCHA
Zpět nahoru
johny Zobrazit panel
TOP uživatel
TOP uživatel

Přihlášen: 24.led.2006
Lokalita: ČR (JM)
Používám:
C3D 2022
Stav: Offline
Bodů: 1671
Přímý odkaz na tuto zprávu Zasláno: 06.říj.2014 v 00:18
Jestli jsem to celé pochopil tak:
(if (= (nth i suradnice_BODOV) BOD_X) (setq bod_X_zapis T))
porovnáváte 
"suradnice_bodov" což není nic jiného než bod začátku polyline ve formátu ((x y z))
se seznamem průsečíků (BOD_X_list) oné polyline s kružnicí, která byla nakreslena v bodu začátku polyline.
>> to mi nezní jako že by to mělo řešení...

Nějaká doporučení:
Zkuste proměnné lépe pojmenovat... nezdá se to moc logické. 
Ten repeat cyklus není asi úplně nejvhodnější pro seznam... lépe 
  (foreach i ed
    (if (eq (car i) 10)
      něco))
Text je vhodné odřádkovat (entsel "\nVyber polylajnu:")
...a pak i otestovat, zdali byla vybrána právě polyline.

Jestli neznáte tak zkuste nastudovat příkazy pro práci s polyline (vlax-curve*):
http://exchange.autodesk.com/autocadmep/enu/online-help/BLDSYS/2012/ENU/pages/WS1a9193826455f5ff1a32d8d10ebc6b7ccc-684e.htm

A doporučoval bych vypnout OSNAP... je to vzdycky jistější.


Upravil johny - 06.říj.2014 v 17:46
Zpět nahoru
michaelflyer Zobrazit panel
Zasloužilý člen
Zasloužilý člen

Přihlášen: 05.úno.2007
Lokalita: Slovensko
Používám:
AutoCAD
Stav: Offline
Bodů: 105
Přímý odkaz na tuto zprávu Zasláno: 15.říj.2014 v 10:04

Vladimír Michl:

Veľmi ste mi pomohol s príkazom equal. Neviem síce prečo ale bol to jedniný príkaz ktorý mi v acad 2000 fungoval. 

Ale stále je to zbytočne zložité. Skúšal som najjednoduchšiu variantu a tou bol príkaz member - porovná zoznam a ak sa nenachádza vyhodí nil a tak môže zapísať súradnicu xyz do zoznamu. Dal som si to otestovať na acad 2015. Tam to bez problémov fungovalo. V čom je teda problém? V tolerancii, alebo presnosti?

johny:

Áno pochopil ste program správne.

Pokúsil som sa aby som vyberal iba polilajny, no už keď nevyberiem žiaden objekt, tak mi vyhlási chybu. Neviem ako by som do toho vsunul cyklus pre nil výber.

 

(while (/=
(setq LWPOLYLINE
(progn
(setq ent_s_bodom (entsel "\nVyber polilajnu v bode výstupu:"))
(setq ent_zoznam (entget (car ent_s_bodom)))
(foreach i ent_zoznam
(if (eq (car i) 0)
(setq LWPOLYLINE (cdr i))))
(princ LWPOLYLINE)))
(setq LWPOLYLINE_2 "LWPOLYLINE")))
 

repead cyklus, ktorý ste mi poradil nahradiť za foreach bol super nápad!

(vlax-curve*) to sa musím doučiť - mysleli ste to na získanie koncových bodov polilajny.

OSNAP tu mám trošku nedostatky - robím to trošku zložito. teda cez makro. Comand "_osnap" "off"... Viem že sa to dá robiť cez setvar getvar. No neviem kde a ako mám prísť k tým príkazom poznám nejaké "to" cmdecho ale to je všetko.



Ďakujem za rady. Boli veľkým prínosom.

Michal MUCHA
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ů: 21434
Přímý odkaz na tuto zprávu Zasláno: 15.říj.2014 v 10:26
Jestli vám jde o rozdíl dvou seznamů, pak můžete použít tuto funkci:
(defun ListDiff (list1 list2)
(vl-remove-if '(lambda(x) (member x list2)) list1)
)
Ale u porovnávání souřadnic nebo jiných reálných čísel (v jakýchkoliv programovacích jazycích) je třeba dát pozor na nejistou přesnou shodu.
Vladimír Michl (moderátor)
Arkance Systems s.r.o. - www.arkance-systems.cz
(podpora viz hd.cads.cz)
Zpět nahoru
johny Zobrazit panel
TOP uživatel
TOP uživatel

Přihlášen: 24.led.2006
Lokalita: ČR (JM)
Používám:
C3D 2022
Stav: Offline
Bodů: 1671
Přímý odkaz na tuto zprávu Zasláno: 15.říj.2014 v 16:48

Původně odeslal(a) michaelflyer michaelflyer napsal(a):

(vlax-curve*) to sa musím doučiť - mysleli ste to na získanie koncových bodov polilajny.

Ano, mimo jiné. Těch funkcí je ale spousta... např. GetPointAtDistance...

Původně odeslal(a) michaelflyer michaelflyer napsal(a):

OSNAP tu mám trošku nedostatky - robím to trošku zložito. teda cez makro. Comand "_osnap" "off"... Viem že sa to dá robiť cez setvar getvar. No neviem kde a ako mám prísť k tým príkazom poznám nejaké "to" cmdecho ale to je všetko.

_Osnap. Dejte F1 a hledejte. _Osnap je příkaz, který ovládá proměnou "osmode". Jakých nabývá hodnot najdete v nápovědě. Pro to nejjednodušší vám ale stačí vědět toto:

(setq old_osmode (getvar "OSMODE")) ; na začátku programu uložíte starou hodnotu

(setvar "OSMODE" 0) ; vypnete uchop

(setvar "OSMODE" old_osmode) ; na konci programu a v error funkci obnovíte starou hodnotu 





Upravil johny - 15.říj.2014 v 20:27
Zpět nahoru
johny Zobrazit panel
TOP uživatel
TOP uživatel

Přihlášen: 24.led.2006
Lokalita: ČR (JM)
Používám:
C3D 2022
Stav: Offline
Bodů: 1671
Přímý odkaz na tuto zprávu Zasláno: 15.říj.2014 v 17:22
No a na závěr jsem si nechal toto.. Napsal jsem vám k tomu pár poznámek jak si to můžete opravit. 

Původně odeslal(a) michaelflyer michaelflyer napsal(a):

(while (/=   ;chybně napsaná podmínka. Správně např. (/= LWPOLYLINE "LWPOLYLINE")

(setq LWPOLYLINE (progn ;progn do setq nepatří! Jestli to mělo být pro while, tak ani to nepotřebuje progn. Celý řádek smazat.
(setq ent_s_bodom (entsel "\nVyber polilajnu v bode výstupu:")) ;název bych volil jednodušší
(setq ent_zoznam (entget (car ent_s_bodom))) ;název bych volil jednodušší 

(foreach i ent_zoznam ;foreach je tu nevhodný. Proč? Je to indexované a jen s jedním výskytem v seznamu. (narozdíl od kódu 10 v předchozím případě)... Tedy stačí (assoc 0 ent_zoznam)
(if (eq (car i) 0)
(setq LWPOLYLINE (cdr i))))
(princ LWPOLYLINE))) ;proč tiskout na obrazovku? smazat
(setq LWPOLYLINE_2 "LWPOLYLINE"))) ;proč to ukládat do další proměnné, celé smazat

 

Jinak třeba takto bych to udělal já.

  (while (not (and (setq ensel (entsel "\nSelect polyline: "))

  (eq (cdr (assoc 0 (entget (car ensel))));  

      "LWPOLYLINE")))

    (prompt "\nWrong selection. Try again.")); while

 



Upravil johny - 15.říj.2014 v 19:07
Zpět nahoru
michaelflyer Zobrazit panel
Zasloužilý člen
Zasloužilý člen

Přihlášen: 05.úno.2007
Lokalita: Slovensko
Používám:
AutoCAD
Stav: Offline
Bodů: 105
Přímý odkaz na tuto zprávu Zasláno: 19.pro.2014 v 12:55

Ospravedlňujem  sa za dlhodobú neprítomnosť. Mal som iné starosti.

Vladimír Michl:

Žiaľ, to mi nepomôže. Budem musieť ostať pri „equal“ s nejakou toleranciou ako ste mi poradili na začiatku.

 

Johny:

(while (not (and (setq ensel (entsel "\nSelect polyline: ")) ; – Tak to som netušil, že „and“ sa dá aj takto použiť!                          (eq (cdr (assoc 0 (entget (car ensel))));

                                      "LWPOLYLINE")))  

Ale je to veľmi pekné a elegantné riešenie!

Rozmýšlal som nad tým „OSMODE“. Má jednu nevýhodu – ak spadne program tak uchopovacie body sú vynulované a tak ostáva na užívateľovi aby si ich zase pozapínal... Mám preto lepšie riešenie ktoré som našiel:

 (defun osnap-off ()

 (setvar "osmode" (logior (getvar "osmode") 16384))

 )

 

(defun osnap-on ()

 (setvar "osmode" (logand (getvar "osmode") (~ 16384)))

 )

Ak aj spadne tak užívateľ stlačí klávesu F3 a nemusí prácne všetko zapínať (každý snap)...

 

Ďakujem Vám obom za rady a poučenie.

 

Neviem či mám zakladať novú tému, ale hodím to sem:

Toto je program, ktorý zrotuje podľa referenčného bodu a je tam aj možnosť „copy“ – či chceš kopírovať a zároveň rotovať objekt. Celkom dobrá vec ale viac ako 1x coyp sa nedá zrealizovať. Vysvetlím nižšie...

 

(defun c:rot (/ objekt m0)

  (prompt "\nVyber objekt na rotovanie:")

  (setq objekt (ssget))

  (initget 1 "Copy")

  (setq m0 (getpoint "\nVyber dva body! [Copy]?:"))

  (if (= m0 "Copy")

    (progn

      (command "_copy" objekt "" "0,0,0" "")

      (setq objekt nil)

      (setq objekt (ssget "_P"))

      (setq m0 (getpoint "\nVyber dva body!"))

    )

  )

  (command "_ROTATE" objekt "" m0 "_R" m0 pause pause)

)

  

Akonáhle implementujem „while“ (setq objekt (ssget "_P")) – nedokáže vybrať posledné objekty. A stým (ssget "_P") mám stále problémy! Aj keď dám niekolko objektov skopírovať a chcem aby mi ich vybralo pomocou  (ssget "_P") vyberie mi iba pár objektov. Ako by sa to dalo obýsť. Nefunguje niečo ako (ssget „_L“) napríklad podľa počtu posledných nakreslených objektov? Alebo niečo podobné?

 

 



Upravil michaelflyer - 19.pro.2014 v 12:58
Michal MUCHA
Zpět nahoru
johny Zobrazit panel
TOP uživatel
TOP uživatel

Přihlášen: 24.led.2006
Lokalita: ČR (JM)
Používám:
C3D 2022
Stav: Offline
Bodů: 1671
Přímý odkaz na tuto zprávu Zasláno: 19.pro.2014 v 14:06
Původně odeslal(a) michaelflyer michaelflyer napsal(a):

Rozmýšlal som nad tým „OSMODE“. Má jednu nevýhodu – ak spadne program tak uchopovacie body sú vynulované a tak ostáva na užívateľovi aby si ich zase pozapínal... Mám preto lepšie riešenie ktoré som našiel:

 (defun osnap-off ()

 (setvar "osmode" (logior (getvar "osmode") 16384))

 )

 

(defun osnap-on ()

 (setvar "osmode" (logand (getvar "osmode") (~ 16384)))

 )

Ak aj spadne tak užívateľ stlačí klávesu F3 a nemusí prácne všetko zapínať (každý snap)...


Psal jsem Vám, že si to musíte v error funkci hlídat. A to platí ať to uděláte tak, či onak. Povypínané proměnné musíte při erroru znovu ponahazovat.

(defun c:VasProgram ()

(defun *error* (errmsg) ; *error* funkce se spustí pri jakekoliv chybe
    (if (not (wcmatch errmsg "Function cancelled, quit / exit abort, console break"))
      (princ (strcat "\nError: " errmsg)))
  (setvar "OSMODE" old_osmode) ;podle mého
  (osnap-on) ;podle vašeho.. + doplnit o podmínku na stav před spuštěním
    (princ)
 ); end *error*

(prikazy VasehoProgramu)
);konec VasehoProgramu

A ještě k tomu vašemu.. Ano, jako přepínač je to pěkné a taky to používám, ale napsal jsem vám to jednodušší, páč u tohoto vašeho je třeba hlídat, abyste svým programem nezapnul OSNAP i tehdá, když ho sám uživatel měl před spuštěním vašeho programu vypnutý.


Upravil johny - 19.pro.2014 v 16:46
Zpět nahoru
johny Zobrazit panel
TOP uživatel
TOP uživatel

Přihlášen: 24.led.2006
Lokalita: ČR (JM)
Používám:
C3D 2022
Stav: Offline
Bodů: 1671
Přímý odkaz na tuto zprávu Zasláno: 19.pro.2014 v 14:16
Původně odeslal(a) michaelflyer michaelflyer napsal(a):

 A stým (ssget "_P") mám stále problémy! Aj keď dám niekolko objektov skopírovať a chcem aby mi ich vybralo pomocou  (ssget "_P") vyberie mi iba pár objektov. Ako by sa to dalo obýsť. Nefunguje niečo ako (ssget „_L“) napríklad podľa počtu posledných nakreslených objektov? Alebo niečo podobné? 


Můj oblíbený link na all-about-ssget

http://www.lee-mac.com/ssget.html
Zpět nahoru
johny Zobrazit panel
TOP uživatel
TOP uživatel

Přihlášen: 24.led.2006
Lokalita: ČR (JM)
Používám:
C3D 2022
Stav: Offline
Bodů: 1671
Přímý odkaz na tuto zprávu Zasláno: 19.pro.2014 v 14:25
Původně odeslal(a) michaelflyer michaelflyer napsal(a):

Toto je program, ktorý zrotuje podľa referenčného bodu a je tam aj možnosť „copy“ – či chceš kopírovať a zároveň rotovať objekt. Celkom dobrá vec ale viac ako 1x coyp sa nedá zrealizovať. Vysvetlím nižšie...

 

(defun c:rot (/ objekt m0)

  (prompt "\nVyber objekt na rotovanie:")

  (setq objekt (ssget))

  (initget 1 "Copy")

  (setq m0 (getpoint "\nVyber dva body! [Copy]?:"))

  (if (= m0 "Copy")

    (progn

      (command "_copy" objekt "" "0,0,0" "")

      (setq objekt nil)

      (setq objekt (ssget "_P"))

      (setq m0 (getpoint "\nVyber dva body!"))

    )

  )

  (command "_ROTATE" objekt "" m0 "_R" m0 pause pause)

)


Taky mám svůj program na referenční otáčení - a velmi velmi oblíbený:

(defun C:O() ;Otoc-tremi-body
  (command "_select" pause)
  (command "_rotate" "_p" "" pause "_r" "@" pause pause)
  (princ)
)

Pak mám i druhý, který používám... no když, tak jednou za rok (=k ničemu).. 

(defun C:Ok() ;Otoc-a-zkopiruj-tremi-body
  (command "_select" pause)
  (command "_rotate" "_p" "" pause "_c" "_r" "@" pause pause)
  (princ)
)


Upravil johny - 19.pro.2014 v 15:11
Zpět nahoru
michaelflyer Zobrazit panel
Zasloužilý člen
Zasloužilý člen

Přihlášen: 05.úno.2007
Lokalita: Slovensko
Používám:
AutoCAD
Stav: Offline
Bodů: 105
Přímý odkaz na tuto zprávu Zasláno: 22.pro.2014 v 10:30
Původně odeslal(a) johny johny napsal(a):

Původně odeslal(a) michaelflyer michaelflyer napsal(a):

Toto je program, ktorý zrotuje podľa referenčného bodu a je tam aj možnosť „copy“ – či chceš kopírovať a zároveň rotovať objekt. Celkom dobrá vec ale viac ako 1x coyp sa nedá zrealizovať. Vysvetlím nižšie...

 

(defun c:rot (/ objekt m0)

  (prompt "\nVyber objekt na rotovanie:")

  (setq objekt (ssget))

  (initget 1 "Copy")

  (setq m0 (getpoint "\nVyber dva body! [Copy]?:"))

  (if (= m0 "Copy")

    (progn

      (command "_copy" objekt "" "0,0,0" "")

      (setq objekt nil)

      (setq objekt (ssget "_P"))

      (setq m0 (getpoint "\nVyber dva body!"))

    )

  )

  (command "_ROTATE" objekt "" m0 "_R" m0 pause pause)

)


Taky mám svůj program na referenční otáčení - a velmi velmi oblíbený:

(defun C:O() ;Otoc-tremi-body
  (command "_select" pause)
  (command "_rotate" "_p" "" pause "_r" "@" pause pause)
  (princ)
)

Pak mám i druhý, který používám... no když, tak jednou za rok (=k ničemu).. 

(defun C:Ok() ;Otoc-a-zkopiruj-tremi-body
  (command "_select" pause)
  (command "_rotate" "_p" "" pause "_c" "_r" "@" pause pause)
  (princ)
)


Ďakumem za ten *error* už to torošku lepšie chápem... Aj keď stále mi vrtá hlavou ako lisp vie, že má toto použiť, keď sa program preruší pomocou klávesy "Esc"? 

  (command "_rotate" "_p" "" pause "_c" "_r" "@" pause pause)- Ja frčím ešte stále na Acad 2000 a takéto zlepšováky si musím doprogramovať. Takže sa stále musím vrátiť k (ssget "_P") - problém je ale v tom, že aj tie príklady čo ste mi na ne poslal odkaz, neriešia to čo by som potreboval. Neviem či to je autocadom2000, alebo nezle napísaného programu... Stačí že urobím túto smičku a už to nefunguje:

 

(setq m0 T)
(if (= m0 "Copy")
(progn
(while m0
(command "_copy" objekt "" "0,0,0" "")
(setq objekt nil)
(setq objekt (ssget "_P"))
(setq m0 (getpoint "\nVyber dva body!"))
(command "_ROTATE" objekt "" m0 "_R" m0 pause pause)
)
)
)   

Michal MUCHA
Zpět nahoru
johny Zobrazit panel
TOP uživatel
TOP uživatel

Přihlášen: 24.led.2006
Lokalita: ČR (JM)
Používám:
C3D 2022
Stav: Offline
Bodů: 1671
Přímý odkaz na tuto zprávu Zasláno: 22.pro.2014 v 19:42
Problémem asi nebude ssget.. viz poznámky v kódu.

(setq m0 T)
(if (= m0 "Copy") ;V předchozím řádku jste do m0 vložil True, jak KDY může nastat tato podmínka??
(progn ;progn nemusí být, když bude následovat jediný příkaz (while...)
(while m0 ;klidně bych dal podmínku (while (= m0 "Copy") a zrušil předchozí 2 řádky...) 
(command "_copy" objekt "" "0,0,0" ""); dál nezkoumáno.
(setq objekt nil)
(setq objekt (ssget "_P"))
(setq m0 (getpoint "\nVyber dva body!"))
(command "_ROTATE" objekt "" m0 "_R" m0 pause pause)
)
)
Zpět nahoru
johny Zobrazit panel
TOP uživatel
TOP uživatel

Přihlášen: 24.led.2006
Lokalita: ČR (JM)
Používám:
C3D 2022
Stav: Offline
Bodů: 1671
Přímý odkaz na tuto zprávu Zasláno: 22.pro.2014 v 19:54
Původně odeslal(a) michaelflyer michaelflyer napsal(a):

 ... Aj keď stále mi vrtá hlavou ako lisp vie, že má toto použiť, keď sa program preruší pomocou klávesy "Esc"?

...lebo to niekto múdry tak naprogramoval ;-)

PS. je důležité aby to bylo právě *error*, ne třeba jen (defun error () ...)
Více: http://www.lee-mac.com/errorhandling.html
Zpět nahoru

Pro technickou podporu CAD
kontaktujte Helpdesk

Příbuzné CAD tipy:
Tip 2025:Jaké jsou výhody a nevýhody e-Plot formátu DWF oproti PDF?


 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,782 sekund.