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.

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.

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

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 

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

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

johny napsal(a): 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)
)
)
)