home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 15 / CD_ASCQ_15_070894.iso / vrac / may94cad.zip / KJOIST.LSP < prev    next >
Text File  |  1994-04-25  |  8KB  |  265 lines
  1. ;; KJOIST.LSP
  2. ;; Program For K-Series Bar Joists Dialog Box Menu
  3. ;; Copyright (c) Barry R. Bowen 1989-94
  4. ;; All rights reserved
  5. ;;
  6.  
  7. (prompt "\nLoading KJOIST...")
  8. (defun JOIST (BNAME DEPTH / DIST EN EN1 EN2 JBPT JLGTH
  9.               LGTH PT PT1 PT2 PT3 PT4 PT5 PT6 PT7 PT8 PT9
  10.               PT10 PT1A PT1B PT5A PT6A PT6B PT9A PT10A PT10B
  11.               DIST SL1)
  12.   (ZC DEPTH)
  13.   (setq SL1 nil)
  14.   (cond
  15.    ((= KVW "E")
  16.     (if (= KBR "S") (setq LGTH 2.5) (setq LGTH 4))
  17.     (setq JBPT (getpoint "\nEdge of Bearing Point: ")
  18.          JLGTH (getdist JBPT "\nPartial Length of Joist: "))
  19.     (if (< JLGTH (* 1.75 DEPTH)) (setq JLGTH (* 2 DEPTH)))
  20.     (ZC JLGTH)
  21.     (if (= KXT "N")
  22.       (progn (setq PT4 (polar JBPT pi LGTH)
  23.                   DIST (distance JBPT PT4)))
  24.       (progn
  25.         (setq DIST (getdist JBPT "\nEnd Extension Length: ")
  26.                PT4 (polar JBPT pi DIST)))
  27.     )
  28. ; ---------------------------- Required Points For Top Cord
  29.     (setq JLGTH (+ DIST JLGTH)
  30.             PT3 (polar JBPT 0 0.5)
  31.            PT3A (polar PT3 (D90) 0.25)
  32.             PT2 (polar PT3 (D90) 1.25)
  33.            PT4A (polar PT4 (D90) 0.25)
  34.            PT4B (polar PT4 (D90) 1.25)
  35.             PT5 (polar PT4 (D90) 2.5)
  36.            PT5A (polar PT5 (D270) 0.25)
  37.             PT1 (polar PT4B 0 JLGTH)
  38.             PT6 (polar PT5 0 JLGTH)
  39.            PT6A (polar PT6 (D270) 0.25)
  40. ; ---------------------------- Required Points For Bottom Cord
  41.            PT7A (polar PT5 (D270) (- DEPTH 1.25))
  42.             PT7 (polar PT7A 0 JLGTH)
  43.            TPT1 (polar PT2 pi 2.0)
  44.            TPT2 (polar TPT1 5.764688 (* 1.5 DEPTH))
  45.             PT8 (inters TPT1 TPT2 PT7A PT7 nil)
  46.            PT8A (inters TPT1 TPT2 PT3 PT2 nil)
  47.             PT9 (polar PT8 pi 2.0)
  48.            PT10 (polar PT9 (D270) 1.25)
  49.           PT10A (polar PT10 (D90) 0.25)
  50.            PT11 (polar PT7 (D270) 1.25)
  51.           PT11A (polar PT11 (D90) 0.25)
  52. ; --------------------------- Required Points For Web
  53.            PT12 (inters TPT1 PT8 PT3 PT2 nil)
  54.            PT13 (polar PT8 0 0.7567)
  55.            PT14 (polar PT12 (D90) 0.4317)
  56.            PT15 (polar PT8 0 1.4375)
  57.            PT16 (polar PT15 (D135) 12)
  58.            PT16 (inters PT15 PT16 PT1 PT2 nil)
  59.            PT17 (polar PT15 0 0.55)
  60.            PT18 (polar PT16 0 0.55)
  61.            PT19 (polar PT17 0 0.5250)
  62.            PT20 (polar PT19 (D45) 12)
  63.            PT20 (inters PT19 PT20 PT1 PT7 nil)
  64.            PT21 (polar PT19 0 0.55)
  65.            PT22 (polar PT21 (D45) 12)
  66.            PT22 (inters PT21 PT22 PT1 PT7 nil))
  67. ; ------------------------------------------ Draw Top Cord
  68.     (command "pline" PT1 "W" 0 0 PT2 PT3 PT4 PT5 PT6 ""
  69.              "line" PT5A PT6A ""
  70.              "line" PT4B PT2 ""
  71.              "line" PT4A PT3A ""
  72. ; ------------------------------------------ Draw Bottom Cord
  73.              "pline" PT7 PT9 PT10 PT11 ""
  74.              "line" PT10A PT11A ""
  75. ; ------------------------------------------ Draw Web Lines
  76.              "line" PT8 PT8A ""
  77.              "line" PT13 PT14 ""
  78.              "line" PT15 PT16 ""
  79.              "line" PT17 PT18 ""
  80.              "line" PT19 PT20 "")
  81.     (CKEXT PT1 PT2 T)
  82.     (command "line" PT21 PT22 "")
  83.     (CKEXT PT1 PT2 T)
  84.    ) ;end first cond
  85.    (T  (JSEC))
  86.   ) ;end cond
  87. )
  88.  
  89. (defun C:KJOIST (/ reset show_j KJ814 KJ16 KJ18 KJ20
  90.      KJ22 KJ24 KJ26 KJ28 KJ30 get_ksz ck_out getimg get_sze
  91.      KLIST JX FILE dcl_id old_cmd KSZCK old_error what_next)
  92.  
  93.  (setq KJDR# "c:/cadalyst/94apr/")
  94.  
  95. (defun reset () (set_tile "error" ""))
  96.  
  97. (defun jsec1 ()
  98.   (foreach N '("eenor" "eext" "bconc" "bstl") (mode_tile N 1)))
  99.  
  100. (defun jelv ()
  101.   (foreach N '("eenor" "eext" "bconc" "bstl") (mode_tile N 0)))
  102.  
  103. (defun show_j ()
  104.   (set_tile "ksize" "")
  105.   (start_list "ksize")
  106.   (mapcar 'add_list JLIST)
  107.   (end_list)
  108. )
  109.  
  110.  (defun KJ814 ()
  111.    (setq JLIST (list "8K1" "10K1" "12K1" "12K3" "12K5"
  112.                      "14K1" "14K3" "14K4" "14K6"))
  113.  )
  114.  
  115.  (defun KJ16 ()
  116.    (setq JLIST (list "16K2" "16K3" "16K4" "16K5" "16K6"
  117.                      "16K7" "16K9"))
  118.  )
  119.  
  120. (defun get_ksz ()
  121.   (setq ksz (nth (atoi X) KLIST))
  122.   (cond
  123.     ((= ksz "8-14") (KJ814) (show_j))
  124.     ((= ksz "  16") (KJ16) (show_j))
  125.   )
  126. )
  127.  
  128. (defun ck_out ()
  129.   (if (/= KSZCK nil) (progn
  130.   (cond
  131.     ((= (get_tile "velv") "1") (setq KVW "E"))
  132.     ((= (get_tile "vsec") "1") (setq KVW "S"))
  133.   )
  134.   (cond
  135.     ((= (get_tile "bconc") "1") (setq KBR "C"))
  136.     ((= (get_tile "bstl") "1") (setq KBR "S"))
  137.   )
  138.   (cond
  139.     ((= (get_tile "eenor") "1") (setq KXT "N"))
  140.     ((= (get_tile "eext") "1") (setq KXT "E"))
  141.   )
  142.   (done_dialog 4)
  143.  );end first progn
  144.  (progn
  145.    (set_tile "error" "You Must Select A Size!")
  146.    (mode_tile "ksize" 2)
  147.  ))
  148. )
  149.  
  150. (defun getimg ()
  151.   (if (= JX 1) (setq KV "KJELV") (setq KV "KJSEC"))
  152.   (set_tile "kjimg" "")
  153.   (setq x (dimx_tile "kjimg"))
  154.   (setq y (dimy_tile "kjimg"))
  155.   (start_image "kjimg")
  156.   (slide_image 0 0 x y (strcat KJDR# KV))
  157.   (end_image)
  158. )
  159.  
  160. (defun get_sze ()
  161.   (setq JSZ (nth (atoi X) JLIST) JL (strlen JSZ))
  162.   (if (= JL 3) (setq JSIZE (substr JSZ 1 1))
  163.                (setq JSIZE (substr JSZ 1 2))
  164.   )
  165.   (setq JSIZE (distof JSIZE))
  166. )
  167.  
  168.   (setvar "cmdecho" 0)
  169.   (setq what_next 4 start_1 nil)
  170.   (setq dcl_id (load_dialog (strcat KJDR# "kjoist.dcl")))
  171.   (if (not (new_dialog "kjoist" dcl_id)) (exit))
  172.  
  173.   (setq KLIST (list "8-14" "  16"))
  174.  
  175.   (start_list "ksiz")
  176.   (mapcar 'add_list KLIST)
  177.   (end_list)
  178.  
  179.   (action_tile "velv"  "(jelv) (setq JX 1) (getimg)")
  180.   (action_tile "vsec"  "(jsec1) (setq JX 2) (getimg)")
  181.   (action_tile "ksiz"  "(reset)  (setq X $value) (get_ksz)")
  182.   (action_tile "ksize" "(reset) (setq X $value KSZCK 1) (get_sze)")
  183.   (action_tile "accept"   "(ck_out)")
  184.   (action_tile "cancel"   "(done_dialog 0)")
  185.  
  186.   (set_tile "eenor" "2")
  187.   (set_tile "bstl"  "2")
  188.   (set_tile "velv"  "2")
  189.  
  190.   (setq x (dimx_tile "kjimg"))
  191.   (setq y (dimy_tile "kjimg"))
  192.   (start_image "kjimg")
  193.   (slide_image 0 0 x y (strcat KJDR# "KJELV"))
  194.   (end_image)
  195.  
  196.   (KJ814)
  197.   (start_list "ksize")
  198.   (mapcar 'add_list JLIST)
  199.   (end_list)
  200.  
  201.   (setq what_next (start_dialog))
  202.   (if (= what_next 4) (joist jsz jsize))
  203.   (unload_dialog dcl_id)
  204.  
  205.   (princ)
  206. );end main defun
  207.  
  208.  
  209.  
  210. (defun CKEXT (X1 X2 X3 / C D E)
  211.  (setq ELIST (entget (entlast))
  212.            C (E4 10 ELIST)
  213.            D (E4 11 ELIST)
  214.            E (inters C D X1 X2 X3))
  215.   (if (/= E nil)
  216.     (progn
  217.       (command "erase" (entlast) ""
  218.                "line" C E "")
  219.   ) )
  220. )
  221.  
  222. (defun JSEC (/ DIST PT1 PT2 PT3)
  223.   (setq PT1 (getpoint "\nTop of Joist: ")
  224.         PT2 (polar PT1 (D270) DEPTH))
  225.   (if (/= (tblsearch "block" BNAME) nil)
  226.     (command "insert" BNAME PT1 1 1 0)
  227.     (progn
  228.       (command "insert" (strcat KJDR# "joistsec") PT1 "" "" "")
  229.       (setq SL1 (ssadd (entlast)))
  230.       (command "insert" "" PT2 "1" "-1" "")
  231.       (SSET)
  232.       (setq PT3 (polar (polar PT1 0 0.125) (D270) 1.25)
  233.            DIST (- DEPTH 2.5))
  234.       (command "insert" (strcat KJDR# "WEB") PT3 "1" DIST "")
  235.       (SSET)
  236.       (BLOCKIT)
  237.   ) )
  238. )
  239.  
  240. (defun D45 () (* pi 0.25))
  241. (defun D90 () (* pi 0.5))
  242. (defun D135 () (* pi 0.75))
  243. (defun D270 () (* pi 1.5))
  244.  
  245. (defun BLOCKIT ()
  246.   (command "block" BNAME PT1 SL1 ""
  247.            "insert" BNAME PT1 "1" "1" "0")
  248.   (setq SL1 (ssget "L"))
  249. )
  250.  
  251. (defun ZC (X) (if (> X (VS)) (command "zoom" "c" (VC) (* 1.5 X))))
  252.  
  253. (defun VC () (getvar "viewctr"))
  254.  
  255. (defun VS () (getvar "viewsize"))
  256.  
  257. (defun SSET () (setq SL1 (ssadd (entlast) SL1)))
  258.  
  259. (defun E4 (NO EVAR1) (cdr (assoc NO EVAR1)))
  260.  
  261. (prompt "K-Series Bar Joist Module Loaded....")
  262. (prompt "\nCopyright Barry R. Bowen 1989-94")
  263. (princ)
  264. 
  265.