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_SSLOT.CDL < prev    next >
Encoding:
Text File  |  1980-01-01  |  8.3 KB  |  329 lines
  1. REM     Name:     Sh_sslot.cdl
  2. REM
  3. REM     Date:     010589 simon izraelevitz
  4. REM
  5. REM     Task:     Constructs a slot given the length, width and radius.
  6. REM               The user has the option to create the slot axes.
  7. REM 
  8. REM     Note:     A message is displayed for all error conditions.
  9. REM
  10. REM
  11. REM     -----------------------------------------------
  12.  
  13.    CLEAR
  14.  
  15. REM define icon scale factor
  16.    sc = .75 / @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 + (-0.4330127*sc)
  28.    y = oy + (-0.2500000*sc)
  29.    r = 1.0000000*sc
  30.    ARC x, y, @depth, r, 180.0000000, 240.0000000, 0, 5
  31.  
  32.    x = ox + ( 0.4330127*sc)
  33.    y = oy + ( 0.2500000*sc)
  34.    r = 1.0000000*sc
  35.    ARC x, y, @depth, r, 360.0000000, 420.0000000, 0, 5
  36.  
  37.    x1 = ox + ( 0.9330127*sc)
  38.    y1 = oy + ( 1.1160254*sc)
  39.    x2 = ox + (-1.4330127*sc)
  40.    y2 = oy + (-0.2500000*sc)
  41.    VLINE x1, y1, @depth, x2, y2, @depth, 0, 5
  42.  
  43.    x1 = ox + ( 1.4330127*sc)
  44.    y1 = oy + ( 0.2500000*sc)
  45.    x2 = ox + (-0.9330127*sc)
  46.    y2 = oy + (-1.1160254*sc)
  47.    VLINE x1, y1, @depth, x2, y2, @depth, 0, 5
  48.  
  49.    x1 = ox + ( 1.3856406*sc)
  50.    y1 = oy + ( 0.8000000*sc)
  51.    x2 = ox + (-1.3856406*sc)
  52.    y2 = oy + (-0.8000000*sc)
  53.    VLINE x1, y1, @depth, x2, y2, @depth, 0, 5, 0, 3
  54.  
  55.    x1 = ox + (-0.1330127*sc)
  56.    y1 = oy + (-0.7696153*sc)
  57.    x2 = ox + (-0.7330127*sc)
  58.    y2 = oy + ( 0.2696151*sc)
  59.    VLINE x1, y1, @depth, x2, y2, @depth, 0, 5, 0, 3
  60.  
  61.    x1 = ox + ( 0.7330127*sc)
  62.    y1 = oy + (-0.2696152*sc)
  63.    x2 = ox + ( 0.1330127*sc)
  64.    y2 = oy + ( 0.7696152*sc)
  65.    VLINE x1, y1, @depth, x2, y2, @depth, 0, 5, 0, 3
  66.  
  67.    x1 = ox + ( 1.5308385*sc)
  68.    y1 = oy + ( 0.0000000*sc)
  69.    x2 = ox + (-1.5840101*sc)
  70.    y2 = oy + ( 0.0000000*sc)
  71.    VLINE x1, y1, @depth, x2, y2, @depth, 0, 5, 0, 3
  72.  
  73. REM draw 'L' dimension
  74.    ARRAY GENDAT[22]
  75.    GENDAT[ 0] = ox + (-1.2240380*sc)
  76.    GENDAT[ 1] = oy + (-0.8799038*sc)
  77.    GENDAT[ 2] = ox + (-0.7087167*sc)
  78.    GENDAT[ 3] = oy + (-1.7724665*sc)
  79.    GENDAT[ 4] = ox + ( 1.3740381*sc)
  80.    GENDAT[ 5] = oy + ( 0.6200962*sc)
  81.    GENDAT[ 6] = ox + ( 1.8893594*sc)
  82.    GENDAT[ 7] = oy + (-0.2724665*sc)
  83.    GENDAT[ 8] = ox + ( 0.3033761*sc)
  84.    GENDAT[ 9] = oy + (-1.1015319*sc)
  85.    GENDAT[10] = ox + (-0.7462167*sc)
  86.    GENDAT[11] = oy + (-1.7075146*sc)
  87.    GENDAT[12] = ox + ( 0.7533761*sc)
  88.    GENDAT[13] = oy + (-0.8417242*sc)
  89.    GENDAT[14] = ox + ( 1.8518593*sc)
  90.    GENDAT[15] = oy + (-0.2075146*sc)
  91.    GENDAT[16] = ox + (-0.7462167*sc)
  92.    GENDAT[17] = oy + (-1.7075146*sc)
  93.    GENDAT[18] = 30.0000000
  94.    GENDAT[19] = ox + ( 1.8518593*sc)
  95.    GENDAT[20] = oy + (-0.2075146*sc)
  96.    GENDAT[21] = -150.0000000
  97.  
  98.    x = ox + ( 0.4533761*sc)
  99.    y = oy + (-1.1216280*sc)
  100.  
  101.    GENDIM    50, 4, 0, 2, GENDAT, 1, x, y, `L
  102. `, 0.0000000, 0.3000000*sc, 0.5000000, 0, 5
  103.  
  104. REM draw 'W' dimension
  105.    ARRAY GENDAT[22]
  106.    GENDAT[ 0] = ox + (-1.5629165*sc)
  107.    GENDAT[ 1] = oy + (-0.3250001*sc)
  108.    GENDAT[ 2] = ox + (-2.4319620*sc)
  109.    GENDAT[ 3] = oy + (-0.8267438*sc)
  110.    GENDAT[ 4] = ox + (-1.0629165*sc)
  111.    GENDAT[ 5] = oy + (-1.1910255*sc)
  112.    GENDAT[ 6] = ox + (-1.9319621*sc)
  113.    GENDAT[ 7] = oy + (-1.6927692*sc)
  114.    GENDAT[ 8] = ox + (-2.6670101*sc)
  115.    GENDAT[ 9] = oy + (-0.2696285*sc)
  116.    GENDAT[10] = ox + (-2.3670101*sc)
  117.    GENDAT[11] = oy + (-0.7892438*sc)
  118.    GENDAT[12] = ox + (-1.5670103*sc)
  119.    GENDAT[13] = oy + (-2.1748843*sc)
  120.    GENDAT[14] = ox + (-1.8670102*sc)
  121.    GENDAT[15] = oy + (-1.6552691*sc)
  122.    GENDAT[16] = ox + (-2.3670101*sc)
  123.    GENDAT[17] = oy + (-0.7892438*sc)
  124.    GENDAT[18] = 120.0000000
  125.    GENDAT[19] = ox + (-1.8670102*sc)
  126.    GENDAT[20] = oy + (-1.6552691*sc)
  127.    GENDAT[21] = -60.0000000
  128.  
  129.    x = ox + (-2.2105601*sc)
  130.    y = oy + (-1.3401272*sc)
  131.  
  132.    GENDIM    50, 4, 0, 2, GENDAT, 1, x, y, `W
  133. `, 0.0000000, 0.3000000*sc, 0.5000000, 0, 5
  134.  
  135. REM draw 'Rot' dimension
  136.    ARRAY GENDAT[24]
  137.    GENDAT[ 0] = ox + ( 1.6808385*sc)
  138.    GENDAT[ 1] = oy + ( 0.0000000*sc)
  139.    GENDAT[ 2] = ox + ( 2.4800098*sc)
  140.    GENDAT[ 3] = oy + ( 0.0000000*sc)
  141.    GENDAT[ 4] = ox + ( 1.5155444*sc)
  142.    GENDAT[ 5] = oy + ( 0.8750000*sc)
  143.    GENDAT[ 6] = ox + ( 2.1477513*sc)
  144.    GENDAT[ 7] = oy + ( 1.2400049*sc)
  145.    GENDAT[ 8] = ox + ( 0.0000000*sc)
  146.    GENDAT[ 9] = oy + ( 0.0000000*sc)
  147.    GENDAT[10] = 2.4050097*sc
  148.    GENDAT[11] = 0.0000000
  149.    GENDAT[12] = 7.0284281
  150.    GENDAT[13] = ox + ( 0.0000000*sc)
  151.    GENDAT[14] = oy + ( 0.0000000*sc)
  152.    GENDAT[15] = 2.4050097*sc
  153.    GENDAT[16] = 21.8292027
  154.    GENDAT[17] = 30.0000000
  155.    GENDAT[18] = ox + ( 2.4050097*sc)
  156.    GENDAT[19] = oy + ( 0.0000000*sc)
  157.    GENDAT[20] = 93.5758438
  158.    GENDAT[21] = ox + ( 2.0827994*sc)
  159.    GENDAT[22] = oy + ( 1.2025049*sc)
  160.    GENDAT[23] = -63.5758438
  161.  
  162.    x = ox + ( 2.1054294*sc)
  163.    y = oy + ( 0.4442813*sc)
  164.  
  165.    GENDIM    53, 2, 2, 2, GENDAT, 1, x, y, `Rot
  166. `, 0.0000000, 0.3000000*sc, 0.5000000, 0, 5
  167.  
  168. REM draw radius 'R' dimension
  169.    ARRAY GENDAT[15]
  170.    GENDAT[ 0] = ox + ( 1.5837173*sc)
  171.    GENDAT[ 1] = oy + ( 1.5411104*sc)
  172.    GENDAT[ 2] = ox + ( 1.2837174*sc)
  173.    GENDAT[ 3] = oy + ( 1.5411104*sc)
  174.    GENDAT[ 4] = ox + ( 1.2837174*sc)
  175.    GENDAT[ 5] = oy + ( 1.5411104*sc)
  176.    GENDAT[ 6] = ox + ( 0.9832113*sc)
  177.    GENDAT[ 7] = oy + ( 1.0850338*sc)
  178.    GENDAT[ 8] = ox + ( 0.4330127*sc)
  179.    GENDAT[ 9] = oy + ( 0.2500000*sc)
  180.    GENDAT[10] = ox + ( 0.9832113*sc)
  181.    GENDAT[11] = oy + ( 1.0850338*sc)
  182.    GENDAT[12] = ox + ( 0.9832113*sc)
  183.    GENDAT[13] = oy + ( 1.0850338*sc)
  184.    GENDAT[14] = 236.6193542
  185.  
  186.    x = ox + ( 1.7337173*sc)
  187.    y = oy + ( 1.3911104*sc)
  188.  
  189.    GENDIM    51, 3, 0, 1, GENDAT, 1, x, y, `R
  190. `, 0.0000000, 0.3000000*sc, 0.5000000, 0, 5
  191.  
  192. REM get data to create permanent geometry
  193.    MODE NORMAL
  194.  
  195. REM default values
  196.    lengthx = 5.00
  197.    widthx = 3.00
  198.    rad = 2.00
  199.    rot = 0
  200.  
  201. REM get slot length
  202. :get_length
  203.    GETFLT "Enter (L) slot length (%f):",lengthx,lengthx
  204.    ON (@key + 3) GOTO exit,exit,
  205.    length = abs(lengthx/2)
  206.    IF ((length <= .00005) || (length >= 10000))
  207.      GOTO message1
  208.  
  209. REM get slot width
  210. :get_width
  211.    GETFLT "Enter (W) slot width (%f):",widthx,widthx
  212.    ON (@key + 3) GOTO exit,get_length,
  213.    width = abs(widthx/2)
  214.    IF ((width <= .00005) || (width >= 10000))
  215.      GOTO message1
  216.  
  217. REM get slot radius
  218. :get_radius
  219.    GETFLT "Enter (R) slot radius (%f):",rad,rad
  220.    ON (@key + 3) GOTO exit,get_width,
  221.    rad = abs(rad)
  222.    IF ((rad <= .00005) || (rad >= 10000))
  223.      GOTO message1
  224.    GOTO check_data
  225.  
  226. :message1
  227.    PROMPT "Entered value is out of range ..."
  228.    WAIT 3
  229.    GOTO get_length
  230.  
  231. REM check if the width is larger than the length or radius
  232. REM smaller than the width
  233. :check_data
  234.    IF (rad < width)
  235.      GOTO message2
  236.    a = length - rad
  237.    b = sqrt(rad*rad - width*width)
  238.    c = a + b
  239.    IF (c <= 0.00005)
  240.      goto message2
  241.    goto get_rot
  242.  
  243. :message2
  244.    PROMPT "Slot construction not possible per given data ..."
  245.    WAIT 3
  246.    GOTO get_length
  247.  
  248. :get_rot
  249.    GETFLT "Enter (Rot) rotation angle (%f):",rot,rot
  250.    ON (@key + 3) GOTO exit,get_radius,
  251.  
  252. REM construct slot
  253. :geom_constr
  254.    MODE NORMAL
  255.    posdef = 1
  256.    GETPOS "Indicate slot center position",posdef
  257.    ON (@key + 3) GOTO exit,get_rot,geom_constr,
  258.    xc     = @XVIEW
  259.    yc     = @YVIEW
  260.    zc     = @DEPTH
  261.  
  262.    sinrot = sin(rot)
  263.    cosrot = cos(rot)
  264.    ang2 = atan2(width,b)
  265.  
  266. REM construct lines
  267. :lines
  268.  
  269.    ax = -c
  270.    ay = width
  271.    bx = c
  272.    by = width
  273.    lntype = 1
  274.    DOSUB sh_drwln
  275.  
  276.    ax = -c
  277.    ay = -width
  278.    bx = c
  279.    by = -width
  280.    lntype = 1
  281.    DOSUB sh_drwln
  282.  
  283. REM right arc
  284.    x = xc + a*cosrot
  285.    y = yc + a*sinrot
  286.    ARC x,y,zc,rad,(-ang2 + rot),(ang2 + rot)
  287.  
  288. REM left arc
  289.    x = xc - a * cosrot
  290.    y = yc - a * sinrot
  291.    ARC x,y,zc,rad,(180 - ang2 + rot),(-180 + ang2 + rot)
  292.  
  293. :do_ctrlines
  294.    GETMENU "Do you want the slot center lines (YES) ?",\
  295.            "YES",\
  296.            "NO"
  297.    ON (@key + 3) GOTO exit,get_length,yes,do_ctrlines,yes,no,
  298.  
  299. :yes
  300.    ax = -c
  301.    ay = -(width + .1)
  302.    bx = -c
  303.    by = width + .1
  304.    lntype = 3
  305.    DOSUB sh_drwln
  306.  
  307.    ax = c
  308.    ay = -(width + .1)
  309.    bx = c
  310.    by = width + .1
  311.    lntype = 3
  312.    DOSUB sh_drwln
  313.  
  314.    ax = -(a + rad + .1)
  315.    ay = 0
  316.    bx = a + rad + .1
  317.    by = 0
  318.    lntype = 3
  319.    DOSUB sh_drwln
  320.  
  321. REM back to the begining
  322. :no
  323.    GOTO get_length
  324.  
  325. :exit
  326.    MODE NORMAL
  327.    CHAIN shapes
  328.    exit
  329.