2013年10月2日 星期三

AUTOLISP門板展開程式

這幾天畫電控箱畫到有點走火入魔
所以寫了自動產生電控箱的程式來增加我的工作速度
好讓我有更多悠閒的時間
想要學LISP程式的網友們可以看看我的程式來學
因為我也都是寫一些基本型態的程式
所以淺顯易懂

(defun C:line7 (/ a b c x2 p1 p4)
(setvar "cmdecho" 0)
(setvar "OSMODE" 0)
(if (= (tblsearch "layer" "標註線") nil)
(command "-layer" "n" "標註線" "c" "13" "標註線" ""))
(if (= (tblsearch "layer" "正折") nil)
(command "-layer" "n" "正折" "c" "6" "正折" ""))
(if (= (tblsearch "layer" "畫線") nil)
(command "-layer" "n" "畫線" "c" "2" "畫線" ""))
(if (= (tblsearch "layer" "打點") nil)
(command "-layer" "n" "打點" "c" "4" "打點" ""))
(if (= (tblsearch "layer" "文字") nil)
(command "-layer" "n" "文字" "c" "5" "文字" ""))
(if (= (tblsearch "layer" "虛線") nil)
(command "-layer" "n" "虛線" "c" "3" "虛線" "L" "DASHED" "虛線" ""))
(if (= (tblsearch "layer" "中心線") nil)
(command "-layer" "n" "中心線" "c" "1" "中心線" "L" "CENTER" "中心線" ""))
(if (= (tblsearch "layer" "圖框線") nil)
(command "-layer" "n" "圖框線" "c" "8" "圖框線" ""))
(if (= (tblsearch "layer" "圖框") nil)
(command "-layer" "n" "圖框" "c" "8" "圖框" ""))
(if (= (tblsearch "layer" "反折") nil)
(command "-layer" "n" "反折" "c" "3" "反折" "L" "DASHED" "反折" ""))

(setq c1(getpoint "\n圖形插入點:"))
(setq W1(getreal "\n輸入門板寬度="))
(setq l1(getreal "\n輸入門板高度="))
(setq h1(getreal "\n輸入門板深度="))
(setq x1(getreal "\n輸入板金延伸量="))
(setq d1(- (/ w1 2) x1))
(setq d2(- (/ l1 2) x1))
(setq x2(+ x1 x1))
(setq p1(list(- (car c1) d1) (+ (cadr c1) d2)))
(setq p2(list(+ (car c1) d1) (+ (cadr c1) d2)))
(setq p3(list(+ (car c1) d1) (- (cadr c1) d2)))
(setq p4(list(- (car c1) d1) (- (cadr c1) d2)))
(setq p5(list(- (car p1) (- h1 x2)) (cadr p1)))
(setq p6(list(- (car p4) (- h1 x2)) (cadr p4)))
(setq p7(list(+ (car p2) (- h1 x2)) (cadr p2)))
(setq p8(list(+ (car p3) (- h1 x2)) (cadr p3)))
(setq p9(list(car p1) (+ (cadr p1) (- h1 x2))))
(setq p10(list(car p2) (+ (cadr p2) (- h1 x2))))
(setq p11(list(car p4) (- (cadr p4) (- h1 x2))))
(setq p12(list(car p3) (- (cadr p3) (- h1 x2))))
(setq p13(list(car p1) (+ (cadr p1) 0.2)))
(setq p14(list(- (car p13) x1)(cadr p13)))
(setq p15(list(car p14)(- (+ (cadr p1) h1) x2)))
(setq p16(list(+ (car p15) x1)(cadr p15)))
(setq p17(list(- (+ (car p16) 12) x1)(- (+ (cadr p16) 12) x1)))

(setq p22(list(car p2) (+ (cadr p2) 0.2)))
(setq p21(list(+ (car p22) x1)(cadr p22)))
(setq p20(list(car p21)(- (+ (cadr p2) h1) x2)))
(setq p19(list(- (car p20) x1)(cadr p20)))
(setq p18(list(+ (- (car p19) 12) x1)(- (+ (cadr p19) 12) x1)))
(setq p23(list(- (+ (car p7) h1) x1)(+ (- (cadr p7) h1) x1)))
(setq p24(list(- (+ (car p8) h1) x1)(- (+ (cadr p8) h1) x1)))
(setq p25(list(+ (- (car p5) h1) x1)(+ (- (cadr p5) h1) x1)))
(setq p26(list(+ (- (car p6) h1) x1)(- (+ (cadr p6) h1) x1)))

(setq p27(list(car p4) (- (cadr p4) 0.2)))
(setq p28(list(- (car p27) x1)(cadr p27)))
(setq p29(list(car p28)(+ (- (cadr p4) h1) x2)))
(setq p30(list(+ (car p29) x1)(cadr p29)))
(setq p31(list(- (+ (car p30) 12) x1)(+ (- (cadr p30) 12) x1)))
(setq p36(list(car p3) (- (cadr p3) 0.2)))
(setq p35(list(+ (car p36) x1)(cadr p36)))
(setq p34(list(car p35)(+ (- (cadr p3) h1) x2)))
(setq p33(list(- (car p34) x1)(cadr p34)))
(setq p32(list(+ (- (car p33) 12) x1)(+ (- (cadr p33) 12) x1)))
(setq p37(list(car p4) (+ (cadr p4) (/ l1 2))))
(setvar "CLAYER" "反折")
(command "line" p1 p2 p3 p4 "c")
(command "line" p5 p6 "")
(command "line" p7 p8 "")
(command "line" p9 p10 "")
(command "line" p11 p12 "")
(setvar "CLAYER" "0")
(command "line" p3 p36 p35 p34 p33 p32 p31 p30 p29 p28 p27 p4 p6 p26 p25 p5 p1 p13 p14 p15 p16 p17 p18 p19 p20 p21 p22 p2 p7 p23 p24 p8 p3 "")
(setq p1(list(+ (car p37) (- 53.5 x1)) (cadr p37)))
(setq p2(list(- (car p1) 11.5) (+ (cadr p1) 32.5)))
(setq p3(list(+ (car p1) 11.5) (+ (cadr p1) 32.5)))
(setq p4(list(+ (car p1) 11.5) (- (cadr p1) 32.5)))
(setq p5(list(- (car p1) 11.5) (- (cadr p1) 32.5)))
(setq p6(list(+ (car p2) 8) (cadr p2)))
(setq p7(list(- (car p3) 8) (cadr p3)))
(setq p8(list(- (car p4) 8) (cadr p4)))
(setq p9(list(+ (car p5) 8) (cadr p5)))
(setq p10(list(car p6) (+ (cadr p6) 4.5)))
(setq p11(list(car p7) (+ (cadr p7) 4.5)))
(setq p12(list(car p8) (- (cadr p8) 4.5)))
(setq p13(list(car p9) (- (cadr p9) 4.5)))
(setq p14(list(car p1) (+ (cadr p1) 40.5)))
(setq p15(list(car p1) (- (cadr p1) 40.5)))
(command "line" p10 p6 p2 p5 p9 p13 "")
(command "line" p11 p7 p3 p4 p8 p12 "")
(command "arc" p10 p14 p11)
(command "arc" p13 p15 p12)
(setvar "OSMODE" 183)
(princ)


)

沒有留言:

張貼留言