Çoklu Move / Multiple Move | Forumlar

Forum Menüsü

AutoCAD Genel

AutoCAD Eğitimi

3ds Max

Ziyaretçi: 515, Üye: 2
aligumus81, nedimdiri

Detaylar »

Forumlar > AutoLISP > Çoklu Move / Multiple Move

Bu başlığı inceleyenler : 1 ziyaretçi, 0 üye : ---

İleti	Yazar
17.05.2014 20:36 77514	ProhibiT Yetkili 1612 ileti İnşaat Mühendisi Ankara
Merhaba arkadaşlar. Oldukça çok istek gelen Çoklu Move konusunda 2 AutoLISP fonksiyon paylaşıyorum. Parametrik Çizim yapan (Betonarme Çizim yapan programlar gibi) programların ürettikleri çizimleri düzenleme işindeki, örneğin Kiriş Detayları paftalarını düzenlerken karşılaşılan çok sayıda uygulanan sıkıcı Move işlemlerini kolaylaştırmak için kullanılabileceğini sanıyorum. Benzer konuda daha önce paylaşımlarımız oldu mu? Hatırlamıyorum. Birinci fonksiyonumuz MvM istekte bulunan arkadaşlarımızın ihtiyacını karşılar düşüncesindeyim. Kod: ;\|**************************************************************************\| \| MvM: Move Multiple / Çoklu Move \| \| Nesne gurupları seçilerek oluşturulan seçim setlerii, her gurubun \| \| belirlenen noktası referan alınarak imleç konumuna sürüklenerek, \| \| tıklanan noktaya bırakılarak Move işlemi uygulanır. Seçim seti \| \| oluşturulurken guruba nesne ekleme/çıkarma işlemi yapılabilir. \| \| M. Şahin Güvercin (ProhibiT) - www.cizimokulu.com - 17.05.2014 \| \|---------------------------------------------------------------------------\|; (defun c:MvM (/ BsPnT m myerr n NewOb olderr) (setvar "cmdecho" 0) (command "_.undo" "group") (vl-load-com) (defun myerr (errmsg /) (if (/= errmsg "Function cancelled")(prompt errmsg)) (command "._undo" "_e") (command "._U") (setq error* olderr) (princ)) (setq olderr error error myerr) (push-error-using-command) (setq n 1 m 0 BsPnT (append)) (princ "\n1. Seçim Seti: ") (while (setq newOb (ssget)) (set (read (strcat "SecSet" (itoa n))) NewOb) (setq BsPnT (append BsPnT (list (getpoint (strcat "\n" (itoa n) ". Refans Noktası:"))))) (princ (strcat "\n" (itoa (setq n (1+ n))) ". Seçim Seti: "))) (while (< (setq m (1+ m)) n) (command "_.Move" (eval (read (strcat "SecSet" (itoa m)))) "" (nth (1- m) BsPnT) Pause)) (command "_.undo" "end") (setq error olderr) (pop-error-mode) (prin1)) İkinci fonksiyonumuz MMv ise biraz farklı. Yazar arkadaşlarımız için ilginç bir örnek olabileceği ve ilk anda aklımıza gelmeyen ihtiyaçları karşılayabileceği düşüncesiyle yazdım. Kullanımı çok seri ve keyifli geldi bana :) Eksik yönleri, teker teker nesneler seçilmesi ve teker teker yeni yerlerine yerleştirilmesi. Avantajlı tarafı, basepoint sormadan, transformation matrix kullanılarak, nesneler orta noktalarından sürüklenerek istenen yere bırakılması. Nesnelerin yeni yerlerinin belirlenmesi sırasında Object Snap kullanılamaması gibi de bir özelliği var. Kod: ;\|**************************************************************************\| \| MMv: Multiple Move / Çoklu Move \| \| Tekil nesneler seçilerek oluşturulan seçim seti, her bir nesnenin \| \| orta noktası referans alınarak imleç konumuna sürüklenerek, \| \| tıklanan noktaya bırakılarak Move işlemi uygulanır. \| \| Seçim seti oluşturulurken nesne ekleme/çıkarma işlemi yapılabilir. \| \| M. Şahin Güvercin (ProhibiT) - www.cizimokulu.com - 17.05.2014 \| \|---------------------------------------------------------------------------\|; (defun c:MMv (/ BndBx Emax Emin myerr n NEwOb olderr PvOb PvT SeLObToMov) (setvar "cmdecho" 0) (command "_.undo" "group") (vl-load-com) (defun myerr (errmsg /) (if (/= errmsg "Function cancelled") (prompt errmsg)) (command "._undo" "_e") (command "._U") (setq error* olderr) (princ)) (setq olderr error error myerr) (push-error-using-command) (setq SeLObToMov (ssadd) n -1) (princ "\nSelect Object(s) to Move..") (while (setq newOb (ssget "+.:s")) (setq PvT (ssname NewOb 0)) (if (ssmemb PvT SeLObToMov) (progn (redraw PvT 4) (ssdel PvT SeLObToMov)) (progn (redraw PvT 3) (ssadd PvT SeLObToMov)))) (if (< (sslength SeLObToMov) 1) (myerr)) (while (< (setq n (1+ n)) (sslength SeLObToMov)) (setq PvT (ssname SeLObToMov n) PvOb (vlax-ename->vla-object PvT) BndBx (vla-getBoundingBox PvOb 'Emin 'Emax) n1 (mapcar '(lambda (e1 e2) (/ (+ e1 e2) 2)) (vlax-safearray->list Emin) (vlax-safearray->list Emax))) (while (and (/= 3 (car (setq n2 (grread T 4 3)))) (/= (car n2) 25)) (vla-transformby PvOb (vlax-tmatrix (list (list 1 0 0 (- (car (cadr n2)) (car n1))) (list 0 1 0 (- (cadr (cadr n2)) (cadr n1))) (list 0 0 1 (- (caddr (cadr n2)) (caddr n1))) (list 0 0 0 1)))) (setq n1 (cadr n2)))) (command "_.undo" "end") (setq error olderr) (pop-error-mode) (prin1)) Beğenmek için anlamak lazım...

17.05.2014 21:36 77516	Travaci Editör 2394 ileti Teknik Ressam Konstantinopol
Bilgisayarım bozuldu bakamıyorum :con

20.05.2014 13:38 77554	kerem1453 Kıdemli Uzman 111 ileti teknik ressam ankara
PUSH-ERROR-USING-COMMAND sayın hocam lispler böyle bir hata veriyor benden mi kaynaklı yoksa lisptemi sıkıntı var bakma şansınız var mı ?

20.05.2014 14:03 77557	Travaci Editör 2394 ileti Teknik Ressam Konstantinopol
Error trap hatasında yalnız değilmişim :yes

20.05.2014 14:24 77558	kerem1453 Kıdemli Uzman 111 ileti teknik ressam ankara
:))

20.05.2014 14:58 77559	ProhibiT Yetkili 1612 ileti İnşaat Mühendisi Ankara
:) Bende güleyim, eksik kalmasın. :) Bende neden hata vermiyor onu çözemedik. Bir araştıralım... Beğenmek için anlamak lazım...

