BURALAR HEP BENİM

Bugün yayınlayacagım lisp yukarda görüldüğü gibi hvac planlarda kanal saplaması yapmaktadır.

Nasıl kullanılır:

Öncelikle aşagıdaki lisp kodlarını kopyalayın ve uzantısı lisp olacak şekilde kaydedin

Autocad açılır, command satırına APPLOAD yazılır, çıkan pencereden kaydedilen dosya bulunur ve LOAD düğmesi tıklanır, pencere kapatılır.

Command satırına SS yazılır, şekildeki sıra ile seçim yapılır. (Dikkat edilmesi gereken yer saplamanın eğimli olarak çizilmesi gereken kenarı ilk seçilmeli ana kanala bağlandığı kenarı ise en son seçilmelidir.)

Bu lispide çok sık kullanıyorum ve çoğu zaman işime yarıyor. inşallah sizinde işinize yarar...

Kodlar (Bu yazıdan sonrasını kopyalayın)

;BU LİSP SAPLAMA ÇİZER
;HAZIRLAYAN miyatu 30/10/2007
;İLETİŞİM miyatu@msn.com
(defun hata (s)
(if (/= s "Function cancelled")
(princ (strcat "nError: " s))
)
(setvar "filletrad" ef)
(setvar "orthomode" eo)
(setq *error* olderr)
(princ))

(defun c:ss ()
  (setq olderr *error*
*error* hata)
  (setq eo (getvar "orthomode"))
  (setq ef (getvar "filletrad"))
  (setvar "orthomode" 0)
  (setq n1 (entsel "nKANALIN PAH KIRILACAK KENARI SEÇİNİZ:")
 n2 (entsel "nKANALIN DİĞER KENARINI SEÇİNİZ:")
 n3 (entsel "nANA KANAL KENARINI SEÇİNİZ:")
  )
  (setq l1 (entget (car n1))
 l2 (entget (car n2))
 l3 (entget (car n3))
  )
  (setq p1 (cdr (assoc 10 l1))
 p2 (cdr (assoc 11 l1))
 p3 (cdr (assoc 10 l2))
 p4 (cdr (assoc 11 l2))
 p5 (cdr (assoc 10 l3))
 p6 (cdr (assoc 11 l3))
  )
  (setq p7 (inters p1 p2 p5 p6 onseg)
 p8 (inters p3 p4 p5 p6 onseg)
  )
  (command "change" n1 "" p7 "")
  (command "change" n2 "" p8 "")
  (setq a1 (distance p7 p8))
  (setq q1 (angle p7 p2))
  (setq q2 (angle p8 p7))
  (setq cp 0)
  (cond
    ((<= a1 40)
     (setq a2 10)
    )
    ((<= a1 70)
     (setq a2 15)
    )
    ((<= a1 90)
     (setq a2 20)
    )
    ((<= a1 110)
     (setq a2 25)
    )
    ((<= a1 130)
     (setq a2 30)
    )
    ((<= a1 150)
     (setq a2 35)
    )
    ((<= a1 170)
     (setq a2 40)
    )
    ((<= a1 190)
     (setq a2 45)
    )
  )
  (setq p9  (polar p8 q1 a2)
 p10 (polar p7 q1 a2)
 p11 (polar p7 q2 a2)
  )
  (command "zoom" "w" p8 p7)
  (command "line" p9 p10 "")
  (setq n4 (entlast))
  (command "line" p10 p11 "")
  (setvar "filletrad" 0)
  (command "fillet" n1 n4 "")
  (command "zoom" "p")
  (setvar "orthomode" eo)
  (setvar "filletrad" ef)
)

Aşagıda kodlarını yazdığım lisp yukarda gördüğünüz 4 çizgiyi dirsek şeklinde birleştirme işine yarar...Havalandırma kanallarını çizerken benim çok sık kullandığım bir lisp...

Nasıl kullanırım:

Öncelikle aşağıdaki kodları kopyalayp not defterine yapıştırın ve uzantısı lsp (mesela dirsek.lsp) olacak şekilde kaydedin.

Sonra autocad ın komut satırına appload yazın.

Çıkan menüden kaydettiğiniz dosyayı bulun ve yükleyin ve menüyü kapatın.

Konut satırına dd yazın ve enter e basın.

Resimde görülen sıra ile çizgilerinizi seçin... bukadar...

Kolay gelsin...

Kodlar (Bu yazıdan sonrasını kopyalayın)

