Sonraki Sayfa
Copyright © 2004-2022 SQL: 3.566 saniye - Sorgu: 98 - Ortalama: 0.03639 saniye
 |
 |
 |
 |
|
|
|
|
05.05.2014 22:53
 ProhibiT
|
|
ibrahimdeniz arkadaşımızın bir isteği olmuştu.
_________________________________________ Bana şöyle bir lisp lazım Polyline (polyline kapalı olmak zorunda değil, başlangıç ve bitiş noktası olması yeterli, kırık kırık şeklinde de olmasa olur) ile kesişen objelerin kesişim noktalarında, polyline ı kestikleri noktadan bahse konu polyline a vertex atan bir lisp... Lisp çalıştırıldığında polyline ı seçtirecek ve polyline ı kesen ne kadar obje varsa çizim içerisinde tarayacak tarama sonlandığında polyline ile objelerin kesişim noktalarından bahse konu polyline a vertex atacak ve komut sonlanacak.. Bu şekilde bir lisp mümkün müdür ? _________________________________________ Söz vermiş olmama rağmen uzunca zamandır vakit bulamadığım LISP fonksiyonu ancak yazabildim. Özellikle yazar arkadaşların ilgisini çekebilir düşüncesiyle burada paylaşmak istedim. Kod: ;|===========================================================================| | AdVx: Seçilen Polyline nesnesinin diğer çizim nesneleriyle kesiştiği | | noktalarında yeni Vertex'ler oluşturulur. işleme alınan Polyline | | nesnesi içinde Arc türü segmentler olduğunda hatalı sonuç verir. | | Hazırlayan: M. Şahin Güvercin www.cizimokulu.com 08.05.2014 | |===========================================================================|; (defun C:AdVx (/ BsLMsf intPoints KesNes m n NewVrtX olderr PLPoints VrtX) (defun myerr (errmsg) (if (/= errmsg "\nFunction cancelled") (prompt (strcat "\n" errmsg))) (command "._undo" "_e") (command "._U") (setq *error* olderr) (princ)) (setvar "cmdecho" 0) (command "undo" "group") (vl-load-com) (setq olderr *error* *error* myerr) (*push-error-using-command*) (princ "\nİşleme alınacak Polyline nesnesini seçiniz: ") (while (not (setq PLineObj (ssget "+.:s" (list (cons 0 "LwPolyLine")))))) (setq KesNes (ssdel (ssname PLineObj 0) (ssget "x" (list (cons 0 "*Line,Arc,Circle,Ellipse")))) PLineObj (vlax-ename->vla-object (ssname PLineObj 0)) PLPoints (vlax-safearray->list (vlax-variant-value (vlax-get-property PLineObj 'Coordinates))) m -1 n -2 VrtX nil) (while (< (setq n (+ n 2)) (length PLPoints)) (if VrtX (setq VrtX (append VrtX (list (list (nth n PLPoints) (nth (1+ n) PLPoints))))) (setq VrtX (list (list (nth n PLPoints) (nth (1+ n) PLPoints)))))) (while (< (setq m (1+ m)) (sslength KesNes)) (if (not (minusp (vlax-safearray-get-u-bound (setq intPoints (vlax-variant-value (vla-intersectwith (vlax-ename->vla-object (ssname KesNes m)) PLineObj 0))) 1))) (progn (setq intPoints (vlax-safearray->list intPoints) n -3) (while (< (setq n (+ n 3)) (length intPoints)) (setq VrtX (append VrtX (list (list (nth n intPoints) (nth (1+ n) intPoints))))))))) (setq n -1) (while (< (setq n (1+ n)) (length VrtX)) (setq VrtX (append (list (nth n VrtX)) (vl-remove (nth n VrtX) VrtX)))) (setq BsLMsf (mapcar'(lambda (e)(vlax-curve-getDistAtPoint PLineObj e)) VrtX) VrtX (mapcar'(lambda (e)(nth e VrtX))(vl-sort-i BsLMsf '<))) (setq n -1 NewVrtX nil) (while (< (setq n (1+ n)) (length VrtX)) (if NewVrtX (setq NewVrtX (append NewVrtX (list (car (nth n VrtX))) (list (cadr (nth n VrtX))))) (setq NewVrtX (append (list (car (nth n VrtX))) (list (cadr (nth n VrtX))))))) (setq VrtX (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length NewVrtX)))) n -1) (while (< (setq n (1+ n)) (length NewVrtX)) (vlax-safearray-put-element VrtX n (nth n NewVrtX))) (setq VrtX (vlax-make-variant VrtX) PLineObj (entget (vlax-vla-object->ename PLineObj)) PLineObJ (subst (cons 90 (/ (length NewVrtX) 2)) (assoc 90 PLineObj) PLineObj) PLineObj (entmod PLineObj) PLineObj (vlax-ename->vla-object (entupd (cdr (assoc -1 PLineObj))))) (vlax-put-property PLineObj 'Coordinates VrtX) (command "_.undo" "end") (setq *error* olderr) (*pop-error-mode*) (prin1)) Yazar arkadaşlarımız için algoritma ve kodların temel adımlarını açıklayalım: - İşleme alınacak Polyline seçilir. (ssget "+.:s" ... ifadesine dikkat ediniz. Bu şekilde seçim yapılırken boş bir yere tıklandığında window yada crossing penceresi açılmaz. Tıpkı entsel işleviyle olduğu gibi seçim yapılabilir. - Çizim içinde bulunan tüm Line, Polyline, Lwpolyline, Arc, Circle ve Ellipse nesneleri seçilerek, KesNes isimli seçimseti oluşturulur. İşleme alınacak Polyline nesnesi bu seçim setinden çıkarılır. - Seçilen Polyline nesnesinin Coordinates listesi elde edilerek, koordinat çiftlerinden (x,y) oluşan VrtX nokta koordinat listesi oluşturulur. - İşleme alınan Polyline nesnesi ile KesNes seçim setindeki nesnelerin kesiştikleri noktalar bulunarak VrtX nokta koordinat listesine eklenir. - Polyline'ı tam köşe noktasında kesen bir nesne olduğunda, köşe noktasının koordinatları VrtX listesinde 2 defa yer alacağından, VrtX listesinde birden fazla tekrarlanan nokta koordinatları ayıklanır. - VrtX listesindeki her bir noktanın Polyline başlangıcına mesafeleri bulunarak aynı sıra ile BsLMsf listesi oluşturulur. - BsLMsf listesi başlangıca en yakından uzağa doğru sıralandığında elde edilen listenin sıra numaraları elde edilerek, bu sıra numalaralarına göre VrtX listesindeki noktalar başlangıca mesafesi en küçük olandan en büyük olana doğru sıralanır. Bu sıralama işleminde vl-sort-i işlevi kullanılmıştır. - VrtX listesinden tek boyutlu bir dizi olan NewVrtX listesi oluşturulur. - lower bound değeri 0, upper bound değeri NewVrtX listesinin eleman sayısı olan tek boyutlu safearray oluşturulur ve NewVrtX listesinin elemanları bu safearray'e yerleştirilir. - Oluşturulan safearray (vlax-make-variant ... işlevi ile variant'a çevrilir. - Polyline nesnesinin ilişilendirilmiş listesinde (association list) Vertex (köşe) sayısı yeni Vertex sayısı ile değiştirilir. (assoc 90 ... - Oluşturulan variant türündeki yeni vertex listesi, vlax-put-property işlevi ile işleme alınan Polyline nesnesine eklenerek güncellenir. ProhibiT (08.05.2014 17:45 GMT) |
|
06.05.2014 06:18
ibrahimdeniz
|
|
Prohibit Hocam emeğinize elinize ilginize sağlık ve bu kadar hızlı dönüş yaptığınız için teşekkür ederim
|
|
06.05.2014 06:28
 Travaci
|
|
Güzel bir örnek, teşekkürler :yes
|
|
06.05.2014 06:53
ProhibiT
|
|
Rica ederim ibrahimdeniz, hızlı dönüş yapmaktan bahsederken nezaket göstermişsiniz, son hatırlatmanızdan sonra bile bir haftaya yakın zaman geçti. :)
Travaci senin ilgini çekebileceğini düşündüğüm bir detay var. Yeni Vertex listesini oluşturup, safearray ve variant'a çevirdikten sonra, (vlax-put-property POLYLINE 'Coordinates YENIVERTEX) şeklinde nesnenin veri tabanına eklemeye çalışınca, POLYLINE nesnesinin tanımında yer alan VERTEX sayısı ile YENIVERTEX nokta sayısı farklı olduğundan, ActiveX Automation error... türü bir hata ile karşılaşılır. İlişkilendirilmiş Liste'de (association list) 90 anahtar kodlu Vertex sayısı entmod ile değiştirildikten sonra vlax-put-property uygulanabilir.
|
|
06.05.2014 07:19
Travaci
|
|
:yes
|
|
06.05.2014 12:02
ibrahimdeniz
|
|
Prohibit Hocam selamlar..
Birbirine yakın disiplinlerde iş yapıyoruz hatta aynı sektördeyiz.. Siz de muhakkak karşılaşmışsınızdır, etüdü verip ertesi gün uygulamasını ertesi gün tüm renderlarını metrajlarını vs. vs . isteyen müşterilerimiz olmuştur.. Bütün işleri sanki biz değilde pc de bir tuş hallediyormuş gibi tavırlara maruz kalmışızdır.. Demem o ki yaptığınız iş gerçekten saygı duyduğum bir iş ve her iş zaman ve konsantrasyon ister sizin için bir hafta uzun olabilir ama ben sizi epeydir takip ediyorum bir hafta benim için hızlı bir dönüş oldu :) belkide iş yoğunluğunuzdan hiç ilgilenemeyeceğiniz bir konu olacaktı işin bu boyutu da var hocam.. İlginize ve yardımlarınıza tekrar teşekkür ederim.. Görüşmek üzere..
|
|
07.05.2014 14:32
ibrahimdeniz
|
|
Prohibit Hocam selamlar..
Lisp ile ilgili bir sorum olacaktı... Yeni bir dosyada bir kaç xline çizdim bu xline ları kesen bir polyline çizip lisp i çalıştırdım sonuç, lisp düzgün bir şekilde çalışıyor.. fakat yoğun bir çizim içersinde aynı şekilde bir kaç objeyi(line ,polyline ,xline objelerini denedim) kesen bir polyline a uyguladığımda lisp 'geçersiz dizin' uyarısı verip komutu sonlandırıyor.. Bu uyarıyı vermesinin sebebi nedir ? Şimdiden teşekkür ederim..
|
|
07.05.2014 14:54
ProhibiT
|
|
Kodlarda da görüldüğü gibi (cons 0 "*Line,Arc,Circle,Ellipse")), Line, Polyline, Lwpolyline, Spline, Xline, Arc, Circle, Ellipse türü nesneleri kesen nesneler olarak alıyoruz. Bahsettiğiniz hatanın nereden kaynaklandığını anlamadım. Bununla birlikte tahmin yürütürsek, İşleme alınan ve bu nesne ile kesişimleri aranan nesneler farklı düzlemlerde iseler, yani planda izdüşümleri kesişir gibi görünmekle birlikte, 3. boyutta gerçek anlamda kesişimleri olmayan nesneler ise intPoints değişkenine bir nokta listesi aktarılmayacağından boş bir dizin VrtX dizinine eklenmeye çalışılıyor ve bu hata ortaya çıkıyor olabilir. Fonksiyonu yazarken her durumda tüm çizim nesnelerinin tek bir düzlemde olacağı gibi bir peşin hükümle yola çıktığım için intersection point var mı, yok mu? diye kontrol koyma gereği duymadım. Hatanın olası kaynaklarına bir bakalım, bir çözüm üretiriz sonuçta. :)
|
|
07.05.2014 15:16
ibrahimdeniz
|
|
Sağolasınız Hocam.. Bahsettiğiniz 3. boyut durumunu bende kontrol ettim tüm objelerin z değerleri 0 hatta daha basit olsun diye 1 line çizip 500 birim offsetledim 3 kopyasını oluşturdum bunları kesen birde polyline çizdim lisp yine geçersiz dizin uyarısı verdi.. fakat boş bir dosyada bu işlemi yapınca lisp çalışıyor, yoğun bir çizimde geçersiz dizin uyarısı veriyor
|
|
07.05.2014 18:50
Travaci
|
|
Şahin hocam bu error trapping de bir iş var ama anlamadım, evdeki pc de yine geçenki gibi
no function definition: *PUSH-ERROR-USING-COMMAND* hatasını alıyorum :dozingoff
|
|
08.05.2014 08:24
ProhibiT
|
|
Travaci senin de ifade ettiğin gibi, bir iş var ama error trap'te değil de senin evdeki bilgisayarında olabilir mi bu iş. Başka bir Lisple ilgili geçen gün bu konu gündeme geldiğinde, her türlü test ettim, acaba compile edilmiş (-.fas veya -.vlx gibi) dosyalarda mı problem oluyor diye araştırdım. Bir problem bulamadım.
|
|
08.05.2014 09:02
Travaci
|
|
Formattan sonra anlıcaz artık :)
Hocam lispi bende boş bir dosya açıp bir rectangle çizip üzerine birkaç line çiziyorum vertexleri atıyor. İkinci rectangle de ise "ActiveX Server returned an error: Geçersiz dizin" uyarısını alıyorum
|
|
08.05.2014 12:34
ibrahimdeniz
|
|
Şahin Hocam selamlar..
Bahsettiğiniz şekilde EN haliyle de denedim yine aynı uyarı veriyor ama zaten TR de boş bir sayfada hata vermemişti.. Hata TR yada EN olmasından değil bence.. Görüşmek üzere..
|
|
08.05.2014 13:39
 ehya
