Copyright © 2004-2022 SQL: 0.99 saniye - Sorgu: 64 - Ortalama: 0.01546 saniye
 |
 |
 |
 |
|
|
|
|
04.07.2010 12:41
zinquer 
|
|
Arkadaşlar öncelikler hepinize merhaba... Çalışmalarımdan dolayı bana gerekli olan bir lisp arıyorum...
İhityacım olan lisp şu şekilde : Çizmiş olduğum çizgilerin uçlarının boşta olup olmadığını kontrol edecek bir lispe ihtiyacım var. peş peşe çizilmiş linelerın hepsinin birbiri ile başlangıç ve bitiş noktalarının bağlantılı olup olmadığını kontrol etmesini istiyorum.... yardımlarınız için teşk...
|
|
05.07.2010 19:46
 ProhibiT
|
|
Öncelikle uçlarının bağlantılı olup olmadığını kontrol edeceğimiz Line objeleri seçilir.
(ssget "x" (list (cons 0 "LINE") (cons 8 "Deneme"))) burada örnek olarak, "Deneme" Layer'ındaki bütün Line Objelerini seçimini verdim. Bundan sonra seçim setindeki bütün objeleri teker teker ele alarak, bir While Loop içinde Seçim setindeki diğer Line Objeleri ile intersection'u olup olmadığı kontrol edilir. Her bir Line Objesinin Başlangıç noktası (assoc 10... ve bitiş noktaları (assoc 11... alınarak, pivot objenin uç koordinatlarına p1 ve p2 referans objenin uç koordinatlarına p3 ve p4 dersek; (inters p1 p2 p3 p4 T) komutu ile gerçek (True) intersection'u olup olmadığı kontrol edilir. Komutun sonundaki T önemli, aksi halde yanlışlıkla nil alırsa uzantılarının kesişim noktaları bulunur. Eğer herhangi bir doğru ile intersection'u (teması) var ise, bu temas noktasının ilgili doğrunun uç noktalarında olup olmadığı kontrol edilmelidir. Aksi halde ortasından kesişen doğrular da işleme alınmış olurlar. (inters... komutundan dönen intersection koordinatları işleme alınan ikinci doğrunun uç noktalarından biriyle aynı ise, bu iki doğru uç uca temas halindedir. Burada dikkat edilmesi gereken bir konu da; (inters... komutu 3D yani x, y ve z olarak döneceğinden, çizgilerimizin düzlemde mi? yoksa uzayda mı? kapalı olup olmadıkalrının kontrol edilmek istendiği burada önem kazanır. Eğer izdüşüm düzleminde işlem yapıyorsan, bir şekilde çizgilerimiz de 3D ise ilk 2 koordinat parametresi ile yani x ve y ile kontroller yapılmalıdır. Sorunuzu öyle sormuşsunuz ki; problemin çoğunu çözmüş yazmışsınız, bu noktada bir trick ihtiyacı duyuyorsunuz şeklinde anlıyorum. Eğer anladığım doğruysa, yukarıda yazdıklarım probleminizin çözümüdür. Eğer pati çekiyorsanız, burada verdiğiniz ipuçları ile zaten bir şeyler yazmak mümkün olmaz. Mümkün olsa bile, kim neden böyle bir şey yazmakla uğraşsın ki? Herkese Kolay Gelsin...
|
|
05.07.2010 20:06
zinquer
|
|
ilginden dolayı çok teşekkür ederim...
line ile yapmış olduğum çizimler x,y,z kordinatlarında oluşturulmuş şekillerdir.. anlattıkların çözüm için doğru olabilir ama çözümü nasıl uygulayacağımı anlayamadım... bunu bir lisp şeklinde oluşturmamız mümkün olabilrmi ?
|
|
07.07.2010 00:04
ProhibiT
|
|
Aşağıdaki AutoLisp fonksiyon işinizi görecektir.
Fonksiyonu çalıştırdıktan sonra, uçlarının açık olup olmadığını kontrol edeceğiniz tüm çizgileri seçin. Uçları açık olan çizgiler Highligt edilerek görmeniz sağlanacaktır. Regen işlemi gerçekleşinceye kadar objeler highlight konumda kalacaklardır. Kod: (defun c:cu ()
(setvar "modemacro" "M. Şahin Güvercin") (setq Lines (ssget (list (cons 0 "LINE"))) l (sslength Lines) m -1 intrs nil) (while (< (setq m (1+ m)) l) (setq pivot (ssname Lines m) n m p1 (cdr (assoc 10 (entget pivot))) p2 (cdr (assoc 11 (entget pivot)))) (while (< (setq n (1+ n)) l) (setq srdk (ssname Lines n) p3 (cdr (assoc 10 (entget srdk))) p4 (cdr (assoc 11 (entget srdk))) intr (inters p1 p2 p3 p4 T)) (if intr (setq intrs (cons intr intrs))))) (setq m -1 n (length intrs)) (while (< (setq m (1+ m)) l) (setq pivot (ssname Lines m) o -1 int1 nil int2 nil p1 (cdr (assoc 10 (entget pivot))) p2 (cdr (assoc 11 (entget pivot)))) (while (< (setq o (1+ o)) n) (if (= (atof (rtos (distance (nth o intrs) p1) 2 2)) 0) (setq int1 T)) (if (= (atof (rtos (distance (nth o intrs) p2) 2 2)) 0) (setq int2 T))) (if (= int1 nil) (redraw pivot 3)) (if (= int2 nil) (redraw pivot 3))) (setvar "modemacro" "") (prin1) ) ProhibiT (07.07.2010 17:18 GMT) |
|
07.07.2010 16:46
zinquer
|
|
yardımların için çok teşekkürler... :)
süper.... denedim çok güzel çalışıyor... buna şu şekilde bir düzenleme yapmamız mümkünmü... yalnız hassasiteyinde bir sorun var sanırım. çizgi ucu ile bir endpoint arasındaki mesafe 0.000001 olduğu zaman çizgiyi sanki kenetlenmiş gibi algılıyor... birde kenetlenmemiş çizgi rengini otomatik olarak sarı renge çevirebilrimi.. ? zinquer (07.07.2010 17:24 GMT) |
|
07.07.2010 17:30
ProhibiT
|
|
Rica ederim, işinize yaramasına sevindim.
Sorularınızı ne kadar net ve açık sorarsanız, o kadar sağlıklı ve seri cevap alacağınızı bilmenizi isterim. Konuyu ilk açtığınızda sorunuz net anlaşılamadığı için, algoritma ve yöntem konusunda ipucları vermiştim. İlgilenen arkadaşlar için fonksiyonun çalışma mantığını kısaca açıklamak gerekirse; - Seçilen Line objeleri teker teker ele alınarak, diğerleriyle reel intersection noktaları olup olmadığı kontrol edilir. - Bulunan intersection noktaları bir listeye eklenir. - Seçim setindeki her bir Line objesi teker teker ele alınarak, her bir uç noktasının intersection listesinde yer alıp almadığı kontrol edilir. - Line objesinin iki ucundan biri ya da her ikisi bu intersection listesinde yok ise bu Line'ın en az bir ucu boşta demektir. Bu durum ilgili obje highlight edilerek belirtilir. Herkese Kolay gelsin... ProhibiT (18.07.2010 20:02 GMT) |
|
21.07.2010 18:55
zinquer
|
|
merhaba...
lisp hakkında bir revizyon istemiştim... yapabilirmisiniz acaba ?
|
|
ProhibiT
|
|
Değişiklik isteklerinizi düzenleme ile eklediğiniz için geç gördüm. Fonksiyonu isteğinize uygun olarak değiştirdim;
Kod: (defun c:cu () Kolay Gelsin...
(setvar "modemacro" "M. Şahin Güvercin") (setq Lines (ssget (list (cons 0 "LINE"))) l (sslength Lines) m -1 intrs nil) (while (< (setq m (1+ m)) l) (setq pivot (ssname Lines m) n m p1 (cdr (assoc 10 (entget pivot))) p2 (cdr (assoc 11 (entget pivot)))) (while (< (setq n (1+ n)) l) (setq srdk (ssname Lines n) p3 (cdr (assoc 10 (entget srdk))) p4 (cdr (assoc 11 (entget srdk))) intr (inters p1 p2 p3 p4 T)) (if intr (setq intrs (cons intr intrs))))) (setq m -1 n (length intrs)) (while (< (setq m (1+ m)) l) (setq pivot (ssname Lines m) o -1 int1 nil int2 nil acik nil p1 (cdr (assoc 10 (entget pivot))) p2 (cdr (assoc 11 (entget pivot)))) (while (< (setq o (1+ o)) n) (if (= (atof (rtos (distance (nth o intrs) p1) 2 8)) 0.00000000) (setq int1 T)) (if (= (atof (rtos (distance (nth o intrs) p2) 2 8)) 0.00000000) (setq int2 T))) (if (or (= int1 nil) (= int2 nil)) (command "change" pivot "" "p" "c" "2" ""))) (setvar "modemacro" "") (prin1) )
|