20.05.2014 15:15 77560	kerem1453 Kıdemli Uzman 111 ileti teknik ressam ankara
prohibit hocam ilk yazdıgınız lisp için şöyle bişey rica etsek taşıdıg objeyi group yapsa bir sonraki taşımalarda o objeyi group olarak rahatca tutma şansı bulsak.(mvm.lsp)

20.05.2014 15:22 77562	ProhibiT Yetkili 1612 ileti İnşaat Mühendisi Ankara
Öncelikle hata yakalama (error trap) yordamlarını başka bir yöntemle yazıp paylaşalım. Group konusuna daha sonra bakarım. Kod: ;\|**************************************************************************\| \| MMv: Multiple Move / Çoklu Move \| \| Tekil nesneler seçilerek oluşturulan seçim seti, her bir nesnenin \| \| orta noktası referans alınarak imleç konumuna sürüklenerek, \| \| tıklanan noktaya bırakılarak Move işlemi uygulanır. \| \| Seçim seti oluşturulurken nesne ekleme/çıkarma işlemi yapılabilir. \| \| M. Şahin Güvercin (ProhibiT) - www.cizimokulu.com - 17.05.2014 \| \|---------------------------------------------------------------------------\|; (defun c:MMv (/ BndBx Emax Emin n NEwOb olderr PvOb PvT SeLObToMov) (setvar "cmdecho" 0) (command "_.undo" "group") (vl-load-com) (defun myerr (errmsg /) (if (/= errmsg "Function cancelled") (prompt errmsg)) (command-s "._undo" "_e") (command-s "._U") (setq error* olderr) (princ)) (setq olderr error error myerr SeLObToMov (ssadd) n -1) (princ "\nSelect Object(s) to Move..") (while (setq newOb (ssget "+.:s")) (setq PvT (ssname NewOb 0)) (if (ssmemb PvT SeLObToMov) (progn (redraw PvT 4) (ssdel PvT SeLObToMov)) (progn (redraw PvT 3) (ssadd PvT SeLObToMov)))) (if (< (sslength SeLObToMov) 1) (myerr)) (while (< (setq n (1+ n)) (sslength SeLObToMov)) (setq PvT (ssname SeLObToMov n) PvOb (vlax-ename->vla-object PvT) BndBx (vla-getBoundingBox PvOb 'Emin 'Emax) n1 (mapcar '(lambda (e1 e2) (/ (+ e1 e2) 2)) (vlax-safearray->list Emin) (vlax-safearray->list Emax))) (while (and (/= 3 (car (setq n2 (grread T 4 3)))) (/= (car n2) 25)) (vla-transformby PvOb (vlax-tmatrix (list (list 1 0 0 (- (car (cadr n2)) (car n1))) (list 0 1 0 (- (cadr (cadr n2)) (cadr n1))) (list 0 0 1 (- (caddr (cadr n2)) (caddr n1))) (list 0 0 0 1)))) (setq n1 (cadr n2)))) (command "_.undo" "end") (setq error olderr) (prin1)) Kod: ;\|**************************************************************************\| \| MvM: Multiple Move / Çoklu Move \| \| Nesne gurupları seçilerek oluşturulan seçim setlerii, her gurubun \| \| belirlenen noktası referan alınarak imleç konumuna sürüklenerek, \| \| tıklanan noktaya bırakılarak Move işlemi uygulanır. Seçim seti \| \| oluşturulurken guruba nesne ekleme/çıkarma işlemi yapılabilir. \| \| M. Şahin Güvercin (ProhibiT) - www.cizimokulu.com - 17.05.2014 \| \|---------------------------------------------------------------------------\|; (defun c:MvM (/ BsPnT m myerr n NewOb olderr) (setvar "cmdecho" 0) (command "_.undo" "group") (vl-load-com) (defun myerr (errmsg /) (if (/= errmsg "Function cancelled")(prompt errmsg)) (command-s "._undo" "_e") (command-s "._U") (setq error* olderr) (princ)) (setq olderr error error myerr n 1 m 0 BsPnT (append)) (princ "\n1. Seçim Seti: ") (while (setq newOb (ssget)) (set (read (strcat "SecSet" (itoa n))) NewOb) (setq BsPnT (append BsPnT (list (getpoint (strcat "\n" (itoa n) ". Refans Noktası:"))))) (princ (strcat "\n" (itoa (setq n (1+ n))) ". Seçim Seti: "))) (while (< (setq m (1+ m)) n) (command "_.Move" (eval (read (strcat "SecSet" (itoa m)))) "" (nth (1- m) BsPnT) Pause)) (command "_.undo" "end") (setq error olderr) (prin1)) Beğenmek için anlamak lazım...

20.05.2014 15:28 77563	CAN123 Kıdemli Uzman 120 ileti Teknik Ressam ANKARA
Hata versiyonla ilgili olabilir. Bende de başka bir lispte benzer bi sorun çıkmıştı. 2007 versiyonunda hata veren lisp 2014 versiyonunda sorunsuz çalışmıştı.

20.05.2014 15:34 77564	ehya Yönetici 3555 ileti Teknik Ressam Ankara
Şahin hocam, bu hata veren kod versiyon ile ilgili.. Eski sürümlerde bu kod tanımsız.. Anlaşılan daha sonraları bu kod eklenmiş.

20.05.2014 21:09 77565	ProhibiT Yetkili 1612 ileti İnşaat Mühendisi Ankara
Haklısınız :) (push-error-using-command), (pop-error-mode) ve benzeri hata yakalama işlevleri 2014'le eklenen özellikler. Bende farkına varıp command-s ile çözmeyi tercih ettim. Söylemekte fayda var ki; bu yeni yöntemle hata yakalama çok daha sağlıklı ve doğru. kerem1453 arkadaşımızın istediği özelliğin eklenmiş hali; Kod: ;\|**************************************************************************\| \| MvM: Multiple Move / Çoklu Move \| \| Nesne gurupları seçilerek oluşturulan seçim setlerii, her gurubun \| \| belirlenen noktası referan alınarak imleç konumuna sürüklenerek, \| \| tıklanan noktaya bırakılarak Move işlemi uygulanır. Seçim seti \| \| oluşturulurken guruba nesne ekleme/çıkarma işlemi yapılabilir. \| \| M. Şahin Güvercin (ProhibiT) - www.cizimokulu.com - 21.05.2014 \| \|---------------------------------------------------------------------------\|; (defun c:MvM (/ BsPnT GrObN m myerr n i NewOb olderr PvT) (setvar "cmdecho" 0) (command "_.undo" "group") (vl-load-com) (defun myerr (errmsg /) (if (/= errmsg "Function cancelled")(prompt errmsg)) (command-s "._undo" "_e") (command-s "._U") (setq error* olderr) (princ)) (setq olderr error error myerr n 1 m 0 BsPnT (append)) (princ "\n1. Seçim Seti: ") (while (setq newOb (ssget)) (set (read (strcat "SecSet" (itoa n))) NewOb) (setq BsPnT (append BsPnT (list (getpoint (strcat "\n" (itoa n) ". Refans Noktası:"))))) (princ (strcat "\n" (itoa (setq n (1+ n))) ". Seçim Seti: "))) (while (< (setq m (1+ m)) n) (setq PvT (eval (read (strcat "SecSet" (itoa m)))) GrObN (append) i -1) (while (< (setq i (1+ i)) (sslength PvT)) (setq GrObN (append GrObN (list (cons 340 (ssname PvT i)))))) (command "_.Move" PvT "" (nth (1- m) BsPnT) Pause) (entmake (append (list (cons 0 "GROUP") (cons 100 "AcDbGroup") (cons 300 "") (cons 70 1) (cons 71 1)) GrObN))) (command "_.undo" "end") (setq error olderr) (prin1)) Beğenmek için anlamak lazım...

21.05.2014 20:14 77574	kerem1453 Kıdemli Uzman 111 ileti teknik ressam ankara
prohibit hocam çok teşekkür ederim elinize sağlık.

22.05.2014 07:09 77579	ProhibiT Yetkili 1612 ileti İnşaat Mühendisi Ankara
Güle güle kullan kerem1453:) Basit bir fonksiyon olmasına rağmen ben de sevdim. Bu arada AutoLISP ile group oluşturma kavramını da örneklemiş olduk. İlgi duyan yazar arkadaşlar, bu problemin çözümünde, önce belirlenen seçim setlerinden group'lar oluşturup sonra move işlemini uygulayacak şekilde yazmayı deneyebilirler. Beğenmek için anlamak lazım...

22.05.2014 11:13 77587	Travaci Editör 2394 ileti Teknik Ressam Konstantinopol
Hocam bende yazdıklarımda, group için command kullanmıştımtım hep :con Artık güncelleme vakti geldi :)

> 1 <