13.01.2011 22:21    

miyatu
Lispte kullanım kolaylıgı olması acısından bazı değişiklikler yaptım
radius degeri ve diğer secenekler için bir menu ekledim
lispi aşagıdaki linkten indirebilirsiniz
gerekli acıklamalar rar paketinin içindeki txt dosyasında mevcutur.

http://hotfile. Com/dl/102997896/b53a523/dd-ver-2. Rar

uyarı: türkçe yazım kuralları gereği, link hatalı görülüyor. noktadan sonraki boşluklar olmayacak.

belki daha önce muadili verilmiş olabilir.

lispin amaci:

mekanik tesisatta boru demetlerinin (birbirine paralel linelar) dönüş yaptığı yerlerde sabit yada değişken radius ile birbirine bağlamak.

kullanımı:

lisp kodlarını kopyalayın, bir notpada yapıştırın, uzantısı lsp olacak sekilde kaydedin.
command satırına ap yazın, cıkan pencerede dosyayı kaydettigniz dizine gidin, dosyanızı secip load butonuna basın, pencereyi kapatın. "pencere derken odanızın penceresini kastetmedim :)"
command satırına dd yazın ve mesajları takip edin.

açıklama:

ılk koseyi seciniz / radius:

mesajını aldıgınızda birleştirmek istediğiniz çizgilerin iç tarafında bir nokta secebilirsiniz yada r girerek radıus degerini yada calışma tipini değiştirebilirsiniz.

eger radius secilmiş ise;

radiusu giriniz / sabit / artis:<0>

mesajını alırsınız, burada yeni radius degerinin girişini yapabilir, çalışma seklini sabit yada artışlı olarak tanımlayabilirsiniz.

eger sabit secilmiş ise;

önceki radius degerini yada default radius degeri olan sıfırı, radius degeri olarak kabul eder ve sizden ilk noktayı secmenizi ister.
bu alt komut secildiğinde; birleştirilmek istenilen çizgiler girilen radius degri ile birbirine bağlanırlar.

eger artış secilmiş ise;

başlangıc radius degerini teyit etmek için,

radiusu giriniz:<0>

mesajını alırsınız, gösterilen degeri kabul etmek için enter yada yeni deger girişi yapabilirsiniz.
bu alt komut seçildiğinde; birleştirilmek istenilen çizgi gruplarının, iç tarafındaki ilk cizgiler birbirlerine, girilen radius degeri ile birleştirilir ve diger cizgiler ofset miktarları kadar, radius degerini artırarak, birbiri ile birleştirilir.

ılk koseyi seciniz:

bu mesajı aldıgınızda birleştirilmek istenen çizgilerin iç kısmında kalan bölgede bir nokta seçmelisiniz.

karsi koseyi seciniz:

bu mesajı aldıgınızda birleştirilmek istenen çixgilerin dış kısmında kalan bölgede bir nokta seçmelisiniz.

tanımlar:

iç kısım; birleştirme sonucunda birleşen çizgilerin küçük açı ile gördüğü taraf.

dış kısım; birleştirme sonucunda birleşen çizgilerin büyük acı açı ile gördüğü taraf.

Kod:

