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