home *** CD-ROM | disk | FTP | other *** search
/ Share Gallery 1 / share_gal_1.zip / share_gal_1 / GR / GR505.ZIP / LSP.EXE / SDBEAM.LSP < prev    next >
Lisp/Scheme  |  1988-08-20  |  29KB  |  441 lines
  1.  
  2. (defun c:sdbeam ()
  3.  
  4.    (vmon)
  5.    (graphscr)
  6.    (terpri)
  7.    (princ "Copyright 1988, Jerry Montgomery, All Rights Reserved")
  8.    (setvar "blipmode" 0)(setvar "cmdecho" 0)(setvar "highlight" 0)
  9.    (terpri)
  10.    (newd)
  11.    (losc)
  12.    (inatr)
  13.    (points)
  14.    (draw)
  15.    (angle)
  16.    (block)
  17.    (dimb)
  18.    (if (= lout "Y")(command "zoom" "p" ))
  19.    (command "insert" "posn" "0,0" "" "" "" posn)
  20.    (if (and (= lout "Y")(= posn 9))(lin))
  21.    (setvar "blipmode" 1)(setvar "cmdecho" 1)(setvar "highlight" 1)
  22. )
  23.  
  24. ;*******************************************************************;
  25. ;Test for new drawing                                               ;
  26.                                                                     ;
  27. (defun newd ( / z)                                                  ;
  28.    (setq z(entlast))                                                ;
  29.       (if(= z nil)                                                  ;
  30.       (progn                                                        ;
  31.          (setq posn 0)                                              ;
  32.          (command "dim" "dimtad" "on" "dimtoh" "off" "dimtsz" ".05" ;
  33.          "dimtih" "off" "dimtxt" "0.125" ^c "layer" "s" "bom" ""    ;
  34.          "insert" "blo" "0,0" "" "" "" "layer" "s" "graphics" "")   ;
  35.       )                                                             ;
  36.          (setq posn (atoi (cdr (assoc 1 (entget (entnext z))))))    ;
  37.       )                                                             ;
  38. )                                                                   ;
  39. ;*******************************************************************;
  40.  
  41. ;*****************************************************************************;
  42. ;Get scaling and layout modes                                                 ;
  43.                                                                               ;
  44. (defun losc ( / check)                                                        ;
  45.    (setq check "n")                                                           ;
  46.    (while check                                                               ;
  47.       (prompt "Use automatic layout and scaling?  [Y]es or [N]o  <Y>  ")      ;
  48.       (setq lout(getstring))                                                  ;
  49.       (setq lout(strcase lout))                                               ;
  50.          (if(or(= lout "Y")(= lout ""))                                       ;
  51.          (progn                                                               ;
  52.          (setq lout "Y")                                                      ;
  53.          (getposn)(data)                                                      ;
  54.          (setq l 6 w (* (atoi width) 0.125) check nil)                        ;
  55.          ))                                                                   ;
  56.          (if (= lout "N")                                                     ;
  57.          (progn                                                               ;
  58.             (setq default                                                     ;
  59.             (getstring "Use automatic scaling only?  [Y]es [N]o  <Y>  "))     ;
  60.             (setq default (strcase default))(terpri)                          ;
  61.                (if (or (= default "Y")(= default ""))                         ;
  62.                (progn (setq default "Y")                                      ;
  63.                (setq posn(+ posn 1))(data)(terpri)                            ;
  64.                (prompt "Digitize lower left hand corner of BEAM.")(terpri)    ;
  65.                (setq p1 (getpoint))                                           ;
  66.                (setq l 6 w (* (atoi width) 0.125) check nil)                  ;
  67.                ))                                                             ;
  68.                (if (= default "N")                                            ;
  69.                (progn                                                         ;
  70.                (setq check nil)(terpri)                                       ;
  71.                (setq posn(+ posn 1))(data)(terpri)                            ;
  72.                (prompt "Digitize lower left hand corner of BEAM.")(terpri)    ;
  73.                (setq p1 (getpoint))                                           ;
  74.                (setq l                                                        ;
  75.                (getdist "Enter LENGTH of beam in inches to be drawn.  "))     ;
  76.                (terpri)                                                       ;
  77.                (setq w                                                        ;
  78.                (getdist "Enter WIDTH of beam in inches to be drawn.  "))      ;
  79.                (terpri)                                                       ;
  80.                ))                                                             ;
  81.           ))                                                                  ;
  82.    )                                                                          ;
  83. )                                                                             ;
  84. ;*****************************************************************************;
  85.  
  86. ;*****************************************************************************;
  87. ;Input data section                                                           ;
  88.                                                                               ;
  89. (defun data ( / check hold pstring)                                           ;
  90.    (if (= reqd nil)(setq reqd "ONE"))                                         ;
  91.    (if (= width nil)(setq width "14"))                                        ;
  92.    (if (= weight nil)(setq weight "22"))                                      ;
  93.    (if (= feet nil)(setq feet "0"))                                           ;
  94.    (if (= inch nil)(setq inch "0"))                                           ;
  95.    (if (= rmrk nil)(setq rmrk " "))                                           ;
  96.    (if (= mark nil)(setq mark "B1"))                                          ;
  97.                                                                               ;
  98.    (setq check "n")                                                           ;
  99.    (while check                                                               ;
  100.       (terpri)                                                                ;
  101.       (setq hold width)                                                       ;
  102.       (setq pstring                                                           ;
  103.       (strcat "Enter the actual WIDTH of the beam in inches. <" width ">  ")) ;
  104.       (princ pstring)(setq width (getstring))                                 ;
  105.       (if (= width "")(setq width hold))(terpri)                              ;
  106.                                                                               ;
  107.       (setq hold weight)                                                      ;
  108.       (setq pstring                                                           ;
  109.       (strcat "Enter the actual WEIGHT of the beam in lbs/ft. <" weight ">  "))
  110.       (princ pstring)(setq weight (getstring))                                ;
  111.       (if (= weight "")(setq weight hold))(terpri)                            ;
  112.                                                                               ;
  113.       (setq hold feet)                                                        ;
  114.       (prompt "Enter the actual LENGTH of the beam.")(terpri)                 ;
  115.       (setq pstring (strcat "Enter FEET. <" feet ">  "))                      ;
  116.       (princ pstring)(setq feet (getstring))                                  ;
  117.       (if (= feet "")(setq feet hold));(terpri)                               ;
  118.                                                                               ;
  119.       (setq hold inch)                                                        ;
  120.       (setq pstring (strcat "Enter INCHES. <" inch ">  "))                    ;
  121.       (princ pstring)(setq inch (getstring))                                  ;
  122.       (if (= inch "")(setq inch hold))(terpri)                                ;
  123.                                                                               ;
  124.       (setq hold mark)                                                        ;
  125.       (setq pstring (strcat "Enter the ID MARK. <" mark ">  "))               ;
  126.       (princ pstring)(setq mark (getstring))                                  ;
  127.       (if (= mark "")(setq mark hold))(terpri)                                ;
  128.                                                                               ;
  129.       (setq hold reqd)                                                        ;
  130.       (setq pstring                                                           ;
  131.       (strcat "Enter the NUMBER REQUIRED. <" reqd ">  "))                     ;
  132.       (princ pstring)(setq reqd (getstring))                                  ;
  133.       (if (= reqd "")(setq reqd hold))(terpri)                                ;
  134.                                                                               ;
  135.       (setq hold rmrk)                                                        ;
  136.       (setq pstring (strcat "Enter REMARKS. <" rmrk ">  "))                   ;
  137.       (princ pstring)(setq rmrk (getstring 1))                                ;
  138.       (if (= rmrk "")(setq rmrk hold))(terpri)                                ;
  139.                                                                               ;
  140.       (setq check                                                             ;
  141.       (getstring "Do you want to check these values?  [Y]es [N]o  <N>  "))    ;
  142.       (setq check(strcase check))                                             ;
  143.       (if (or (= check "")(= check "N"))(setq check nil))                     ;
  144.    )                                                                          ;
  145. )                                                                             ;
  146. ;*****************************************************************************;
  147.  
  148. ;***************************************************************;
  149. ;Get x,y position of beam point                                 ;
  150.                                                                 ;
  151. (defun getposn ( / z1 )                                         ;
  152.    (if(= lout "Y")(progn                                        ;
  153.      (setq posn(+ posn 1))                                      ;
  154.      (if(= posn 1)(setq p1 '(2.75 19) z1 '(1.25 16.125)))       ;
  155.      (if(= posn 2)(setq p1 '(12.25 19) z1 '(10.75 16.125)))     ;
  156.      (if(= posn 3)(setq p1 '(21.75 19) z1 '(20.25 16.125)))     ;
  157.      (if(= posn 4)(setq p1 '(2.75 11.34) z1 '(1.25 8.4375)))    ;
  158.      (if(= posn 5)(setq p1 '(12.25 11.34) z1 '(10.75 8.4375)))  ;
  159.      (if(= posn 6)(setq p1 '(21.75 11.34) z1 '(20.25 8.4375)))  ;
  160.      (if(= posn 7)(setq p1 '(2.75 3.68) z1 '(1.25 0.75)))       ;
  161.      (if(= posn 8)(setq p1 '(12.25 3.68) z1 '(10.75 0.75)))     ;
  162.      (if(= posn 9)(setq p1 '(21.75 3.68) z1 '(20.25 0.75)))     ;
  163.      (command "zoom" "w" z1 "@9,7")                             ;
  164.    ))                                                           ;
  165. )                                                               ;
  166. ;***************************************************************;
  167.  
  168. ;*****************************************************************************;
  169. ;Insert attributes                                                            ;
  170.                                                                               ;
  171. (defun inatr ( / xpt ypt bompt section)                                       ;
  172.    (setq section(strcat "W" width "x" weight "x"))                            ;
  173.    (if (<= (strlen inch) 3)(strcat "  " inch))                                ;
  174.    (setq xpt 29.5 ypt (- 23 posn))                                            ;
  175.    (setq bompt (list xpt ypt))                                                ;
  176.    (command "layer" "s" "dim" "")                                             ;
  177.    (command "insert" "bmb" bompt "" "" ""  reqd mark section feet inch rmrk)  ;
  178.    (command "layer" "s" "graphics" "")                                        ;
  179. )                                                                             ;
  180. ;*****************************************************************************;
  181.  
  182. ;*********************************************************;
  183. ;Points for plotting beams                                ;
  184.                                                           ;
  185. (defun points ( / osr )                                   ;
  186.                                                           ;
  187.    (setq blockx 0.5 blocky 0.25 fwidth 0.0625 aos 0.375)  ;
  188.    (setq osr 0.125 bp 0.51625 bpu 1.0625)                 ;
  189.    (setq p2(list(+(car p1)blockx)(cadr p1)))              ;
  190.    (setq p3(list(+(car p1)(/ l 2))(cadr p1)))             ;
  191.    (setq p4(list(car p1)(+(cadr p1)fwidth)))              ;
  192.    (setq p5(list(car p2)(cadr p4)))                       ;
  193.    (setq p6(list(car p3)(cadr p4)))                       ;
  194.    (setq p7(list(car p1)(+(cadr p1)blocky)))              ;
  195.    (setq p8(list(car p1)(+(cadr p1)(/ w 2))))             ;
  196.    (setq p9(list(car p1)(+(cadr p1)w)))                   ;
  197.    (setq p10(list(+(car p1)l)(+(cadr p1)w)))              ;
  198.    (setq p11(list(+(car p1)l)(cadr p1)))                  ;
  199.    (setq p12(list(car p2)(-(cadr p9)blocky)))             ;
  200.    (setq p13(list(-(car p11)blockx)(cadr p12)))           ;
  201.    (setq p14(list(-(car p13)fwidth)(+(cadr p7)fwidth)))   ;
  202.    (setq p15(list(car p1)(+(cadr p1)aos)))                ;
  203.    (setq p16(list(car p1)(-(cadr p9)aos)))                ;
  204.    (setq p17(list(+(car p1)0.375)(cadr p15)))             ;
  205.    (setq p18(list(car p17)(cadr p16)))                    ;
  206.    (setq p19(list(-(car p1)osr)(cadr p16)))               ;
  207.    (setq p20(list(car p19)(cadr p15)))                    ;
  208.    (setq p21(list(-(car p20)fwidth)(cadr p15)))           ;
  209.    (setq p22(list(car p21)(cadr p16)))                    ;
  210.    (setq p23(list(-(car p22)fwidth)(cadr p9)))            ;
  211.    (setq p24(list(-(car p22)fwidth)(+(cadr p22)fwidth)))  ;
  212.    (setq p25(list(+(car p17)fwidth)(-(cadr p17)fwidth)))  ;
  213.    (setq p26(list(+(car p11)fwidth)(+(cadr p11)blockx)))  ;
  214.    (setq p27(list(-(car p10)fwidth)(-(cadr p10)blockx)))  ;
  215.    (setq p28(list(+(car p15)fwidth)(+(cadr p15)osr)))     ;
  216.    (setq p29(list(-(car p16)fwidth)(-(cadr p16)osr)))     ;
  217.    (setq p30(list(car p3)(-(cadr p3)1.75)))               ;
  218. )                                                         ;
  219. ;*********************************************************;
  220.  
  221. ;**********************************************************;
  222. ;Draw beam                                                 ;
  223.                                                            ;
  224. (defun draw ( / p33 p34 p35 )                              ;
  225.    (command "line" p1 p2 p3 "" )                           ;
  226.    (command "line" p1 p4 p5 p6 "")                         ;
  227.    (command "line" p4 p7 p8 "")                            ;
  228.    (setq p34(list(+(car p3)blocky)(- (cadr p3) blocky)))   ;
  229.    (setq p35(list(-(car p8)blocky)(+ (cadr p8) blocky)))   ;
  230.    (command "mirror" "w" p35 p34 "" p8 "@1,0" "")          ;
  231.    (setq p33(list(-(car p9)blocky)(+ (cadr p9) blocky)))   ;
  232.    (command "mirror" "w" p33 p34 "" p3 "@0,1" "")          ;
  233. )                                                          ;
  234. ;**********************************************************;
  235.  
  236. ;*************************************************************************;
  237. ;Add angles                                                               ;
  238.                                                                           ;
  239. (defun angle ( / p36 )                                                    ;
  240.    (terpri)(terpri)                                                       ;
  241.    (princ "Add angle bracket(s)?  [N]one [L]eft [R]ight [B]oth  <N>   ")  ;
  242.    (setq angles(getstring))                                               ;
  243.    (if (= angles "")(setq angles "N"))                                    ;
  244.    (setq angles(strcase angles))                                          ;
  245.    (terpri)                                                               ;
  246.    (if(not (= angles "N"))                                                ;
  247.    (progn                                                                 ;
  248.    (command "erase" "c" p28  p29 "")                                      ;
  249.    (command "line" p7 p15 p17 p18 p16 "@0,0.125" "")                      ;
  250.    (command "line" p20 p21 p22 p19 "")(command "line" p16 p19 p20 p15 "") ;
  251.    (if(= angles "R")(progn                                                ;
  252.    (setq p36(list(+(car p11)fwidth)(cadr p11)))                           ;
  253.    (command "mirror" "w" p23 p36 "" p3 p6 "y")(command "redraw")))        ;
  254.    (if(= angles "B")(progn                                                ;
  255.    (command "erase" "c" p26 p27 "")                                       ;
  256.    (command "mirror" "c" p24 p25 "" p3 "@0,1" "")))                       ;
  257.    ))                                                                     ;
  258.    (setq dos 0.1875)                                                      ;
  259.    (setq b1 p1 b4 p11)                                                    ;
  260.    (if(or(= angles "L")(= angles "B"))                                    ;
  261.       (setq b1(list(-(car p1)dos)(+(cadr p1)aos))))                       ;
  262.    (if(or(= angles "R")(= angles "B"))                                    ;
  263.       (setq b4(list(+(car p11)dos)(+(cadr p1)aos))))                      ;
  264. )                                                                         ;
  265. ;*************************************************************************;
  266.  
  267. ;***************************************************************;
  268. ;Block corners                                                  ;
  269.                                                                 ;
  270. (defun block ( / bstring blockit counter tx1 tx2 t1 t2 p31 p41  ;
  271.               p37 p38 p39 p40)                                  ;
  272.                                                                 ;
  273.    (setq counter 0)                                             ;
  274.    (while counter                                               ;
  275.       (setq counter (+ counter 1) blockit "N")                  ;
  276.       (if(= counter 1)(progn                                    ;
  277.       (setq bstring "Block lower left?")(blkit)                 ;
  278.          (if(= blockit "Y")(progn                               ;
  279.          (setq p2(list(+(car p2)fwidth)(-(cadr p2)fwidth)))     ;
  280.          (setq p41(list(-(car p7)fwidth)(+(cadr p7)fwidth)))    ;
  281.          (command "erase" "w" p41 p2 "")                        ;
  282.          (command "insert" "cornerbk" p1 "" "" "")              ;
  283.             (if(or(= angles "N")(= angles "R"))                 ;
  284.             (setq b1(list(car p1)(+(cadr p1)blocky))))          ;
  285.          (gettxt)                                               ;
  286.          (setq t1 (list (+ (car p1) blocky)(- (cadr p1) bp)))   ;
  287.          (setq t2 (list (+ (car t1) aos)(cadr t1)))             ;
  288.          (command "layer" "s" "dim" "")                         ;
  289.             (if (or (= angles "N")(= angles "R"))               ;
  290.             (command "insert" "dblkb2" p7 "1" "1" "")           ;
  291.             (command "insert" "dblkb" p7 "1" "1" ""))           ;
  292.          (puttxt)                                               ;
  293.          ))                                                     ;
  294.       ))                                                        ;
  295.                                                                 ;
  296.       (if (= counter 2)(progn                                   ;
  297.       (setq bstring "Block upper left?")(blkit)                 ;
  298.          (if(= blockit "Y")(progn                               ;
  299.          (setq p39(list(-(car p9)fwidth)(+(cadr p9)fwidth)))    ;
  300.          (setq p40(list(+(car p12)fwidth)(-(cadr p12)fwidth)))  ;
  301.          (command "erase" "w" p39 p40 "")                       ;
  302.          (command "insert" "cornerbk" p9 "1" "-1" "")           ;
  303.          (gettxt)                                               ;
  304.          (setq bd2 (list (car p1)(- (cadr p9)blocky)))          ;
  305.          (setq t1 (list (+ (car p1) blocky)(+ (cadr bd2) bpu))) ;
  306.          (setq t2 (list (+ (car t1) aos)(cadr t1)))             ;
  307.          (command "layer" "s" "dim" "")                         ;
  308.          (command "insert" "dblk" bd2 "1" "1" "")               ;
  309.          (puttxt)                                               ;
  310.          ))                                                     ;
  311.       ))                                                        ;
  312.                                                                 ;
  313.       (if(= counter 3)(progn                                    ;
  314.       (setq bstring "Block upper right?")(blkit)                ;
  315.          (if(= blockit "Y")(progn                               ;
  316.          (setq p37(list(-(car p13)fwidth)(-(cadr p13)fwidth)))  ;
  317.          (setq p38(list(+(car p10)fwidth)(+(cadr p10)fwidth)))  ;
  318.          (command "erase" "w" p37 p38 "")                       ;
  319.          (command "insert" "cornerbk" p10 "-1" "-1" "")         ;
  320.          (gettxt)                                               ;
  321.          (setq bd2 (list (car p10)(- (cadr p10)blocky)))        ;
  322.          (setq t1 (list (- (car p10) blocky)(+ (cadr bd2) bpu)));
  323.          (setq t2 (list (+ (car t1) aos)(cadr t1)))             ;
  324.          (command "layer" "s" "dim" "")                         ;
  325.          (command "insert" "dblkb" bd2 "-1" "-1" "")            ;
  326.          (puttxt)                                               ;
  327.          ))                                                     ;
  328.        ))                                                       ;
  329.                                                                 ;
  330.       (if (= counter 4)(progn                                   ;
  331.       (setq counter nil)                                        ;
  332.       (setq bstring "Block lower right?")(blkit)                ;
  333.          (if(= blockit "Y")(progn                               ;
  334.          (setq p31(list(car p11)(- (cadr p11) blocky)))         ;
  335.          (command "erase" "w" p14 p31 "")                       ;
  336.          (command "insert" "cornerbk" p11 "-1" "1" "")          ;
  337.             (if(or(= angles "N")(= angles "L"))                 ;
  338.             (setq b4(list(car p11)(+(cadr p11)blocky))))        ;
  339.          (gettxt)                                               ;
  340.          (setq bd4 (list (car p11)(+ (cadr p11)blocky)))        ;
  341.          (setq t1 (list (- (car p11) blocky)(- (cadr p11) bp))) ;
  342.             (if (or (= angles "R")(= angles "B"))               ;
  343.             (setq t2 (list (+ (car t1) blockx)(cadr t1)))       ;
  344.             (setq t2 (list (+ (car t1) aos)(cadr t1))))         ;
  345.          (command "layer" "s" "dim" "")                         ;
  346.             (if (or (= angles "L")(= angles "N"))               ;
  347.             (command "insert" "dblk2" bd4 "1" "1" "")           ;
  348.             (command "insert" "dblk" bd4 "-1" "-1" ""))         ;
  349.          (puttxt)                                               ;
  350.          ))                                                     ;
  351.       ))                                                        ;
  352.    )                                                            ;
  353. )                                                               ;
  354. ;***************************************************************;
  355.  
  356. ;******************************************************************************;
  357. ;Dimension beam                                                                ;
  358.                                                                                ;
  359. (defun dimb ( / ans)                                                           ;
  360.   (setq ans                                                                    ;
  361.   (strcat reqd " REQ'D " "W" width "x" weight "x" feet "'-" inch  (chr 34)))   ;
  362.   (command "layer" "s" "dim" "")                                               ;
  363.   (command "dim" "horiz" b1 b4 p30 ans ^c)                                     ;
  364.   (command "layer" "s" "graphics" "")                                          ;
  365. )                                                                              ;
  366. ;******************************************************************************;
  367.  
  368. ;**********************************************;
  369. ;Draw borders                                  ;
  370.                                                ;
  371. (defun lin ()                                  ;
  372.      (command "layer" "s" "bom" "")            ;
  373.      (command "line" "10.5,0.5" "@0,23" "")    ;
  374.      (command "line" "20,0.5" "@0,23" "")      ;
  375.      (command "line" "29.5,2" "@0,12.0" "")    ;
  376.      (command "line" "1,8.2"  "@28.5,0" "")    ;
  377.      (command "line" "1,15.9"  "@28.5,0" "")   ;
  378.      (command "layer" "s" "graphics" "")       ;
  379. )                                              ;
  380. ;**********************************************;
  381.  
  382. ;************************************************************************;
  383. ;Get block dimensions                                                    ;
  384.                                                                          ;
  385. (defun gettxt ( / hold1 hold2 pstring pstg check)                        ;
  386.    (setq check "n")                                                      ;
  387.    (while check                                                          ;
  388.       (if (= txt1 nil)(setq txt1 " "))                                   ;
  389.       (if (= txt2 nil)(setq txt2 " "))                                   ;
  390.       (setq hold1 txt1 hold2 txt2)                                       ;
  391.       (setq pstg (strcat "Enter the block dimensions.  "));              ;
  392.       (prompt pstg)(terpri)                                              ;
  393.       (setq pstring                                                      ;
  394.       (strcat "Enter INCHES in the horizontal direction. <" txt1 ">  ")) ;
  395.       (princ pstring)(setq txt1 (getstring))                             ;
  396.       (if (= txt1 "")(setq txt1 hold1));(terpri)                         ;
  397.       (setq pstring                                                      ;
  398.       (strcat "Enter INCHES in the vertical direction. <" txt2 ">  "))   ;
  399.       (princ pstring)(setq txt2 (getstring))                             ;
  400.       (if (= txt2 "")(setq txt2 hold2))(terpri)                          ;
  401.       (setq check                                                        ;
  402.       (getstring "Do you want to check these values?  [Y]es [N]o  <N>  "))
  403.       (setq check(strcase check))                                        ;
  404.       (if (or (= check "")(= check "N"))(setq check nil)(terpri))        ;
  405.       (setq tx1 (strcat txt1 (chr 34)) tx2 (strcat " x " txt2 (chr 34))) ;
  406.    )                                                                     ;
  407. )                                                                        ;
  408. ;************************************************************************;
  409.  
  410. ;****************************************************;
  411. ;Put block text in drawing                           ;
  412.                                                      ;
  413. (defun puttxt ( / fd1 fd2)                           ;
  414.    (if (> (strlen tx1) 3)                            ;
  415.    (progn                                            ;
  416.       (setq fd1 (list (- (car t1) 0.22)(cadr t1)))   ;
  417.       (setq fd2 (list (+ (car t1) 0.22)(cadr t1)))   ;
  418.       (command "text" "f" fd1 fd2 "0.1" tx1))        ;
  419.       (command "text" "c" t1 "0.1" "0" tx1)          ;
  420.    )                                                 ;
  421.    (command "text" t2 "0.1" "0" tx2)                 ;
  422.    (command "layer" "s" "graphics" "")               ;
  423. )                                                    ;
  424. ;****************************************************;
  425.  
  426. ;*********************************************************************;
  427. ;Block this corner?                                                   ;
  428.                                                                       ;
  429. (defun blkit ( / c )                                                  ;
  430.     (terpri)(setq c "b")                                              ;
  431.     (while c                                                          ;
  432.        (princ bstring)                                                ;
  433.        (setq blockit                                                  ;
  434.        (getstring "  [Y]es or [N]o  <N>  "))(terpri)                  ;
  435.        (setq blockit(strcase blockit))(if(= blockit "Y")(setq c nil)) ;
  436.           (if(or(= blockit "N")(= blockit ""))(setq c nil))           ;
  437.     )                                                                 ;
  438. )                                                                     ;
  439. ;*********************************************************************;
  440.  
  441.