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.

michaelflyer2014-10-05 17:38:11

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) 

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

Nezkoumal jsem přesně logiku kódu, ale na to porovnání raději používejte (equal), možná dokonce: [CODE](setq bod_X_zapis (equal (nth i suradnice_BODOV) BOD_X 0.001))[/CODE]Neměla by být logika testu na bod_X_zapis spíš obráceně, v tomto tvaru? [CODE](if bod_X_zapis (setq suradnice_BODOV (append suradnice_BODOV (list BOD_X))))[/CODE]

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.

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.htmA doporučoval bych vypnout OSNAP... je to vzdycky jistější.

johny2014-10-06 17:46:22

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. [CODE](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")))
[/CODE] 
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.

Jestli vám jde o rozdíl dvou seznamů, pak můžete použít tuto funkci: [CODE](defun ListDiff (list1 list2) (vl-remove-if '(lambda(x) (member x list2)) list1))[/CODE] 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.

[QUOTE=michaelflyer](vlax-curve*) to sa musím doučiť - mysleli ste to na získanie koncových bodov polilajny.[/QUOTE]Ano, mimo jiné. Těch funkcí je ale spousta... např. GetPointAtDistance...[QUOTE=michaelflyer]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.[/QUOTE]_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 


johny2014-10-15 20:27:51

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. [QUOTE=michaelflyer][CODE](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[/CODE] 
[/QUOTE]Jinak třeba takto bych to udělal já.[CODE]  (while (not (and (setq ensel (entsel "\nSelect polyline: "))   (eq (cdr (assoc 0 (entget (car ensel))));         "LWPOLYLINE")))    (prompt "\nWrong selection. Try again.")); while[/CODE] 
johny2014-10-15 19:07:46

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é?

 

 

michaelflyer2014-12-19 12:58:00

[QUOTE=michaelflyer]


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

[/QUOTE]
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 VasehoProgramuA 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ý.

johny2014-12-19 16:46:54

[QUOTE=michaelflyer]


 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é? 

[/QUOTE]
Můj oblíbený link na all-about-ssgethttp://www.lee-mac.com/ssget.html

[QUOTE=michaelflyer]


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)

)

[/QUOTE]
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))
johny2014-12-19 15:11:51

[QUOTE=johny][QUOTE=michaelflyer]


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)

)

[/QUOTE]
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))
[/QUOTE]
Ď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) ) ) )   

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

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

[/QUOTE]
...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