;************************************************************************************
;13/01/2011 qatar / doha / ekın proje / miyatu
;miyatu@msn.        com
;calistirma kodu "dd" dir
;secimler herzaman icten disa dogru olmalidir
;birbiri ile kesisebilen, iki grup cizgiyi, birbiri ile radiuslu yada radiussuz olarak birlestirir
;ıstenilen radius olcusu girisi yapilabilir
;radius yaricapi sabit tutulabilir, istenirse ofset miktari eklenerek kullanilabilir.        .        .       
;*****************************************************************************************
(defun c:dd ()
  (if (= rad nil)(progn(setq rad 0)))
  (if (= style nil)(progn(setq style 0)))
  (initget "radius")
  (setq p1 (getpoint "\nılk koseyi seciniz / radius:"))
  (if (= p1 "radius")
    (progn
      (initget "sabit artis")
      (setq rad1 (getreal (strcat "\nradiusu giriniz / sabit / artis:<"(rtos rad)">")))
      (cond
((= rad1 nil)
(setq rad1 rad))
((= rad1 "sabit")
(setq rad1 rad)
(setq style 0))
((= rad1 "artis")
(setq style 1)
(setq rad1 (getreal (strcat "\nradiusu giriniz:<"(rtos rad)">")))
(if (= rad1 nil)
   (progn
     (setq rad1 rad)))))
    (setq rad rad1)
    (setq p1 (getpoint "\nılk koseyi seciniz:"))))
    (setq p2 (getcorner p1 "\nkarsi koseyi seciniz:")
p1x (car p1)
p1y (cadr p1)
p1z (caddr p1)
p2x (car p2)
p2y (cadr p2)
p3 (list p1x p2y p1z)
p4 (list p2x p1y p1z)
secim (ssget "_c" p1 p2 )
x_listesi (list ())
y_listesi (list ())
next (- (sslength secim) 1))
  (while (/= next -1)
    (setq ps (cdr (assoc 10 (entget (ssname secim next))))
  pf (cdr (assoc 11 (entget (ssname secim next)))))
    (if (/= (inters p1 p3 ps pf) nil)
      (progn
(setq y_listesi (append y_listesi (list (cadr (inters p1 p3 ps pf)))))))
    (if (/= (inters p1 p4 ps pf) nil)
      (progn
(setq x_listesi (append x_listesi (list (car (inters p1 p4 ps pf)))))))
    (setq next (- next 1)))
  (setq sirali_y (vl-sort (cdr y_listesi) '<)
sirali_x (vl-sort (cdr x_listesi) '<)
xk (abs (distance p1 (list (nth 0 sirali_x) p1y p1z)))
xb (abs (distance p1 (list (nth (- (length sirali_x) 1) sirali_x) p1y p1z)))
yk (abs (distance p1 (list p1x (nth 0 sirali_y) p1z )))
yb (abs (distance p1 (list p1x (nth (- (length sirali_y) 1) sirali_y)p1z))))
  (if (< xk xb)
    (progn
      (setq sirali_x (vl-sort sirali_x '<)))
    (progn
      (setq sirali_x (vl-sort sirali_x '>))))
  (if (< yk yb)
    (progn
      (setq sirali_y (vl-sort sirali_y '<)))
    (progn
      (setq sirali_y (vl-sort sirali_y '>))))
  (setq next (- (sslength secim) 1))
  (setq rad2 rad)
  (while (/= next -1)
    (setq px (list (nth 0 sirali_x) p1y p1z)
  sirali_x (cdr sirali_x)
  py (list p1x (nth 0 sirali_y) p1z)
  sirali_y (cdr sirali_y)
  l1 (ssget px)
  l2 (ssget py)
  next (- next 1))
    (setq old_rad (getvar "filletrad")
  old_osn (getvar "osmode"))
    (setvar "filletrad" rad2)
    (setvar "osmode" 0)
    (command "fillet" l1 l2 "")
    (if (= style 1)
      (progn
(setq px1 (list (nth 0 sirali_x) p1y p1z)
      ofset (abs(distance px px1))
      rad2 (+ rad2 ofset))))
    (setvar "filletrad" old_rad)
    (setvar "osmode" old_osn)))



ben yazarken cok eğlendim, kullanırken daha cok eglendim.

inş. birilerinin işine yarar.

bu lispi yazarken fikirlerinden faydalandığım buyuklerime saygıyla teşekkürederim.

kolay gelsin.

not:
1-kodları istediğiniz gibi değiştirebilir, bir kısmını kopyalayabilir ve başka bir yerde kullanabilirsiniz.
2-cumle dusukluklerı için özür dilerim.

miyatu (08.02.2011 21:10 GMT)

24.04.2015 08:32    

akartal
Arkadaşlar burda paylaşmış olduğunuz birbirinden değerli lispler için emeği geçen tüm arkadaşlarıma teşekkür ediyorum.
Lisp konusunda uzman arkadaşlarımdan bir tanede ricam var ilgilenirseniz sevinirim.
Hani yazı bul değiştir lispi varya onun mantığıyla çalışan yalnız bu defa yazı değilde çizgi bul değiştir lispi biraz daha açarsak misal basit bir v tipi kanal 3 adet çizgiden oluştuğunu varsayalım.Bu v tipi çizgi yerine düz çizgi koymak istiyom.Olay bu, yapabilirseniz.Çok faydalı bir Lisp olacağını düşünüyorum.Şimdiden ilgilenen arkadaşlarıma teşekkür ediyorum.Kolaylıklar diliyorum.

27.05.2018 05:35    

ayak
miyatu usta,
bu lispi kontrol eder misin çalışmadı
radiusu değişmek içinde R yi kabul etmiyor
radius yazınca kabul ediyor.
iyi çalışmalar

> 1 <
Copyright © 2004-2022 SQL: 0.7 saniye - Sorgu: 47 - Ortalama: 0.01489 saniye