04.05.2012 10:26    

alirizasahin


Linkleri görebilmek için ÜYE olmalısınız.

sitesinde bulduğum (Paylaşımda sıkıntı olmaz umarım) Yerden ısıtma lispini bu sitede paylaşmak istedim. Umarım yerden ısıtma projesi yapan arkadaşların işine yarar.
Odanızın dikdörtgen olma şartı var...


(defun c:RS (/ os_off os_on undo_group undo_end llp urp siz xdm ydm spg ns lov xpl sp op
e)
(defun os_off () (setvar "osmode" (logior 16384 (getvar "osmode"))))
(defun os_on () (setvar "osmode" (logand (~ 16384) (getvar "osmode"))))
(defun undo_group () (command "undo" "group"))
(defun undo_end () (command "undo" "end"))
(undo_group)
(os_on)
(setq llp (getpoint "Odanın sol alt köşesini seçiniz: ")
urp (getpoint llp "Odanın sağ üst köşesini seçiniz: ")
siz (mapcar '- urp llp)
xdm (car siz)
ydm (cadr siz)
;;spg (getdist "Boru aralığı <3>: ")
spg (if spg
spg
3
)
ns (fix (/ ydm spg))
ns (/ (fix (* 2 (1+ ns))) 2) ; round to an even number
lov (/ (- ydm (* (- ns 2) spg)) 2) ; leftover
xpl (- xdm (* 4 lov))
)
(os_off)
(command "Pline"
(print (setq sp (mapcar '+ llp (list (* 6 spg) 0))))
(print (setq sp (mapcar '+ sp (list 0 (print (/ spg 4.0))))))
"Arc"
(setq sp (mapcar '+ sp (list spg spg)) op sp)
"Line"
(setq sp (mapcar '- urp (list (* 1.5 lov) (- ydm (* 1.5 lov)))))
"Arc"
(setq sp (mapcar '+ sp (list 0 spg)))
"Line"
(setq sp (mapcar '+ sp (list (- xpl) 0)))
"Arc"
(setq sp (mapcar '+ sp (list 0 spg)))
"Line"
)
(repeat (- (/ ns 2) 3)
(command (setq sp (mapcar '+ sp (list xpl 0)))
"Arc"
(setq sp (mapcar '+ sp (list 0 spg)))
"Line"
(setq sp (mapcar '+ sp (list (- xpl) 0)))
"Arc"
(setq sp (mapcar '+ sp (list 0 spg)))
"Line"
)
)
(command (setq sp (mapcar '+ sp (list xpl 0)))
"Arc"
(setq sp (mapcar '+ sp (list 0 spg)))
"Line"
(setq sp (mapcar '- sp (list (+ xpl 0) 0)))
"Arc"
(setq sp (mapcar '- sp (list spg spg)))
"Line"
(setq sp (list (car sp) (+ (cadr op) spg)))
"Arc"
(setq sp (mapcar '+ sp (list spg (- spg))))
"line"
(setq sp (mapcar '+ sp (list (* 2 spg) 0)))
"arc"
(setq sp (mapcar '+ sp (list spg (- spg))))
"line"
(setq sp (list (car sp) (cadr llp)))
""
)
(os_on)
(undo_end)
(setq e (vlax-ename->vla-object (entlast)))
(princ (strcat "Length of piping: " (rtos (vla-get-length e))))
(princ)
)

01.05.2015 13:13    

rmz cnk
paylaşım için saolasın en azından çizmekten kurtulduk kulağını kuyrugunu çeker ayarlarız artık :)

04.05.2015 11:39    

semiyildiz
BORU ARALIĞINI GİR SEÇENEĞİ OLSA DAHA SÜPER OLUR ODA İÇERİSİNİ İKİ VEYA DAHA FAZLA AYRI GRUP YAPABİLİRİZ.

TEŞEKKÜRLER..

16.05.2015 06:51    

merdinozacar
Merhaba,

Lispi boru aralıklarını 3 cm olarak çiziyor. Bunu 15 cm ye nasıl çıkarabiliriz. Değiştirip gönderebilir misin?

17.06.2015 13:41    

güngör özay
Cm olarak algilamazsak daha dogru olur. Birim olarak degistirmek icin asagidaki kirmizi renkli degeri degistirirsek aralarindaki mesafe istenilen degere gelir.

Hatta kodun basinda bulunan ";;" ibareyi kaldirirsak her defasinda istenilen degeri soracaktir :) Dolayisiyla rakami lisp icinde degistirmesekte olur.


;;spg (getdist "Boru aralığı <3>: ")
spg (if spg
spg
3
)

16.02.2016 13:06    

kerem-----
iki değilde daha fazla nokta seçilebilse yada yapabilinirse çok daha güzel olurmuş bu da güzel tabi ki

21.12.2017 10:56    

ahmetgedik29
arkadaşlar programın komutu nedir.?

Travaci (21.12.2017 11:08 GMT)

21.12.2017 11:09    

Travaci
ahmetgedik29


RS

30.04.2021 21:40    

suleymanozsu


Linkleri görebilmek için ÜYE olmalısınız.

bu sayfada nerde acaba lisp?

01.05.2021 17:58    

yazgunesi
Autolisp programının alıntı yapıldığı sayfa :



Linkleri görebilmek için ÜYE olmalısınız.

> 1 <
Copyright © 2004-2022 SQL: 1.376 saniye - Sorgu: 80 - Ortalama: 0.0172 saniye