04.05.2012 10:26

68721    

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)
)

04.05.2015 11:39

81401    

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..

17.06.2015 13:41

81647    

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
)

21.12.2017 10:56

85838    

arkadaşlar programın komutu nedir.?

Travaci (21.12.2017 11:08 GMT)

30.04.2021 21:40

88965    

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

bu sayfada nerde acaba lisp?