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_2BELT.CDL < prev    next >
Encoding:
Text File  |  1980-01-01  |  7.4 KB  |  300 lines
  1.  
  2. REM     Name:     sh_2belt.cdl
  3. REM
  4. REM     Date:     013089 simon izraelevitz
  5. REM
  6. REM     Task:     Constructs a two arcs belt shape.
  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 = 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 + ( 0.6495190*sc)
  28.    y = oy + ( 0.3750000*sc)
  29.    r = 0.2500000*sc
  30.    ARC x, y, @depth, r, 309.6153437, 470.3863582, 0, 5
  31.  
  32.    x = ox + (-0.6495190*sc)
  33.    y = oy + (-0.3750000*sc)
  34.    r = 0.5000000*sc
  35.    ARC x, y, @depth, r, 110.4163122, 309.5940540, 0, 5
  36.  
  37.    x1 = ox + (-0.8239385*sc)
  38.    y1 = oy + ( 0.0935914*sc)
  39.    x2 = ox + ( 0.5624318*sc)
  40.    y2 = oy + ( 0.6093413*sc)
  41.    VLINE x1, y1, @depth, x2, y2, @depth, 0, 5
  42.  
  43.    x1 = ox + ( 0.8089266*sc)
  44.    y1 = oy + ( 0.1824144*sc)
  45.    x2 = ox + (-0.3308470*sc)
  46.    y2 = oy + (-0.7602897*sc)
  47.    VLINE x1, y1, @depth, x2, y2, @depth, 0, 5
  48.  
  49.    x1 = ox + (-0.9495190*sc)
  50.    y1 = oy + ( 0.1446153*sc)
  51.    x2 = ox + (-0.3495190*sc)
  52.    y2 = oy + (-0.8946153*sc)
  53.    VLINE x1, y1, @depth, x2, y2, @depth, 0, 5, 0, 3
  54.  
  55.    x1 = ox + ( 0.4745191*sc)
  56.    y1 = oy + ( 0.6781090*sc)
  57.    x2 = ox + ( 0.8245191*sc)
  58.    y2 = oy + ( 0.0718912*sc)
  59.    VLINE x1, y1, @depth, x2, y2, @depth, 0, 5, 0, 3
  60.  
  61.    x1 = ox + ( 0.9526280*sc)
  62.    y1 = oy + ( 0.5500001*sc)
  63.    x2 = ox + (-1.1691343*sc)
  64.    y2 = oy + (-0.6750001*sc)
  65.    VLINE x1, y1, @depth, x2, y2, @depth, 0, 5, 0, 3
  66.  
  67.    x1 = ox + ( 1.0301059*sc)
  68.    y1 = oy + (-0.3750000*sc)
  69.    x2 = ox + (-1.3922682*sc)
  70.    y2 = oy + (-0.3750000*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 + (-0.6995190*sc)
  76.    GENDAT[ 1] = oy + (-0.2883975*sc)
  77.    GENDAT[ 2] = ox + (-1.1091101*sc)
  78.    GENDAT[ 3] = oy + ( 0.4210352*sc)
  79.    GENDAT[ 4] = ox + ( 0.5995191*sc)
  80.    GENDAT[ 5] = oy + ( 0.4616026*sc)
  81.    GENDAT[ 6] = ox + ( 0.1899280*sc)
  82.    GENDAT[ 7] = oy + ( 1.1710352*sc)
  83.    GENDAT[ 8] = ox + (-0.6071204*sc)
  84.    GENDAT[ 9] = oy + ( 0.6531241*sc)
  85.    GENDAT[10] = ox + (-1.0841101*sc)
  86.    GENDAT[11] = oy + ( 0.3777339*sc)
  87.    GENDAT[12] = ox + (-0.3071204*sc)
  88.    GENDAT[13] = oy + ( 0.8263292*sc)
  89.    GENDAT[14] = ox + ( 0.2149280*sc)
  90.    GENDAT[15] = oy + ( 1.1277339*sc)
  91.    GENDAT[16] = ox + (-1.0841101*sc)
  92.    GENDAT[17] = oy + ( 0.3777339*sc)
  93.    GENDAT[18] = 30.0000000
  94.    GENDAT[19] = ox + ( 0.2149280*sc)
  95.    GENDAT[20] = oy + ( 1.1277339*sc)
  96.    GENDAT[21] = -150.0000000
  97.  
  98.    x = ox + (-0.5071204*sc)
  99.    y = oy + ( 0.6397266*sc)
  100.  
  101.    GENDIM    50, 4, 0, 2, GENDAT, 1, x, y, `L
  102. `, 0.0000000, 0.2000000*sc, 0.5000000, 0, 5
  103.  
  104. REM draw 'Rot' dimension
  105.    ARRAY GENDAT[24]
  106.    GENDAT[ 0] = ox + ( 1.1301060*sc)
  107.    GENDAT[ 1] = oy + (-0.3750000*sc)
  108.    GENDAT[ 2] = ox + ( 1.3838564*sc)
  109.    GENDAT[ 3] = oy + (-0.3750000*sc)
  110.    GENDAT[ 4] = ox + ( 1.0392306*sc)
  111.    GENDAT[ 5] = oy + ( 0.6000000*sc)
  112.    GENDAT[ 6] = ox + ( 1.1114358*sc)
  113.    GENDAT[ 7] = oy + ( 0.6416878*sc)
  114.    GENDAT[ 8] = ox + (-0.6495190*sc)
  115.    GENDAT[ 9] = oy + (-0.3750000*sc)
  116.    GENDAT[10] = 1.9833754*sc
  117.    GENDAT[11] = 0.0000000
  118.    GENDAT[12] = 8.5417061
  119.    GENDAT[13] = ox + (-0.6495190*sc)
  120.    GENDAT[14] = oy + (-0.3750000*sc)
  121.    GENDAT[15] = 1.9833754*sc
  122.    GENDAT[16] = 20.4998951
  123.    GENDAT[17] = 30.0000000
  124.    GENDAT[18] = ox + ( 1.3338565*sc)
  125.    GENDAT[19] = oy + (-0.3750000*sc)
  126.    GENDAT[20] = 92.8900299
  127.    GENDAT[21] = ox + ( 1.0681345*sc)
  128.    GENDAT[22] = oy + ( 0.6166877*sc)
  129.    GENDAT[23] = -62.8900261
  130.  
  131.    x = ox + ( 1.1211995*sc)
  132.    y = oy + ( 0.0195893*sc)
  133.  
  134.    GENDIM    53, 2, 2, 2, GENDAT, 1, x, y, `Rot
  135. `, 0.0000000, 0.2000000*sc, 0.5000000, 0, 5
  136.  
  137. REM draw label 'PT'
  138.    x1 = ox + ( 0.3503735*sc)
  139.    y1 = oy + (-0.8755332*sc)
  140.    x2 = ox + (-0.0496265*sc)
  141.    y2 = oy + (-0.8755332*sc)
  142.    x3 = ox + (-0.6495190*sc)
  143.    y3 = oy + (-0.3750000*sc)
  144.    x = ox + ( 0.4503735*sc)
  145.    y = oy + (-0.9755332*sc)
  146.  
  147.    LABEL   x1, y1, x2, y2, x3, y3, 1, x, y, `PT
  148. `, 0.0000000, 0.2000000*sc, 0.5000000, 0, 5
  149.  
  150. REM draw label 'R1'
  151.    x1 = ox + (-0.9647385*sc)
  152.    y1 = oy + (-1.3597043*sc)
  153.    x2 = ox + (-1.3647385*sc)
  154.    y2 = oy + (-1.3597043*sc)
  155.    x3 = ox + (-0.8762745*sc)
  156.    y3 = oy + (-0.8249927*sc)
  157.    x = ox + (-0.8647385*sc)
  158.    y = oy + (-1.4597043*sc)
  159.  
  160.    LABEL   x1, y1, x2, y2, x3, y3, 1, x, y, `R1
  161. `, 0.0000000, 0.2000000*sc, 0.5000000, 0, 5
  162.  
  163. REM draw label 'R2'
  164.    x1 = ox + ( 0.8426620*sc)
  165.    y1 = oy + ( 1.1669366*sc)
  166.    x2 = ox + ( 1.2426620*sc)
  167.    y2 = oy + ( 1.1669366*sc)
  168.    x3 = ox + ( 0.7964553*sc)
  169.    y3 = oy + ( 0.5746280*sc)
  170.    x = ox + ( 0.5426620*sc)
  171.    y = oy + ( 1.0669366*sc)
  172.  
  173.    LABEL   x1, y1, x2, y2, x3, y3, 1, x, y, `R2
  174. `, 0.0000000, 0.2000000*sc, 0.5000000, 0, 5
  175.  
  176. REM get data to create permanent geometry
  177. REM default values
  178.    PI = 3.14159
  179.    radang = 180/PI
  180.    rad1 = 2.00
  181.    rad2 = 1.00
  182.    length = 3.00
  183.    rot = 0
  184.  
  185. REM get length
  186. :get_length
  187.    GETFLT "Enter (L) distance between centers (%f):",length,length
  188.    ON (@key + 3) GOTO exit,exit,
  189.    length = abs(length)
  190.    IF ((length <= .00005) || (length >= 10000))
  191.      GOTO message1
  192.  
  193. REM get first arc radius
  194. :get_rad1
  195.    GETFLT "Enter (R1) first arc radius (%f):",rad1,rad1
  196.    ON (@key + 3) GOTO exit,get_length,
  197.    rad1 = abs(rad1)
  198.    IF ((rad1 <= .00005) || (rad1 >= 10000))
  199.      GOTO message1
  200.  
  201. REM get second arc radius
  202. :get_rad2
  203.    GETFLT "Enter (R2) second arc radius (%f):",rad2,rad2
  204.    ON (@key + 3) GOTO exit,get_rad1,
  205.    rad2 = abs(rad2)
  206.    IF ((rad2 <= .00005) || (rad2 >= 10000))
  207.      GOTO message1
  208.    GOTO get_rot
  209.  
  210. :message1
  211.    PROMPT "Entered value is out of range ..."
  212.    WAIT 3
  213.    GOTO get_length
  214.  
  215. :get_rot
  216.    GETFLT "Enter (Rot) rotation angle (%f):",rot,rot
  217.    sinrot = sin(rot)
  218.    cosrot = cos(rot)
  219.    ON (@key + 3) GOTO exit,get_rad2,
  220.  
  221. REM construct belt shape
  222. :geom_constr
  223.    MODE NORMAL
  224.    posdef = 1
  225.    GETPOS "Indicate (PT) arc center position",posdef
  226.    ON (@key + 3) GOTO exit,get_rot,geom_constr,
  227.    xc     = @XVIEW
  228.    yc     = @YVIEW
  229.    zc     = @DEPTH
  230.  
  231. REM tangent points calculation
  232.    dist = abs((rad1*length) / (rad1 - rad2))
  233.    cosang = rad1/dist
  234.    sinang = sqrt(1 - cosang*cosang)
  235.    CALL atan3,sinang,cosang,ang
  236.    ang = ang*radang
  237.  
  238. REM construct tangent lines
  239. :lines
  240.    ax = rad1*cosang
  241.    ay = rad1*sinang
  242.    bx = length + rad2*cosang
  243.    by = rad2*sinang
  244.    lntype = 1
  245.    DOSUB sh_drwln
  246.  
  247.    ax = rad1*cosang
  248.    ay = -rad1*sinang
  249.    bx = length + rad2*cosang
  250.    by = -rad2*sinang
  251.    lntype = 1
  252.    DOSUB sh_drwln
  253.  
  254. REM right arc
  255.    x = xc + length*cosrot
  256.    y = yc + length*sinrot
  257.    ARC x,y,zc,rad2,(-ang + rot),(ang + rot)
  258.  
  259. REM left arc
  260.    x = xc
  261.    y = yc
  262.    ARC x,y,zc,rad1,(ang + rot),(-ang + rot)
  263.  
  264. :do_ctrlines
  265.    GETMENU "Do you want the slot center lines (YES) ?",\
  266.            "YES",\
  267.            "NO"
  268.    ON (@key + 3) GOTO exit,get_length,yes,do_ctrlines,yes,no,
  269.  
  270. :yes
  271.    ax = 0
  272.    ay = rad1 + .1
  273.    bx = 0
  274.    by = -(rad1 + .1)
  275.    lntype = 3
  276.    DOSUB sh_drwln
  277.  
  278.    ax = length
  279.    ay = rad2 + .1
  280.    bx = length
  281.    by = -(rad2 + .1)
  282.    lntype = 3
  283.    DOSUB sh_drwln
  284.  
  285.    ax = -(rad1 + .1)
  286.    ay = 0
  287.    bx = length + rad2 + .1
  288.    by = 0
  289.    lntype = 3
  290.    DOSUB sh_drwln
  291.  
  292. REM back to the begining
  293. :no
  294.    GOTO get_length
  295.  
  296. :exit
  297.    MODE NORMAL
  298.    CHAIN shapes
  299.    exit
  300.