(defun c:DD(/ *error* oldOsnap oldOffset oldEcho oldFillet ind1 ind2 outd1 outd2 ename1 ename2 ename3 ename4 obj1 obj2 obj3 obj4 strpt1 strpt2 strpt3  
    strpt4 endpt1 endpt2 endpt3 endpt4 dspt1 dspt2 raddst rads smarcc cls1 cls2 endl1 endl2 clst1 clst2 enda1 enda2
     )
 (setq oldOsnap (getvar "osmode"))
 (setq oldOffset (getvar "offsetdist"))
 (setq oldEcho (getvar "cmdecho"))
 (setq oldFillet (getvar "filletrad"))

   (defun *error*(msg)
   (setvar "osmode" oldOsnap)
   (setvar "offsetdist" oldOffset)
   (setvar "cmdecho" oldEcho)
   (setvar "filletrad" oldFillet)  
   (princ)
   )
  (setvar "osmode" 0)
  (setvar "cmdecho" 0)
  (setq ind1 (entsel " ILK KANAL ICINI SEC"))
  (setq outd1 (entsel " ILK KANAL DISINI SEC"))
  (setq ind2 (entsel " IKINCI KANALIN  ICINI SEC"))
  (setq outd2 (entsel " IKINCI KANALIN  DISINI SEC"))
  (setq ename1 (car ind1))
  (setq obj1 (vlax-ename->vla-object ename1))
  (setq strpt1 (vlax-get obj1 'StartPoint)
        endpt1 (vlax-get obj1 'EndPoint))
  (setq ename2 (car outd1))
  (setq obj2 (vlax-ename->vla-object ename2))
  (setq strpt2 (vlax-get obj2 'StartPoint)
        endpt2 (vlax-get obj2 'EndPoint))
  (if (inters strpt1 endpt1 strpt2 endpt2) (setq result "The first two lines are not parallel")
   (setq d1 (distance strpt1 (vlax-curve-getClosestPointTo obj2 strpt1))
         d2 (distance endpt1 (vlax-curve-getClosestPointTo obj2 endpt1))
         d3 (distance strpt2 (vlax-curve-getClosestPointTo obj1 strpt2))
         d4 (distance endpt2 (vlax-curve-getClosestPointTo obj1 endpt2))))
   (setq dspt1 (min d1 d2 d3 d4))
  (setq ename3 (car ind2))
  (setq obj3 (vlax-ename->vla-object ename3))
  (setq strpt3 (vlax-get obj3 'StartPoint)
        endpt3 (vlax-get obj3 'EndPoint))
  (setq ename4 (car outd2))
  (setq obj4 (vlax-ename->vla-object ename4))
  (setq strpt4 (vlax-get obj4 'StartPoint)
        endpt4 (vlax-get obj4 'EndPoint))
  (if (inters strpt3 endpt3 strpt4 endpt4) (setq result "The second two lines are not parallel")
   (setq d5 (distance strpt3 (vlax-curve-getClosestPointTo obj4 strpt3))
         d6 (distance endpt3 (vlax-curve-getClosestPointTo obj4 endpt3))
         d7 (distance strpt4 (vlax-curve-getClosestPointTo obj3 strpt4))
         d8 (distance endpt4 (vlax-curve-getClosestPointTo obj3 endpt4))))
   (setq dspt2 (min d5 d6 d6 d8))  
  (if (<= dspt2 dspt1) (setq raddst dspt2) (setq raddst dspt1))
      (cond
                                       ((< raddst 20.9) (setq rads 5))
   ((< raddst 50.9) (setq rads 10))
   ((< raddst 70.9) (setq rads 15))
   ((< raddst 90.9) (setq rads 20))
                                       ((< raddst 110.9) (setq rads 25))
                                       ((< raddst 130.9) (setq rads 30))
                                       ((< raddst 150.9) (setq rads 35))
                                       ((< raddst 170.9) (setq rads 40))
                                       ((< raddst 190.9) (setq rads 45))
                                        ((< raddst 210.9) (setq rads 50))

      )
  (setvar "FILLETRAD" rads)
  (command "FILLET" ind1 ind2)
  (setq smarcc (cdr (assoc 10  (entget (entlast)))))
  (setvar "FILLETRAD" (+ rads raddst))
  (command "FILLET" outd1 outd2)
  (setq cls1 (vlax-curve-getClosestPointTo obj1 smarcc))
  (setq cls2 (vlax-curve-getClosestPointTo obj3 smarcc)) 
  (setq endl1 (inters  smarcc cls1 strpt2 endpt2 nil))
  (setq endl2 (inters  smarcc cls2 strpt4 endpt4 nil))  
  (setq smarcc (trans smarcc 0 1))  
  (setq clst1 (trans cls1 0 1))
  (setq clst2 (trans cls2 0 1))   
  (setq enda1 (trans endl1 0 1))
  (setq enda2 (trans endl2 0 1)) 
  (command "LINE" clst1 enda1 "")
  (command "LINE" clst2 enda2 "")  
 (setvar "osmode" oldOsnap)
 (setvar "offsetdist" oldOffset)
 (setvar "cmdecho" oldEcho)
 (setvar "filletrad" oldFillet)
 (princ)
)

ARTIK BURDAN YAYINIMIZA DEVAM EDECEGİZ...

TÜM İLGİLİLERE DUYURULUR...