;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; ;; initialize the environment ;; ;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (command "vpoint" (list 1 -1 1)) (command "layer" "make" "block" "color" "red" "block" "") (command "layer" "make" "arm" "color" "yellow" "arm" "") (command "layer" "make" "cantilever" "color" "cyan" "cantilever" "") (command "layer" "make" "nose" "color" "blue" "nose" "") (command "layer" "make" "purlin" "color" "green" "purlin" "") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; ;; define the types ;; ;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (nt_def_type "cap_block" 'cap_block '(("xo" . 0) ("yo" . 0) ("zo" . 0) ("para" . 1))) (nt_def_type "connection_block" 'connection_block '(("xo" . 0) ("yo" . 0) ("zo" . 0) ("para" . 1))) (nt_def_type "center_block" 'center_block '(("xo" . 0) ("yo" . 0) ("zo" . 0) ("para" . 1))) (nt_def_type "small_block" 'small_block '(("xo" . 0) ("yo" . 0) ("zo" . 0) ("para" . 1))) (nt_def_type "petal_arm" 'petal_arm '(("xo" . 0) ("yo" . 0) ("zo" . 0) ("para" . 1) ("width" . 72))) (nt_def_type "wall_arm" 'wall_arm '(("xo" . 0) ("yo" . 0) ("zo" . 0) ("para" . 1))) (nt_def_type "oval_arm" 'oval_arm '(("xo" . 0) ("yo" . 0) ("zo" . 0) ("para" . 1))) (nt_def_type "regular_arm" 'regular_arm '(("xo" . 0) ("yo" . 0) ("zo" . 0) ("para" . 1))) (nt_def_type "long_arm" 'long_arm '(("xo" . 0) ("yo" . 0) ("zo" . 0) ("para" . 1))) (nt_def_type "cantilever" 'cantilever '(("xo" . 0) ("yo" . 0) ("zo" . 0) ("para" . 1))) (nt_def_type "nose" 'nose '(("xo" . 0) ("yo" . 0) ("zo" . 0) ("para" . 1) ("direction" . 1))) (nt_def_type "purlin" 'purlin '(("xo" . 0) ("yo" . 0) ("zo" . 0) ("para" . 1))) (nt_def_type "canti_petal" 'canti_petal '(("xo" . 0) ("yo" . 0) ("zo" . 0) ("para" . 1) ("width" . 72))) (nt_def_type "two_small_blocks" 'two_small_blocks '(("xo" . 0) ("yo" . 0) ("zo" . 0) ("x1o" . 50) ("y1o" . 50) ("z1o" . 50) ("para" . 1))) (nt_def_type "two_connection_blocks" 'two_connection_blocks '(("xo" . 0) ("yo" . 0) ("zo" . 0) ("x1o" . 50) ("y1o" . 50) ("z1o" . 50) ("para" . 1))) (nt_def_type "connection_blocks_2" 'connection_blocks_2 '(("xo" . 0) ("yo" . 0) ("zo" . 0) ("x1o" . 50) ("y1o" . 50) ("z1o" . 50) ("para" . 1))) (nt_add_seed_type "cap_block") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; ;; set the parameter ;; ;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; modified by Takehiko Nagakura, 2005.1.31 (defun c:grade () (setq grade (getint "Choose the grade from 1-8:")) (if (= grade 1) (setq para 0.6) (if (= grade 2) (setq para 0.55) (if (= grade 3) (setq para 0.5) (if (= grade 4) (setq para 0.48) (if (= grade 5) (setq para 0.44) (if (= grade 6) (setq para 0.4) (if (= grade 7) (setq para 0.35) (setq para 0.3) ))))))) ; if ) ; c:grade (setq grade 2) (setq para 0.6) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; ;; geometry and parameteric functions ;; ;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;''''''''''''''''''; ; draw cap_block ; ;..................; (defun cap_block (xo yo zo para) (command "layer" "set" "block" "") (block xo yo zo 32 32 11 11 4 8 4 8) (setq b1 (entlast)) (setq s1 (ssadd b1)) (command "scale" s1 "" (list xo yo zo) para) (entlast) ) ;'''''''''''''''''''''''''; ; draw connection_block ; ;.........................; (defun connection_block (xo yo zo para) (command "layer" "set" "block" "") (block xo yo zo 18 16 4 3 2 4 2 4) (setq b1 (entlast)) (setq s1 (ssadd b1)) (command "scale" s1 "" (list xo yo zo) para) (entlast) ) ;'''''''''''''''''''''; ; draw center_block ; ;.....................; (defun center_block (xo yo zo para) (command "layer" "set" "block" "") (block xo yo zo 16 16 3 16 2 4 2 4) (setq b1 (entlast)) (setq s1 (ssadd b1)) (command "rotate" s1 "" (list xo yo zo) 90) (command "scale" s1 "" (list xo yo zo) para) (entlast) ) ;''''''''''''''''''''; ; draw small_block ; ;....................; (defun small_block (xo yo zo para) (command "layer" "set" "block" "") (block xo yo zo 16 14 3 14 2 4 2 4) (setq b1 (entlast)) (setq s1 (ssadd b1)) (command "rotate" s1 "" (list xo yo zo) 90) (command "scale" s1 "" (list xo yo zo) para) (entlast) ) ;''''''''''''''''''''''''''''''''''''''''''; ; draw two_connection_blocks (parameter) ; ;..........................................; (defun two_connection_blocks (xo yo zo x1o y1o z1o para) (command "layer" "set" "block" "") (connection_block xo yo zo para) (setq b1 (entlast)) (setq s1 (ssadd b1)) (command "copy" s1 "" (list xo yo zo) (list x1o y1o z1o)) (setq b2 (entlast)) (setq s2 (ssadd b2)) (command "union" s1 s2 "") (entlast) ) ;''''''''''''''''''''''''''''''''''''''''; ; draw connection_blocks_2 (parameter) ; ;........................................; (defun connection_blocks_2 (xo yo zo x1o y1o z1o para) (command "layer" "set" "block" "") (setq b (list "connection_block" nil (list (cons "xo" xo) (cons "yo" yo) (cons "zo" zo) (cons "para" para)) ) ) (setq b1 (list "connection_block" nil (list (cons "xo" x1o) (cons "yo" y1o) (cons "zo" z1o) (cons "para" para)) ) ) (nt_composit (list b b1)) ) ;'''''''''''''''''''''''''''''''''''''; ; draw two_small_blocks (parameter) ; ;.....................................; (defun two_small_blocks (xo yo zo x1o y1o z1o para) (command "layer" "set" "block" "") (small_block xo yo zo para) (setq b1 (entlast)) (setq s1 (ssadd b1)) (command "copy" s1 "" (list xo yo zo) (list x1o y1o z1o)) (setq b2 (entlast)) (setq s2 (ssadd b2)) (command "union" s1 s2 "") (entlast) ) ;''''''''''''''; ; draw block ; ;..............; (defun block (xpos ypos zpos width depth t_width t_depth b h1 h2 h3) (command "osnap" "off") (setq hw (/ width 2.0)) (setq hd (/ depth 2.0)) (setq x (- xpos hw)) (setq y (- ypos hd)) (setq z0 zpos) (setq z1 (+ z0 h3)) (setq z2 (+ z1 h2)) (setq z3 (+ z2 h1)) ; draw the middle part of a block (middle x y z1 z2 width depth) (setq block_m (entlast)) (setq s1 (ssadd block_m)) ; draw the top part of a block (if (< t_depth hd) (top1 x y z2 z3 width depth t_width t_depth) (top2 x y z2 z3 width depth t_width t_depth) ) ; end of if (setq block_t (entlast)) (setq s2 (ssadd block_t)) ; draw the bottom part of a block (bottom x y z0 z1 width depth b h3) (setq block_b (entlast)) (setq s3 (ssadd block_b)) (command "union" s1 s2 s3 "") ) ; end of defun block (defun middle (x y z1 z2 width depth) (command "box" (list x y z1) (list (+ x width) (+ y depth) z2)) ) ; end of defun middle (defun top1 (x y z2 z3 width depth t_width t_depth) (command "box" (list x y z2) (list (+ x t_width) (+ y t_depth) z3)) (setq box1 (entlast)) (setq ss1 (ssadd box1)) (command "box" (list (- (+ width x) t_width) y z2) (list (+ width x) (+ y t_depth) z3)) (setq box2 (entlast)) (setq ss2 (ssadd box2)) (command "box" (list x (- (+ y depth) t_depth) z2) (list (+ x t_width) (+ y depth) z3)) (setq box3 (entlast)) (setq ss3 (ssadd box3)) (command "box" (list (- (+ width x) t_width) (- (+ y depth) t_depth) z2) (list (+ x width) (+ y depth) z3)) (setq box4 (entlast)) (setq ss4 (ssadd box4)) (command "union" ss1 ss2 ss3 ss4 "") ) ; end of defun top1 (defun top2 (x y z2 z3 width depth t_width t_depth) (command "box" (list x y z2) (list (+ x t_width) (+ y depth) z3)) (setq box1 (entlast)) (setq ss1 (ssadd box1)) (command "box" (list (- (+ width x) t_width) y z2) (list (+ width x) (+ y depth) z3)) (setq box2 (entlast)) (setq ss2 (ssadd box2)) (command "union" ss1 ss2 "") (entlast) ) ; end of defun top2 (defun bottom (x y z0 z1 width depth b h3) (command "wedge" (list (+ x width) (+ y depth) z0) (list (- (+ x width) b) (- (+ y depth) width) z1) h3) (setq w1 (entlast)) (setq e1 (ssadd w1)) (setq e2 (ssadd w1)) (command "copy" e2 "" (list 0 0 0) (list 0 0 0)) (setq w3 (entlast)) (setq e3 (ssadd w3)) (command "copy" e2 "" (list 0 0 0) (list 0 0 0)) (setq w4 (entlast)) (setq e4 (ssadd w4)) (command "mirror" e1 "" (list (+ x (/ width 2.0)) y z0) (list (+ x (/ width 2.0)) 0 z0) "n") (setq w2 (entlast)) (setq e1 (ssadd w2 e1)) (command "rotate" e3 "" (list (+ x width) (+ y depth) z0) "90") (command "move" e3 "" (list 0 0 0) (list (- width) 0 0)) (setq e1 (ssadd w3 e1)) (command "rotate" e4 "" (list (+ x width) (+ y depth) z0) "-90") (command "move" e4 "" (list 0 0 0) (list 0 (- depth) 0)) (setq e1 (ssadd w4 e1)) (command "box" (list x y z0) (list (+ x width) (+ y depth) z1)) (setq b1 (entlast)) (setq e (ssadd b1)) (command "subtract" e "" e1 "") ) ; end of defun bottom ;''''''''''''''''''; ; draw petal_arm ; ;..................; (defun petal_arm (xo yo zo para width) (command "layer" "set" "cantilever" "") (arm xo yo zo width 15 16 9 4) (setq a1 (entlast)) (setq s1 (ssadd a1)) (command "scale" s1 "" (list xo yo zo) para) (command "rotate" s1 "" (list xo yo zo) "90") (entlast) ) ;'''''''''''''''''; ; draw wall_arm ; ;.................; (defun wall_arm (xo yo zo para) (command "layer" "set" "arm" "") (arm xo yo zo 62 15 14 9 4) (setq a1 (entlast)) (setq s1 (ssadd a1)) (command "scale" s1 "" (list xo yo zo) para) (entlast) ) ;'''''''''''''''''; ; draw oval_arm ; ;.................; (defun oval_arm (xo yo zo para) (command "layer" "set" "arm" "") (arm xo yo zo 62 15 16 9 4) (setq a1 (entlast)) (setq s1 (ssadd a1)) (command "scale" s1 "" (list xo yo zo) para) (entlast) ) ;''''''''''''''''''''; ; draw regular_arm ; ;....................; (defun regular_arm (xo yo zo para) (command "layer" "set" "arm" "") (arm xo yo zo 72 15 20 9 5) (setq a1 (entlast)) (setq s1 (ssadd a1)) (command "scale" s1 "" (list xo yo zo) para) (entlast) ) ;'''''''''''''''''; ; draw long_arm ; ;.................; (defun long_arm (xo yo zo para) (command "layer" "set" "arm" "") (arm xo yo zo 92 15 12 9 4) (setq a1 (entlast)) (setq s1 (ssadd a1)) (command "scale" s1 "" (list xo yo zo) para) (entlast) ) ;''''''''''''; ; draw arm ; ;............; (defun arm (xpos ypos zpos width height c_width c_height num) (command "ucs" "origin" (list (- xpos (/ width 2.0)) (- ypos 5.0) zpos)) (command "ucs" "x" "90") (setq x 0) (setq n num) (setq sec_width (/ (float c_width) n)) (setq sec_height (/ (float c_height) n)) (setq l (- width c_width)) (setq m (/ (- width 8.0) 2.0)) (command "pline" (list 0 c_height 0) (list 0 height 0) (list m height 0) (list m (- height 10.0) 0) (list (+ m 8.0) (- height 10.0) 0) (list (+ m 8.0) height 0) (list width height 0) (list width c_height 0) "") (setq l1 (entlast)) (setq ss1 (ssadd l1)) (command "pline" (list c_width 0 0) (list l 0 0) "") (setq l2 (entlast)) (setq ss2 (ssadd l2)) (repeat num (setq x (+ x 1)) (setq a (- x 2)) (if (< a 0) (setq a 0) (setq a a) ) ; end if (setq b (+ x 1)) (if (> b n) (setq b n) (setq b b) ) ; end if (setq p1 (list 0 (* sec_height (- n a)) 0)) (setq p2 (list (* sec_width (- x 1)) 0 0)) (setq p3 (list 0 (* sec_height (- n (- x 1))) 0)) (setq p4 (list (* sec_width x) 0 0)) (setq p5 (list 0 (* sec_height (- n x)) 0)) (setq p6 (list (* sec_width b) 0 0)) (setq p7 (list (+ l (* sec_width a)) 0 0)) (setq p8 (list width (* sec_height (- x 1)) 0)) (setq p9 (list (+ l (* sec_width (- x 1))) 0 0)) (setq p10 (list width (* sec_height x) 0)) (setq p11 (list (+ l (* sec_width x)) 0 0)) (setq p12 (list width (* sec_height b) 0)) (command "line" (inters p1 p2 p3 p4 nil) (inters p3 p4 p5 p6 nil) "") (setq l3 (entlast)) (setq ss2 (ssadd l3 ss2)) (command "line" (inters p7 p8 p9 p10 nil) (inters p9 p10 p11 p12 nil) "") (setq l4 (entlast)) (setq ss2 (ssadd l4 ss2)) ); close repeat (command "pedit" ss1 "join" ss2 "" "") (setq ss3 (entlast)) (command "extrude" ss3 "" "-10" "") (entlast) (command "ucs" "") (command "ucs" "origin" (list xpos ypos zpos)) (command "ucs" "") ) ;'''''''''''''; ; draw nose ; ;.............; (defun nose (xo yo zo para direction) (command "layer" "set" "nose" "") (command "box" (list (- xo 5) yo zo) (list (+ xo 5) (- yo 25) (+ zo 15))) (setq n1 (entlast)) (setq s1 (ssadd n1)) (command "box" (list (- xo 5) (- yo 19) zo) (list (+ xo 5) (- yo 25) (+ zo 2))) (setq n2 (entlast)) (setq s2 (ssadd n2)) (command "ucs" "origin" (list (+ xo 5) (- yo 19) zo)) (command "ucs" "z" "90") (command "wedge" (list 0 0 0) (list 5 10 0) "2") (setq n3 (entlast)) (setq s2 (ssadd n3 s2)) (command "ucs" "origin" (list -6 0 2)) (command "wedge" (list 0 0 0) (list 6 10 0) "13") (setq n4 (entlast)) (setq s2 (ssadd n4 s2)) (command "ucs" "") (command "subtract" s1 "" s2 "") (setq n1 (entlast)) (setq s1 (ssadd n1)) (command "scale" s1 "" (list xo yo zo) para) (setq n1 (entlast)) (setq s1 (ssadd n1)) (if (= direction 0) (command "rotate" s1 "" (list xo yo zo) "180")) n1 ) ;'''''''''''''''; ; draw purlin ; ;...............; (defun purlin (xo yo zo para) (command "layer" "set" "purlin" "") (command "box" (list (- xo 60) (- yo 5) zo) (list (+ xo 60) (+ yo 5) (+ zo 15))) (setq p1 (entlast)) (setq s1 (ssadd p1)) (command "scale" s1 "" (list xo yo zo) para) (entlast) ) ;''''''''''''''''''''; ; draw canti_petal ; ;....................; (defun canti_petal (xo yo zo para width) (command "layer" "set" "cantilever" "") (setq hw (/ width 2.0)) (cantilever xo (- yo (+ hw 17)) (- zo 6) para) (setq canti (entlast)) (setq sc (ssadd canti)) (petal_arm xo yo zo para width) (setq pa (entlast)) (setq s2 (ssadd pa)) (command "box" (list (- xo 10) (- yo hw) zo) (list (+ xo 10) (+ (- yo hw) 36) (+ zo 20))) (setq b (entlast)) (setq s3 (ssadd b)) (command "subtract" s2 "" s3 "") (setq p (entlast)) (setq s4 (ssadd p)) (command "union" sc s4 "") (entlast) ) ;'''''''''''''''''''; ; draw cantilever ; ;...................; (defun cantilever (xo yo zo para) (command "box" (list (- xo 5) yo zo) (list (+ xo 5) (+ yo 150) (+ zo 15))) (setq c1 (entlast)) (setq s1 (ssadd c1)) (command "box" (list (- xo 5) yo (+ zo 2)) (list (+ xo 5) (+ yo 60) (+ zo 15))) (setq c2 (entlast)) (setq s2 (ssadd c2)) (command "ucs" "origin" (list xo yo (+ zo 2))) (command "ucs" "y" "-90") (command "rotate" s2 "" (list 0 0 0) "-30") (command "subtract" s1 "" s2 "") (setq s1 (entlast)) (command "rotate" s1 "" (list 0 0 0) "-20") (command "ucs" "") (command "scale" s1 "" (list xo yo zo) para) (entlast) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; ;; transformation declaration ;; ;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (nt_def_trans '("cap_block") "petal_arm" 'cap_block--->petal_arm nil 'add) (nt_def_trans '("cap_block") "wall_arm" 'cap_block--->wall_arm nil 'add) (nt_def_trans '("two_connection_blocks") "petal_arm" 'two_connection_blocks--->petal_arm nil 'add) (nt_def_trans '("connection_block") "oval_arm" 'connection_block--->oval_arm nil 'add) (nt_def_trans '("connection_block") "regular_arm" 'connection_block--->regular_arm nil 'add) (nt_def_trans '("two_connection_blocks") "canti_petal" 'two_connection_blocks--->canti_petal nil 'add) (nt_def_trans '("two_connection_blocks") "connection_blocks_2" 'two_connection_blocks--->connection_blocks_2 nil 'replace) (nt_def_trans '("connection_blocks_2") "connection_block" 'connection_blocks_2--->connection_block nil 'replace) (nt_def_trans '("center_block") "nose" 'center_block--->nose nil 'add) (nt_def_trans '("two_small_blocks") "long_arm" 'two_small_blocks--->long_arm nil 'add) (nt_def_trans '("two_small_blocks") "purlin" 'two_small_blocks--->purlin nil 'add) (nt_def_trans '("petal_arm") "two_connection_blocks" 'petal_arm--->two_connection_blocks nil 'add) (nt_def_trans '("wall_arm") "two_small_blocks" 'wall_arm--->two_small_blocks nil 'add) (nt_def_trans '("oval_arm") "two_small_blocks" 'oval_arm--->two_small_blocks nil 'add) (nt_def_trans '("regular_arm") "two_small_blocks" 'regular_arm--->two_small_blocks nil 'add) (nt_def_trans '("regular_arm") "center_block" 'regular_arm--->center_block nil 'add) (nt_def_trans '("long_arm") "two_small_blocks" 'long_arm--->two_small_blocks nil 'add) (nt_def_trans '("canti_petal") "two_connection_blocks" 'canti_petal--->two_connection_blocks nil 'add) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; ;; transformation functions ;; ;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;''''''''''''''''''''''''''; ; cap_block--->petal_arm ; ;..........................; (defun cap_block--->petal_arm (cap_block_list trans_plist / cap_block_plist c_plist f_plist) (setq cap_block_plist (nt_plist (car cap_block_list))) (setq zo_arm (+ (nt_val "zo" cap_block_plist) 12)) (setq c_plist (list (cons "xo" (nt_val "xo" cap_block_plist)) (cons "yo" (nt_val "yo" cap_block_plist)) (cons "zo" zo_arm) (cons "para" (nt_val "para" cap_block_plist)) (cons "width" 72))) (setq f_plist nil) (list f_plist c_plist) ) ;'''''''''''''''''''''''''; ; cap_block--->wall_arm ; ;.........................; (defun cap_block--->wall_arm (cap_block_list trans_plist / cap_block_plist c_plist f_plist) (setq cap_block_plist (nt_plist (car cap_block_list))) (setq zo_arm (+ (nt_val "zo" cap_block_plist) 12)) (setq c_plist (list (cons "xo" (nt_val "xo" cap_block_plist)) (cons "yo" (nt_val "yo" cap_block_plist)) (cons "zo" zo_arm) (cons "para" (nt_val "para" cap_block_plist)))) (setq f_plist nil) (list f_plist c_plist) ) ;'''''''''''''''''''''''''''''''''; ; connection_block--->oval_arm ; ;,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,; (defun connection_block--->oval_arm (connection_block_list trans_plist / connection_block_plist c_plist f_plist) (setq connection_block_plist (nt_plist (car connection_block_list))) (setq zo_arm (+ (nt_val "zo" connection_block_plist) 6)) (setq c_plist (list (cons "xo" (nt_val "xo" connection_block_plist)) (cons "yo" (nt_val "yo" connection_block_plist)) (cons "zo" zo_arm) (cons "para" (nt_val "para" connection_block_plist)))) (setq f_plist nil) (list f_plist c_plist) ) ;'''''''''''''''''''''''''''''''''''; ; connection_block--->regular_arm ; ;,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,; (defun connection_block--->regular_arm (connection_block_list trans_plist / connection_block_plist c_plist f_plist) (setq connection_block_plist (nt_plist (car connection_block_list))) (setq zo_arm (+ (nt_val "zo" connection_block_plist) 6)) (setq c_plist (list (cons "xo" (nt_val "xo" connection_block_plist)) (cons "yo" (nt_val "yo" connection_block_plist)) (cons "zo" zo_arm) (cons "para" (nt_val "para" connection_block_plist)))) (setq f_plist nil) (list f_plist c_plist) ) ;''''''''''''''''''''''''''''''''''''''; ; two_connection_blocks--->petal_arm ; ;,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,; (defun two_connection_blocks--->petal_arm (two_connection_blocks_list trans_plist / two_connection_blocks_plist c_plist f_plist) (setq two_connection_blocks_plist (nt_plist (car two_connection_blocks_list))) (setq zo_arm (+ (nt_val "zo" two_connection_blocks_plist) 6)) (setq y1 (nt_val "yo" two_connection_blocks_plist)) (setq y2 (nt_val "y1o" two_connection_blocks_plist)) (setq c_plist (list (cons "xo" (nt_val "xo" two_connection_blocks_plist)) (cons "yo" (/ (+ y1 y2) 2.0)) (cons "zo" zo_arm) (cons "para" (nt_val "para" two_connection_blocks_plist)) (cons "width" (+ (abs (- y1 y2)) 72)))) (setq f_plist nil) (list f_plist c_plist) ) ;''''''''''''''''''''''''''''''''''''''''; ; two_connection_blocks--->canti_petal ; ;,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,; (defun two_connection_blocks--->canti_petal (two_connection_blocks_list trans_plist / two_connection_blocks_plist c_plist f_plist) (setq two_connection_blocks_plist (nt_plist (car two_connection_blocks_list))) (setq zo_arm (+ (nt_val "zo" two_connection_blocks_plist) 6)) (setq y1 (nt_val "yo" two_connection_blocks_plist)) (setq y2 (nt_val "y1o" two_connection_blocks_plist)) (setq c_plist (list (cons "xo" (nt_val "xo" two_connection_blocks_plist)) (cons "yo" (/ (+ y1 y2) 2.0)) (cons "zo" zo_arm) (cons "para" (nt_val "para" two_connection_blocks_plist)) (cons "width" (+ (abs (- y1 y2)) 72)))) (setq f_plist nil) (list f_plist c_plist) ) ;''''''''''''''''''''''''''''''''''''''''''''''''; ; two_connection_blocks--->connection_blocks_2 ; ;,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,; (defun two_connection_blocks--->connection_blocks_2 (two_connection_blocks_list trans_plist / two_connection_blocks_plist c_plist) (setq two_connection_blocks_plist (nt_plist (car two_connection_blocks_list))) (setq c_plist (list (cons "xo" (nt_val "xo" two_connection_blocks_plist)) (cons "yo" (nt_val "yo" two_connection_blocks_plist)) (cons "zo" (nt_val "zo" two_connection_blocks_plist)) (cons "x1o" (nt_val "x1o" two_connection_blocks_plist)) (cons "y1o" (nt_val "y1o" two_connection_blocks_plist)) (cons "z1o" (nt_val "z1o" two_connection_blocks_plist)) (cons "para" (nt_val "para" two_connection_blocks_plist)))) (list nil c_plist) ) ;'''''''''''''''''''''''''''''''''''''''''''; ; connection_blocks_2--->connection_block ; ;,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,; (defun connection_blocks_2--->connection_block (connection_blocks_2_list trans_plist / connection_blocks_2_plist c_plist) (setq connection_blocks_2_plist (nt_plist (car connection_blocks_2_list))) (setq c_plist (list (cons "xo" (nt_val "xo" connection_blocks_2_plist)) (cons "yo" (nt_val "yo" connection_blocks_2_plist)) (cons "zo" (nt_val "zo" connection_blocks_2_plist)) (cons "para" (nt_val "para" connection_blocks_2_plist)))) (list nil c_plist) ) ;'''''''''''''''''''''''''; ; center_block--->nose ; ;.........................; (defun center_block--->nose (center_block_list trans_plist / center_block_plist c_plist f_plist) (setq center_block_plist (nt_plist (car center_block_list))) (setq zo_arm (+ (nt_val "zo" center_block_plist) 6)) (setq c_plist (list (cons "xo" (nt_val "xo" center_block_plist)) (cons "yo" (nt_val "yo" center_block_plist)) (cons "zo" zo_arm) (cons "para" (nt_val "para" center_block_plist)))) (setq f_plist (list (cons "direction" 1))) (list f_plist c_plist) ) ;''''''''''''''''''''''''''''''''; ; two_small_blocks--->long_arm ; ;,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,; (defun two_small_blocks--->long_arm (two_small_blocks_list trans_plist / two_small_blocks_plist c_plist f_plist) (setq two_small_blocks_plist (nt_plist (car two_small_blocks_list))) (setq zo_arm (+ (nt_val "zo" two_small_blocks_plist) 6)) (setq c_plist (list (cons "xo" (/ (+ (nt_val "xo" two_small_blocks_plist) (nt_val "x1o" two_small_blocks_plist)) 2.0)) (cons "yo" (nt_val "yo" two_small_blocks_plist)) (cons "zo" zo_arm) (cons "para" (nt_val "para" two_small_blocks_plist)))) (setq f_plist nil) (list f_plist c_plist) ) ;''''''''''''''''''''''''''''''; ; two_small_blocks--->purlin ; ;,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,; (defun two_small_blocks--->purlin (two_small_blocks_list trans_plist / two_small_blocks_plist c_plist f_plist) (setq two_small_blocks_plist (nt_plist (car two_small_blocks_list))) (setq zo_arm (+ (nt_val "zo" two_small_blocks_plist) 6)) (setq c_plist (list (cons "xo" (/ (+ (nt_val "xo" two_small_blocks_plist) (nt_val "x1o" two_small_blocks_plist)) 2.0)) (cons "yo" (nt_val "yo" two_small_blocks_plist)) (cons "zo" zo_arm) (cons "para" (nt_val "para" two_small_blocks_plist)))) (setq f_plist nil) (list f_plist c_plist) ) ;''''''''''''''''''''''''''''''''''''''; ; petal_arm--->two_connection_blocks ; ;,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,; (defun petal_arm--->two_connection_blocks (petal_arm_list trans_plist / petal_arm_plist c_plist f_plist) (setq petal_arm_plist (nt_plist (car petal_arm_list))) (setq width (nt_val "width" petal_arm_plist)) (setq dis (- (/ width 2.0) 6)) (setq c_plist (list (cons "xo" (nt_val "xo" petal_arm_plist)) (cons "yo" (- (nt_val "yo" petal_arm_plist) dis)) (cons "zo" (+ (nt_val "zo" petal_arm_plist) 15)) (cons "x1o" (nt_val "xo" petal_arm_plist)) (cons "y1o" (+ (nt_val "yo" petal_arm_plist) dis)) (cons "z1o" (+ (nt_val "zo" petal_arm_plist) 15)) (cons "para" (nt_val "para" petal_arm_plist)))) (setq f_plist nil) (list f_plist c_plist) ) ;''''''''''''''''''''''''''''''''; ; wall_arm--->two_small_blocks ; ;,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,; (defun wall_arm--->two_small_blocks (wall_arm_list trans_plist / wall_arm_plist c_plist f_plist) (setq wall_arm_plist (nt_plist (car wall_arm_list))) (setq c_plist (list (cons "xo" (- (nt_val "xo" wall_arm_plist) 26)) (cons "yo" (nt_val "yo" wall_arm_plist)) (cons "zo" (+ (nt_val "zo" wall_arm_plist) 15)) (cons "x1o" (+ (nt_val "xo" wall_arm_plist) 26)) (cons "y1o" (nt_val "yo" wall_arm_plist)) (cons "z1o" (+ (nt_val "zo" wall_arm_plist) 15)) (cons "para" (nt_val "para" wall_arm_plist)))) (setq f_plist nil) (list f_plist c_plist) ) ;''''''''''''''''''''''''''''''''; ; oval_arm--->two_small_blocks ; ;,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,; (defun oval_arm--->two_small_blocks (oval_arm_list trans_plist / oval_arm_plist c_plist f_plist) (setq oval_arm_plist (nt_plist (car oval_arm_list))) (setq c_plist (list (cons "xo" (- (nt_val "xo" oval_arm_plist) 26)) (cons "yo" (nt_val "yo" oval_arm_plist)) (cons "zo" (+ (nt_val "zo" oval_arm_plist) 15)) (cons "x1o" (+ (nt_val "xo" oval_arm_plist) 26)) (cons "y1o" (nt_val "yo" oval_arm_plist)) (cons "z1o" (+ (nt_val "zo" oval_arm_plist) 15)) (cons "para" (nt_val "para" oval_arm_plist)))) (setq f_plist nil) (list f_plist c_plist) ) ;'''''''''''''''''''''''''''''''''''; ; regular_arm--->two_small_blocks ; ;,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,; (defun regular_arm--->two_small_blocks (regular_arm_list trans_plist / regular_arm_plist c_plist f_plist) (setq regular_arm_plist (nt_plist (car regular_arm_list))) (setq c_plist (list (cons "xo" (- (nt_val "xo" regular_arm_plist) 31)) (cons "yo" (nt_val "yo" regular_arm_plist)) (cons "zo" (+ (nt_val "zo" regular_arm_plist) 15)) (cons "x1o" (+ (nt_val "xo" regular_arm_plist) 31)) (cons "y1o" (nt_val "yo" regular_arm_plist)) (cons "z1o" (+ (nt_val "zo" regular_arm_plist) 15)) (cons "para" (nt_val "para" regular_arm_plist)))) (setq f_plist nil) (list f_plist c_plist) ) ;'''''''''''''''''''''''''''''''; ; regular_arm--->center_block ; ;,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,; (defun regular_arm--->center_block (regular_arm_list trans_plist / regular_arm_plist c_plist f_plist) (setq regular_arm_plist (nt_plist (car regular_arm_list))) (setq c_plist (list (cons "xo" (nt_val "xo" regular_arm_plist)) (cons "yo" (nt_val "yo" regular_arm_plist)) (cons "zo" (+ (nt_val "zo" regular_arm_plist) 15)) (cons "para" (nt_val "para" regular_arm_plist)))) (setq f_plist nil) (list f_plist c_plist) ) ;''''''''''''''''''''''''''''''''; ; long_arm--->two_small_blocks ; ;,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,; (defun long_arm--->two_small_blocks (long_arm_list trans_plist / long_arm_plist c_plist f_plist) (setq long_arm_plist (nt_plist (car long_arm_list))) (setq c_plist (list (cons "xo" (- (nt_val "xo" long_arm_plist) 41)) (cons "yo" (nt_val "yo" long_arm_plist)) (cons "zo" (+ (nt_val "zo" long_arm_plist) 15)) (cons "x1o" (+ (nt_val "xo" long_arm_plist) 41)) (cons "y1o" (nt_val "yo" long_arm_plist)) (cons "z1o" (+ (nt_val "zo" long_arm_plist) 15)) (cons "para" (nt_val "para" long_arm_plist)))) (setq f_plist nil) (list f_plist c_plist) ) ;''''''''''''''''''''''''''''''''''''''''; ; canti_petal--->two_connection_blocks ; ;,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,; (defun canti_petal--->two_connection_blocks (canti_petal_list trans_plist / canti_petal_plist c_plist f_plist) (setq canti_petal_plist (nt_plist (car canti_petal_list))) (setq width (nt_val "width" canti_petal_plist)) (setq dis (- (/ width 2.0) 6)) (setq c_plist (list (cons "xo" (nt_val "xo" canti_petal_plist)) (cons "yo" (+ (nt_val "yo" canti_petal_plist) dis)) (cons "zo" (+ (nt_val "zo" canti_petal_plist) 15)) (cons "x1o" (nt_val "xo" canti_petal_plist)) (cons "y1o" (- (nt_val "yo" canti_petal_plist) dis)) (cons "z1o" (+ (nt_val "zo" canti_petal_plist) 15)) (cons "para" (nt_val "para" canti_petal_plist)))) (setq f_plist nil) (list f_plist c_plist) ) ;; modified by Takehiko Nagakura, 2005.1.31 (terpri) (prompt "To change the grade, type grade (default = 2).") (princ)