AutoCAD • AutoLISP • Programlama • Püfler • Komutlar • Terimler • Eğitim
aLd • TCad • FacadeCAD • Cephe Kot • HQ Library • FreeMUST • Pasdoc.A
Forumlar > AutoLISP > Çoklu Move / Multiple Move
17.05.2014 20:36    
ProhibiT
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))
17.05.2014 21:36    
Travaci
Bilgisayarım bozuldu bakamıyorum :con

20.05.2014 13:38    
kerem1453
*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    
Travaci
Error trap hatasında yalnız değilmişim :yes

20.05.2014 14:24    
kerem1453
:))

20.05.2014 14:58    
ProhibiT
:) Bende güleyim, eksik kalmasın. :) Bende neden hata vermiyor onu çözemedik. Bir araştıralım...

20.05.2014 15:15    
kerem1453
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    
ProhibiT
Ö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))
20.05.2014 15:28    
CAN123
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    
ehya
Ş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    
ProhibiT
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))
21.05.2014 20:14    
kerem1453
prohibit hocam çok teşekkür ederim elinize sağlık.

22.05.2014 07:09    
ProhibiT
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.

22.05.2014 11:13    
Travaci
Hocam bende yazdıklarımda, group için command kullanmıştımtım hep :con Artık güncelleme vakti geldi :)

> 1 <
Copyright © 2004-2022 SQL: 1.689 saniye - Sorgu: 82 - Ortalama: 0.02059 saniye