|
|
Şahin hocam lisp'deki sorun şudur.
Ana nesne seçildikten sonra dosyadaki tüm nesneler otomatik seçiliyor. Bu seçimden sonra seçilen nesneye temas etmeyen nesne var ise ActiveX Server hatası veriyor. Sorunlu kod : (/= (type intPoints) vlax-vbEmpty)
|
|
08.05.2014 17:51
ProhibiT
|
|
Teşekkürler Mehmet hocam, tam isabet :) :yes
Daha önce defalarca yazdığım şekilde değil başka şekilde yazmışım. safearray'in boş olup olmadığını (intersection olup olmadığını) daha önceleri upper bound'un sıfırdan küçük olmaması şartıyla kontrol ederken, bu sefer vlax-vbEmpty şeklinde kontrol edince hata oluşuyor(muş). ibrahimdeniz arkadaşımız düzeltilmiş kodları yeniden indirip problemsiz kullanabilir.
|
|
09.05.2014 07:19
ibrahimdeniz
|
|
Şahin Hocam teşekkürler şimdi sorunsuz çalışıyor.. Elinize sağlık.. Görüşmek üzere..
|
|
21.04.2015 12:46
ProhibiT
|
|
Kod: ;|===========================================================================| | AdVx: Seçilen Polyline nesnesinin diğer çizim nesneleriyle kesiştiği | | noktalarında yeni Vertex'ler oluşturulur. işleme alınan Polyline | | nesnesi içinde Arc türü segmentler olduğunda hatalı sonuç verir. | | Hazırlayan: M. Şahin Güvercin www.cizimokulu.com 08.05.2014 | | Freeze ve Off Layer'ları işleme almayacak şekilde süzenlendi. | | 20.04.2015 | |===========================================================================|; (defun C:AdVx (/ BsLMsf intPoints KesNes m n NewVrtX olderr PLPoints VrtX) (defun myerr (errmsg) (if (/= errmsg "\nFunction cancelled") (prompt (strcat "\n" errmsg))) (command "._undo" "_e") (command "._U") (setq *error* olderr) (princ)) (setvar "cmdecho" 0) (command "undo" "group") (vl-load-com) (setq olderr *error* *error* myerr) (*push-error-using-command*) (princ "\nİşleme alınacak Polyline nesnesini seçiniz: ") (while (not (setq PLineObj (ssget "+.:s" (list (cons 0 "LwPolyLine")))))) ;;; (setq KesNes (ssdel (ssname PLineObj 0) ;;; (ssget "x" (list (cons 0 "*Line,Arc,Circle,Ellipse")))) ;;; PLineObj (vlax-ename->vla-object (ssname PLineObj 0)) ;;; PLPoints (vlax-safearray->list (vlax-variant-value ;;; (vlax-get-property PLineObj 'Coordinates))) m -1 n -2 VrtX nil) (setq KesNes (ssdel (ssname PLineObj 0) (ssget "C" (getvar "ExtMin") (getvar "ExtMax") (list (cons 0 "*Line,Arc,Circle,Ellipse")))) PLineObj (vlax-ename->vla-object (ssname PLineObj 0)) PLPoints (vlax-safearray->list (vlax-variant-value (vlax-get-property PLineObj 'Coordinates))) m -1 n -2 VrtX nil) (while (< (setq n (+ n 2)) (length PLPoints)) (if VrtX (setq VrtX (append VrtX (list (list (nth n PLPoints) (nth (1+ n) PLPoints))))) (setq VrtX (list (list (nth n PLPoints) (nth (1+ n) PLPoints)))))) (while (< (setq m (1+ m)) (sslength KesNes)) (if (not (minusp (vlax-safearray-get-u-bound (setq intPoints (vlax-variant-value (vla-intersectwith (vlax-ename->vla-object (ssname KesNes m)) PLineObj 0))) 1))) (progn (setq intPoints (vlax-safearray->list intPoints) n -3) (while (< (setq n (+ n 3)) (length intPoints)) (setq VrtX (append VrtX (list (list (nth n intPoints) (nth (1+ n) intPoints))))))))) (setq n -1) (while (< (setq n (1+ n)) (length VrtX)) (setq VrtX (append (list (nth n VrtX)) (vl-remove (nth n VrtX) VrtX)))) (setq BsLMsf (mapcar'(lambda (e)(vlax-curve-getDistAtPoint PLineObj e)) VrtX) VrtX (mapcar'(lambda (e)(nth e VrtX))(vl-sort-i BsLMsf '<))) (setq n -1 NewVrtX nil) (while (< (setq n (1+ n)) (length VrtX)) (if NewVrtX (setq NewVrtX (append NewVrtX (list (car (nth n VrtX))) (list (cadr (nth n VrtX))))) (setq NewVrtX (append (list (car (nth n VrtX))) (list (cadr (nth n VrtX))))))) (setq VrtX (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length NewVrtX)))) n -1) (while (< (setq n (1+ n)) (length NewVrtX)) (vlax-safearray-put-element VrtX n (nth n NewVrtX))) (setq VrtX (vlax-make-variant VrtX) PLineObj (entget (vlax-vla-object->ename PLineObj)) PLineObJ (subst (cons 90 (/ (length NewVrtX) 2)) (assoc 90 PLineObj) PLineObj) PLineObj (entmod PLineObj) PLineObj (vlax-ename->vla-object (entupd (cdr (assoc -1 PLineObj))))) (vlax-put-property PLineObj 'Coordinates VrtX) (command "_.undo" "end") (setq *error* olderr) (*pop-error-mode*) (prin1)) Merhaba ibrahimdeniz :) ssget "x" yerine ssget "c" kullanarak bir çözüm ürettim. Bu durumda Freeze ve Off olan Layer'lardaki nesneler seçilmez. Ama, bir şeye daha dikkat etmek gerek; Lock durumda olan layer'lar seçilir. Kolay gelsin.
|
|
21.04.2015 13:36
ibrahimdeniz
|
|
Sağolasınız hocam bende x yerine "_A" yazmakta buldum çareyi, lisp yazmayı bildiğimden değil..Bir kaç lisp indirip terimlerin ne olduğunu araştırdım _A freeze edilmiş layerları işleme almıyor galiba deyip şansımı denedim oldu..Teşekkür ederim görüşmek dileğiyle..
|
|
27.11.2015 08:15
 poli
|
|
merhaba ProhibiT arkadaşım,
Yazdığın lisp gerçekten güzel ve çok iyi de çalışıyor fakat benim sizden bir ricam var buda kesişen polyline larda bir polylineın diğer polyşin üzerinden arc ile geçecek fakat o arc polyline olacak yani atlayan polyline arc ile bitişik polyline olacak dokununca tek parça olacak bu arada o arc açısınıda girmemize müsade etme imkanı olması yada bir ayar olarak ta olabilir bir kez bir açı ayarı yapılır ve bu devam lı kullanılabilir o sayfada, bu konuda yardımcı olursanız minnettar kalırım yapsanız da yapmasanızda teşekkür ederim iyi çalışmalar...  19901-kesisen-polyline-arc.dwg
|
 alumina
|
|
Sahin Hocam,
Bu kodun yeni bir versiyonunu yazdim, umarim begenirsiniz :) Icerisinde arc turu segmentler olmasina bakilmaksizin, secilen polyline nesneye, secilen diger nesnelerle kesistigi noktalardan yeni vertex'ler eklenir. Kod: (defun c:pvx (/ ps pm pt dc en cl vr cr ns m n bl ds lp ls lk lt pr lz m1) (vl-load-com)
(defun *error* (msg) (if (not (wcmatch (strcase msg t) "*cancel*,*exit*")) (princ (strcat "\nError: " msg))) (if ps (redraw (ssname ps 0) 4)) (setq *error* nil)) (if (setq ps (ssget ":s" '((0 . "lwpolyline")))) (progn (redraw (setq pm (ssname ps 0)) 3) (if (setq pt (ssget)) (progn (vla-startundomark (setq dc (vla-get-activedocument (vlax-get-acad-object)))) (if (ssmemb pm pt) (ssdel pm pt)) (setq en (entget pm) cl (cdr (assoc 70 en)) vr (cdr (assoc 90 en)) cr (mapcar 'cdr (vl-remove-if '(lambda(a) (/= (car a) 10)) en)) ns (vlax-ename->vla-object pm) m -1 n -1) (if (= cl 1) (setq cr (append cr (list (car cr))))) (repeat (if (= cl 1) vr (1- vr)) (setq bl (vla-getBulge ns (setq m (1+ m))) ds (distance (nth m cr) (nth (1+ m) cr)) lp (cons (list m bl (if (= bl 0) 0 (/ (+ (expt (* (/ ds 2) bl) 2) (expt (/ ds 2) 2)) (* ds bl)))) lp))) (repeat vr (setq ls (cons (setq n (1+ n)) ls))) (repeat (setq n (sslength pt)) (setq m -1) (if (not (minusp (vlax-safearray-get-u-bound (setq lk (vlax-variant-value (vla-Intersectwith ns (vlax-ename->vla-object (ssname pt (setq n (1- n)))) 0))) 1))) (repeat (/ (length (setq lt (vlax-safearray->list lk))) 3) (if (not (member (setq pr (vlax-curve-getparamatpoint ns (list (nth (setq m (1+ m)) lt) (nth (setq m (1+ m)) lt) (nth (setq m (1+ m)) lt)))) ls)) (setq ls (cons pr ls)))))) (setq n -1 lz (vl-sort ls '<) ls (apply 'append (mapcar '(lambda(a) (vl-remove (last a) a)) (mapcar '(lambda(a) (vlax-curve-getpointatparam ns a)) (vl-sort ls '<))))) (vla-put-Coordinates ns (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 0 (1- (length ls)))) ls)) (repeat (if (= cl 1) (length lz) (1- (length lz))) (setq m1 (nth (vl-position (fix (nth (setq n (1+ n)) lz)) (mapcar '(lambda(a) (car a)) lp)) lp) dr (distance (vlax-curve-getpointatparam ns n) (vlax-curve-getpointatparam ns (1+ n)))) (vla-setBulge ns n (if (zerop (cadr m1)) 0 (* (if (minusp (cadr m1)) -1 1) (/ (- (abs (caddr m1)) (sqrt (- (expt (caddr m1) 2) (expt (/ dr 2) 2)))) (/ dr 2)))))) (vla-endundomark dc) ) ) (redraw pm 4) ) ) (setq *error* nil) (prin1) )
|