home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0010 - 0019 / ibm0010-0019 / ibm0010.tar / ibm0010 / CADKEY_C.ZIP / CADKEY14.ZIP / CDL / SH_RASLT.CDL < prev    next >
Encoding:
Text File  |  1980-01-01  |  8.2 KB  |  308 lines
  1. REM     Name:     sh_raslt.cdl
  2. REM
  3. REM     Date:     010989 simon izraelevitz
  4. REM
  5. REM     Task:     Constructs a radial slot given the width, the sweep
  6. REM               angle, and the center line radius.
  7. REM               The user has the option to create the slot centerlines.
  8. REM 
  9. REM     Note:     A message is displayed for all error conditions.
  10. REM
  11. REM     -----------------------------------------------
  12.  
  13.    CLEAR
  14.  
  15. REM define icon scale factor
  16.    sc = 1.5 / @scale
  17.  
  18. REM compute icon oval origin
  19.    xinc = (@xmax - @xmin)/10
  20.    yinc = (@ymax - @ymin)/10
  21.    ox = @xmax - 3*xinc
  22.    oy = @ymax - 3*yinc
  23.  
  24. REM create icon geometry
  25.    MODE DRAW
  26.  
  27.    x = ox + (-1.1248783*sc)
  28.    y = oy + (-1.3405778*sc)
  29.    r = 1.5000000*sc
  30.    ARC x, y, @depth, r, 20.0000000, 80.0000000, 0, 5
  31.  
  32.    x = ox + (-1.1248783*sc)
  33.    y = oy + (-1.3405778*sc)
  34.    r = 2.0000000*sc
  35.    ARC x, y, @depth, r, 20.0000000, 80.0000000, 0, 5
  36.  
  37.    x = ox + (-1.1248783*sc)
  38.    y = oy + (-1.3405778*sc)
  39.    r = 1.7500000*sc
  40.    ARC x, y, @depth, r, 8.5216591, 91.4783432, 0, 5, 0, 3
  41.  
  42.    x = ox + (-0.8209940*sc)
  43.    y = oy + ( 0.3828357*sc)
  44.    r = 0.2500000*sc
  45.    ARC x, y, @depth, r, 80.0000000, 260.0000000, 0, 5
  46.  
  47.    x = ox + ( 0.5195838*sc)
  48.    y = oy + (-0.7420426*sc)
  49.    r = 0.2500000*sc
  50.    ARC x, y, @depth, r, 200.0000000, 380.0000000, 0, 5
  51.  
  52.    x1 = ox + ( 1.3418933*sc)
  53.    y1 = oy + (-1.3405778*sc)
  54.    x2 = ox + ( 0.2751217*sc)
  55.    y2 = oy + (-1.3405778*sc)
  56.    VLINE x1, y1, @depth, x2, y2, @depth, 0, 5, 0, 3
  57.  
  58.    x1 = ox + ( 0.1906914*sc)
  59.    y1 = oy + (-0.8617496*sc)
  60.    x2 = ox + ( 0.8484762*sc)
  61.    y2 = oy + (-0.6223356*sc)
  62.    VLINE x1, y1, @depth, x2, y2, @depth, 0, 5, 0, 3
  63.  
  64.    x1 = ox + (-0.2249756*sc)
  65.    y1 = oy + (-0.2681156*sc)
  66.    x2 = ox + ( 0.2249756*sc)
  67.    y2 = oy + ( 0.2681154*sc)
  68.    VLINE x1, y1, @depth, x2, y2, @depth, 0, 5, 0, 3
  69.  
  70.    x1 = ox + (-0.8817708*sc)
  71.    y1 = oy + ( 0.0381529*sc)
  72.    x2 = ox + (-0.7602171*sc)
  73.    y2 = oy + ( 0.7275183*sc)
  74.    VLINE x1, y1, @depth, x2, y2, @depth, 0, 5, 0, 3
  75.  
  76.    x1 = ox + (-1.1248783*sc)
  77.    y1 = oy + (-1.3405778*sc)
  78.    VPOINT x1, y1, @depth, 0, 5
  79.  
  80. REM draw 'W' dimension
  81.    ARRAY GENDAT[22]
  82.    GENDAT[ 0] = ox + (-0.9628868*sc)
  83.    GENDAT[ 1] = oy + ( 0.1539986*sc)
  84.    GENDAT[ 2] = ox + (-1.4866660*sc)
  85.    GENDAT[ 3] = oy + ( 0.2463550*sc)
  86.    GENDAT[ 4] = ox + (-0.8760627*sc)
  87.    GENDAT[ 5] = oy + ( 0.6464024*sc)
  88.    GENDAT[ 6] = ox + (-1.3998418*sc)
  89.    GENDAT[ 7] = oy + ( 0.7387589*sc)
  90.    GENDAT[ 8] = ox + (-1.5068849*sc)
  91.    GENDAT[ 9] = oy + (-0.1562505*sc)
  92.    GENDAT[10] = ox + (-1.4374256*sc)
  93.    GENDAT[11] = oy + ( 0.2376726*sc)
  94.    GENDAT[12] = ox + (-1.2811421*sc)
  95.    GENDAT[13] = oy + ( 1.1239995*sc)
  96.    GENDAT[14] = ox + (-1.3506014*sc)
  97.    GENDAT[15] = oy + ( 0.7300764*sc)
  98.    GENDAT[16] = ox + (-1.4374256*sc)
  99.    GENDAT[17] = oy + ( 0.2376726*sc)
  100.    GENDAT[18] = 260.0000000
  101.    GENDAT[19] = ox + (-1.3506014*sc)
  102.    GENDAT[20] = oy + ( 0.7300764*sc)
  103.    GENDAT[21] = 80.0000000
  104.  
  105.    x = ox + (-1.4380946*sc)
  106.    y = oy + ( 0.4174420*sc)
  107.  
  108.    GENDIM    50, 4, 0, 2, GENDAT, 1, x, y, `W
  109. `, 0.0000000, 0.2000000*sc, 0.5000000, 0, 5
  110.  
  111. REM draw 'Ang' dimension
  112.    ARRAY GENDAT[24]
  113.    GENDAT[ 0] = ox + ( 0.9424455*sc)
  114.    GENDAT[ 1] = oy + (-0.5881335*sc)
  115.    GENDAT[ 2] = ox + ( 1.1897597*sc)
  116.    GENDAT[ 3] = oy + (-0.4981185*sc)
  117.    GENDAT[ 4] = ox + (-0.7428523*sc)
  118.    GENDAT[ 5] = oy + ( 0.8259991*sc)
  119.    GENDAT[ 6] = ox + (-0.6971505*sc)
  120.    GENDAT[ 7] = oy + ( 1.0851871*sc)
  121.    GENDAT[ 8] = ox + (-1.1248783*sc)
  122.    GENDAT[ 9] = oy + (-1.3405778*sc)
  123.    GENDAT[10] = 2.4131863*sc
  124.    GENDAT[11] = 20.0000000
  125.    GENDAT[12] = 43.6258888
  126.    GENDAT[13] = ox + (-1.1248783*sc)
  127.    GENDAT[14] = oy + (-1.3405778*sc)
  128.    GENDAT[15] = 2.4131863*sc
  129.    GENDAT[16] = 57.9254532
  130.    GENDAT[17] = 80.0000000
  131.    GENDAT[18] = ox + ( 1.1427751*sc)
  132.    GENDAT[19] = oy + (-0.5152195*sc)
  133.    GENDAT[20] = 112.3749542
  134.    GENDAT[21] = ox + (-0.7058328*sc)
  135.    GENDAT[22] = oy + ( 1.0359467*sc)
  136.    GENDAT[23] = -12.3749619
  137.  
  138.    x = ox + ( 0.2565772*sc)
  139.    y = oy + ( 0.4243921*sc)
  140.  
  141.    GENDIM    53, 2, 2, 2, GENDAT, 1, x, y, `Ang
  142. `, 0.0000000, 0.2000000*sc, 0.5000000, 0, 5
  143.  
  144. REM draw 'Rot' dimension
  145.    ARRAY GENDAT[24]
  146.    GENDAT[ 0] = ox + ( 0.1751217*sc)
  147.    GENDAT[ 1] = oy + (-1.3405778*sc)
  148.    GENDAT[ 2] = ox + (-0.1883723*sc)
  149.    GENDAT[ 3] = oy + (-1.3405778*sc)
  150.    GENDAT[ 4] = ox + (-0.2892544*sc)
  151.    GENDAT[ 5] = oy + (-0.3447201*sc)
  152.    GENDAT[ 6] = ox + (-0.5229039*sc)
  153.    GENDAT[ 7] = oy + (-0.6231727*sc)
  154.    GENDAT[ 8] = ox + (-1.1248782*sc)
  155.    GENDAT[ 9] = oy + (-1.3405778*sc)
  156.    GENDAT[10] = 0.9865059*sc
  157.    GENDAT[11] = 0.0000000
  158.    GENDAT[12] = 11.8160295
  159.    GENDAT[13] = ox + (-1.1248782*sc)
  160.    GENDAT[14] = oy + (-1.3405778*sc)
  161.    GENDAT[15] = 0.9865059*sc
  162.    GENDAT[16] = 37.6069603
  163.    GENDAT[17] = 50.0000000
  164.    GENDAT[18] = ox + (-0.1383723*sc)
  165.    GENDAT[19] = oy + (-1.3405778*sc)
  166.    GENDAT[20] = 95.8179474
  167.    GENDAT[21] = ox + (-0.4907645*sc)
  168.    GENDAT[22] = oy + (-0.5848705*sc)
  169.    GENDAT[23] = -45.8179398
  170.  
  171.    x = ox + (-0.3739384*sc)
  172.    y = oy + (-1.0385711*sc)
  173.  
  174.    GENDIM    53, 2, 2, 2, GENDAT, 1, x, y, `Rot
  175. `, 0.0000000, 0.2000000*sc, 0.5000000, 0, 5
  176.  
  177. REM draw label 'R'
  178.    x1 = ox + (-1.1247880*sc)
  179.    y1 = oy + (-0.6431985*sc)
  180.    x2 = ox + (-0.7247881*sc)
  181.    y2 = oy + (-0.6431985*sc)
  182.    x3 = ox + (-0.5661268*sc)
  183.    y3 = oy + ( 0.3131930*sc)
  184.    x = ox + (-1.3247881*sc)
  185.    y = oy + (-0.7431985*sc)
  186.  
  187.    LABEL   x1, y1, x2, y2, x3, y3, 1, x, y, `R
  188. `, 0.0000000, 0.1500000*sc, 0.5000000, 0, 5
  189.  
  190. REM draw label 'PT'
  191.    x1 = ox + (-0.5166867*sc)
  192.    y1 = oy + (-1.5990208*sc)
  193.    x2 = ox + (-0.9166868*sc)
  194.    y2 = oy + (-1.5990208*sc)
  195.    x3 = ox + (-1.1248783*sc)
  196.    y3 = oy + (-1.3405778*sc)
  197.    x = ox + (-0.4166867*sc)
  198.    y = oy + (-1.6990209*sc)
  199.  
  200.    LABEL   x1, y1, x2, y2, x3, y3, 1, x, y, `PT
  201. `, 0.0000000, 0.1500000*sc, 0.5000000, 0, 5
  202.  
  203. REM get data to create permanent geometry
  204. REM default values
  205.    rad = 3.00
  206.    width = 1.00
  207.    angx = 60
  208.    rot = 0
  209.  
  210. REM get center line radius
  211. :get_radius
  212.    GETFLT "Enter (R) center line radius (%f):",rad,rad,
  213.    ON (@key + 3) GOTO exit,exit,
  214.    rad = abs(rad)
  215.    IF ((rad <= .00005) || (rad >= 10000))
  216.      GOTO message1
  217.    GOTO get_width
  218.  
  219. REM get width
  220. :get_width
  221.    GETFLT "Enter (W) slot width (%f):",width,width
  222.    ON (@key + 3) GOTO exit,get_radius,
  223.    rad2 = abs(width/2)
  224.    IF ((rad2 <= .00005) || (rad2 >= 10000))
  225.      GOTO message1
  226.    GOTO get_ang
  227.  
  228. :message1
  229.    PROMPT "Entered value is out of range ..."
  230.    WAIT 3
  231.    GOTO get_radius
  232.  
  233. REM get included angle
  234. :get_ang
  235.    GETFLT "Enter (Ang) including angle (%f):",angx,angx
  236.    ON (@key + 3) GOTO exit,get_width,
  237.    ang = abs(angx/2)
  238.  
  239. :get_rot
  240.    GETFLT "Enter (Rot) rotation angle (%f):",rot,rot
  241.    ON (@key + 3) GOTO exit,get_ang,
  242.  
  243. REM construct slot
  244. :geom_constr
  245.    MODE NORMAL
  246.    posdef = 1
  247.    GETPOS "Indicate (PT) slot center position",posdef
  248.    ON (@key + 3) GOTO exit,get_rot,geom_constr,
  249.    xc     = @XVIEW
  250.    yc     = @YVIEW
  251.    zc     = @DEPTH
  252.  
  253.    sinang = sin(ang)
  254.    cosang = cos(ang)
  255.    sinrot = sin(rot)
  256.    cosrot = cos(rot)
  257.  
  258. REM construct arcs
  259.  
  260.    a = rad*cosang
  261.    b = -rad*sinang
  262.    x = xc + a*cosrot - b*sinrot
  263.    y = yc + a*sinrot + b*cosrot
  264.    ARC x,y,zc,rad2,(rot - ang - 180),(rot - ang)
  265.  
  266.    a = rad*cosang
  267.    b = rad*sinang
  268.    x = xc + a*cosrot - b*sinrot
  269.    y = yc + a*sinrot + b*cosrot
  270.    ARC x,y,zc,rad2,(rot + ang),(rot + ang + 180)
  271.  
  272.    ARC xc,yc,zc,(rad - rad2),(rot - ang),(rot + ang)
  273.  
  274.    ARC xc,yc,zc,(rad + rad2),(rot - ang),(rot + ang)
  275.  
  276. :do_ctrlines
  277.    GETMENU "Do you want the slot center lines (YES) ?",\
  278.            "YES",\
  279.            "NO"
  280.    ON (@key + 3) GOTO exit,get_radius,yes,do_ctrlines,yes,no,
  281.  
  282. :yes
  283.    ax = (rad + rad2 + .1)*cosang
  284.    ay = -(rad + rad2 + .1)*sinang
  285.    bx = (rad - rad2 - .1)*cosang
  286.    by = -(rad - rad2 - .1)*sinang
  287.    lntype = 3
  288.    DOSUB sh_drwln
  289.  
  290.    ax = (rad + rad2 + .1)*cosang
  291.    ay = (rad + rad2 + .1)*sinang
  292.    bx = (rad - rad2 - .1)*cosang
  293.    by = (rad - rad2 -.1)*sinang
  294.    lntype = 3
  295.    DOSUB sh_drwln
  296.  
  297.    ARC xc,yc,zc,rad,(rot - ang - atan2(1.25*rad2,rad)),\
  298.        (rot + ang + atan2(1.25*rad2,rad)),0,0,0,3
  299.  
  300. REM back to the begining
  301. :no
  302.    GOTO get_radius
  303.  
  304. :exit
  305.    MODE NORMAL
  306.    CHAIN shapes
  307.    exit
  308.