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_OVAL.CDL < prev    next >
Encoding:
Text File  |  1980-01-01  |  8.8 KB  |  342 lines
  1. REM     Name:     sh_Oval.cdl
  2. REM
  3. REM     Date:     122988 simon izraelevitz
  4. REM
  5. REM     Task:     Constructs an oval given the major and minor axes,
  6. REM               one of the radii and a rotation angle. The user has 
  7. REM               the option to create the oval axes.
  8. REM 
  9. REM     Note:     A message is displayed for all error conditions.
  10. REM
  11. REM
  12. REM     -----------------------------------------------
  13.  
  14.    CLEAR
  15.  
  16. REM define scale factor
  17.    sc = 2 / @scale
  18.  
  19. REM compute icon oval origin
  20.    xinc = (@xmax - @xmin)/10
  21.    yinc = (@ymax - @ymin)/10
  22.    ox = @xmax - 3*xinc
  23.    oy = @ymax - 3*yinc
  24.  
  25.  
  26. REM create icon geometry
  27.    MODE DRAW
  28.  
  29.    x = ox + (0.2165062*sc)
  30.    y = oy + (0.1250000*sc)
  31.    r = 0.2500000*sc
  32.    ARC x, y, @depth, r, 336.8699022, 443.1300989, 0, 5
  33.  
  34.    x = ox + (0.1666667*sc)
  35.    y = oy + (-0.2886751*sc)
  36.    r = 0.6666666*sc
  37.    ARC x, y, @depth, r, 83.1300958, 156.8699041, 0, 5
  38.  
  39.    x = ox + (-0.2165062*sc)
  40.    y = oy + (-0.1250000*sc)
  41.    r = 0.2500000*sc
  42.    ARC x, y, @depth, r, 156.8698972, 263.1300939, 0, 5
  43.  
  44.    x = ox + (-0.1666667*sc)
  45.    y = oy + ( 0.2886751*sc)
  46.    r = 0.6666666*sc
  47.    ARC x, y, @depth, r, 263.1300871, 336.8699022, 0, 5
  48.  
  49.    x1 = ox + ( 0.5196154*sc)
  50.    y1 = oy + ( 0.3000000*sc)
  51.    x2 = ox + (-0.5196152*sc)
  52.    y2 = oy + (-0.3000000*sc)
  53.    VLINE x1, y1, @depth, x2, y2, @depth, 0, 5, 0, 3
  54.  
  55.    x1 = ox + (-0.2166667*sc)
  56.    y1 = oy + ( 0.3752778*sc)
  57.    x2 = ox + ( 0.2166665*sc)
  58.    y2 = oy + (-0.3752778*sc)
  59.    VLINE x1, y1, @depth, x2, y2, @depth, 0, 5, 0 , 3
  60.  
  61.    x1 = ox + ( 0.6430624*sc)
  62.    y1 = oy + ( 0.0000000*sc)
  63.    x2 = ox + (-0.7537405*sc)
  64.    y2 = oy + ( 0.0000000*sc)
  65.    VLINE x1, y1, @depth, x2, y2, @depth, 0, 5, 0 , 3
  66.  
  67. REM draw 'L' dimension
  68.    ARRAY GENDAT[22]
  69.    GENDAT[ 0] = ox + (-0.4080126*sc)
  70.    GENDAT[ 1] = oy + (-0.2933013*sc)
  71.    GENDAT[ 2] = ox + (-0.1283369*sc)
  72.    GENDAT[ 3] = oy + (-0.7777140*sc)
  73.    GENDAT[ 4] = ox + ( 0.4580128*sc)
  74.    GENDAT[ 5] = oy + ( 0.2066984*sc)
  75.    GENDAT[ 6] = ox + ( 0.7376883*sc)
  76.    GENDAT[ 7] = oy + (-0.2777143*sc)
  77.    GENDAT[ 8] = ox + ( 0.2200778*sc)
  78.    GENDAT[ 9] = oy + (-0.5476894*sc)
  79.    GENDAT[10] = ox + (-0.1408370*sc)
  80.    GENDAT[11] = oy + (-0.7560635*sc)
  81.    GENDAT[12] = ox + ( 0.3700783*sc)
  82.    GENDAT[13] = oy + (-0.4610865*sc)
  83.    GENDAT[14] = ox + ( 0.7251885*sc)
  84.    GENDAT[15] = oy + (-0.2560637*sc)
  85.    GENDAT[16] = ox + (-0.1408370*sc)
  86.    GENDAT[17] = oy + (-0.7560635*sc)
  87.    GENDAT[18] = 29.9999790
  88.    GENDAT[19] = ox + ( 0.7251885*sc)
  89.    GENDAT[20] = oy + (-0.2560637*sc)
  90.    GENDAT[21] = -150.0000153
  91.  
  92.    x = ox + ( 0.2700779*sc)
  93.    y = oy + (-0.5543878*sc)
  94.  
  95.    GENDIM    50, 4, 0, 2, GENDAT, 1, x, y, `L
  96. `, 0.0000000, 0.1000000*sc, 0.5000000, 0, 5
  97.  
  98. REM draw 'W' dimension
  99.    ARRAY GENDAT[22]
  100.    GENDAT[ 0] = ox + (-0.2099681*sc)
  101.    GENDAT[ 1] = oy + ( 0.2636750*sc)
  102.    GENDAT[ 2] = ox + (-0.9838688*sc)
  103.    GENDAT[ 3] = oy + (-0.1831362*sc)
  104.    GENDAT[ 4] = ox + ( 0.1233649*sc)
  105.    GENDAT[ 5] = oy + (-0.3136754*sc)
  106.    GENDAT[ 6] = ox + (-0.6505358*sc)
  107.    GENDAT[ 7] = oy + (-0.7604866*sc)
  108.    GENDAT[ 8] = ox + (-0.8688109*sc)
  109.    GENDAT[ 9] = oy + (-0.3324227*sc)
  110.    GENDAT[10] = ox + (-0.9622183*sc)
  111.    GENDAT[11] = oy + (-0.1706362*sc)
  112.    GENDAT[12] = ox + (-0.7533410*sc)
  113.    GENDAT[13] = oy + (-0.5324225*sc)
  114.    GENDAT[14] = ox + (-0.6288853*sc)
  115.    GENDAT[15] = oy + (-0.7479866*sc)
  116.    GENDAT[16] = ox + (-0.9622183*sc)
  117.    GENDAT[17] = oy + (-0.1706362*sc)
  118.    GENDAT[18] = 299.9999695
  119.    GENDAT[19] = ox + (-0.6288853*sc)
  120.    GENDAT[20] = oy + (-0.7479866*sc)
  121.    GENDAT[21] = 119.9999466
  122.  
  123.    x = ox + (-0.8360760*sc)
  124.    y = oy + (-0.4824226*sc)
  125.  
  126.    GENDIM    50, 4, 0, 2, GENDAT, 1, x, y, `W
  127. `, 0.0000000, 0.1000000*sc, 0.5000000, 0, 5
  128.  
  129. REM draw label 'R'
  130.    x1 = ox + (-0.9062896*sc)
  131.    y1 = oy + ( 0.2030108*sc)
  132.    x2 = ox + (-0.7062895*sc)
  133.    y2 = oy + ( 0.2030108*sc)
  134.    x3 = ox + (-0.3806808*sc)
  135.    y3 = oy + ( 0.0975721*sc)
  136.    x = ox + (-1.0062895*sc)
  137.    y = oy + ( 0.1530108*sc)
  138.  
  139.    LABEL   x1, y1, x2, y2, x3, y3, 1, x, y, `R
  140. `, 0.0000000, 0.1000000*sc, 0.5000000, 0, 5
  141.  
  142.    x1 = ox + (-0.6982007*sc)
  143.    y1 = oy + ( 0.2017970*sc)
  144.    x2 = ox + (-0.4624188*sc)
  145.    y2 = oy + (-0.1552286*sc)
  146.  
  147.    LEADER     x1, y1, x2, y2, 0.1000000*sc, 1, 0, 5
  148.  
  149. REM draw 'Rot' dimension
  150.    ARRAY GENDAT[24]
  151.    GENDAT[ 0] = ox + ( 0.6930625*sc)
  152.    GENDAT[ 1] = oy + ( 0.0000000*sc)
  153.    GENDAT[ 2] = ox + ( 0.7982585*sc)
  154.    GENDAT[ 3] = oy + ( 0.0000000*sc)
  155.    GENDAT[ 4] = ox + ( 0.5629165*sc)
  156.    GENDAT[ 5] = oy + ( 0.3250000*sc)
  157.    GENDAT[ 6] = ox + ( 0.6913121*sc)
  158.    GENDAT[ 7] = oy + ( 0.3991289*sc)
  159.    GENDAT[ 8] = ox + ( 0.0000002*sc)
  160.    GENDAT[ 9] = oy + ( 0.0000000*sc)
  161.    GENDAT[10] = 0.7732580*sc
  162.    GENDAT[11] = 0.0000000
  163.    GENDAT[12] = 8.7267179
  164.    GENDAT[13] = ox + ( 0.0000002*sc)
  165.    GENDAT[14] = oy + ( 0.0000000*sc)
  166.    GENDAT[15] = 0.7732580*sc
  167.    GENDAT[16] = 24.2279148
  168.    GENDAT[17] = 29.9999943
  169.    GENDAT[18] = ox + ( 0.7732583*sc)
  170.    GENDAT[19] = oy + ( 0.0000000*sc)
  171.    GENDAT[20] = 93.7074127
  172.    GENDAT[21] = ox + ( 0.6696614*sc)
  173.    GENDAT[22] = oy + ( 0.3866290*sc)
  174.    GENDAT[23] = -63.7074203
  175.  
  176.    x = ox + ( 0.6670921*sc)
  177.    y = oy + ( 0.1673200*sc)
  178.  
  179.    GENDIM    53, 2, 2, 2, GENDAT, 1, x, y, `Rot
  180. `, 0.0000000, 0.1000000*sc, 0.5000000, 0, 5
  181.  
  182. REM get data to create permanent geometry
  183. REM default values
  184.    lengthx = 5.00
  185.    widthx = 3.00
  186.    rad = 1.00
  187.    rot = 0
  188.  
  189. REM get oval length
  190. :get_length
  191.    GETFLT "Enter (L) oval length (%f):",lengthx,lengthx
  192.    ON (@key + 3) GOTO exit,exit,
  193.    length = abs(lengthx / 2)
  194.    IF ((length <= .00005) || (length >= 10000))
  195.      GOTO message1
  196.  
  197. REM get oval width
  198. :get_width
  199.    GETFLT "Enter (W) oval width (%f):",widthx,widthx
  200.    ON (@key + 3) GOTO exit,get_length,
  201.    width = abs(widthx / 2)
  202.    IF ((width <= .00005) || (width >= 10000))
  203.      GOTO message1
  204.      
  205. REM if axes are equal bypass radius question
  206.    IF (length == width)
  207.      GOTO get_rot
  208.  
  209. REM get the radius of any of the arcs
  210. :get_rad
  211.    GETFLT "Enter (R) either radius (%f):",rad,rad
  212.    ON (@key + 3) GOTO exit,get_width,
  213.    rad  = abs(rad)
  214.    IF ((rad <= .00005) || (rad >= 10000))
  215.      GOTO message1
  216.    GOTO check_axes
  217.      
  218. :message1
  219.    PROMPT "Entered value is out of range ..."
  220.    WAIT 3
  221.    GOTO get_length
  222.  
  223. REM check if the length is smaller than the width.
  224. :check_axes
  225.    IF (length < width)
  226.      goto swap_axes
  227.    goto check_rad
  228.  
  229. :swap_axes
  230.    temp = width
  231.    width = length
  232.    length = temp
  233.  
  234. REM check for bad radius values
  235. :check_rad
  236.    minval = (length*length + width*width) / (2*width)
  237.    IF ((rad >= width) && (rad <= minval))
  238.      GOTO message2
  239.    GOTO get_rot
  240.  
  241. :message2
  242.    PROMPT "Oval construction not possible per given data ..."
  243.    WAIT 3
  244.    GOTO get_length
  245.  
  246. REM get the radius of any of the arcs
  247. :get_rot
  248.    GETFLT "Enter (Rot) rotation angle (%f):",rot,rot
  249.    ON (@key + 3) GOTO exit,get_rad,
  250.  
  251. REM construct oval
  252. :geom_constr
  253.    MODE NORMAL
  254.    posdef = 1
  255.    GETPOS "Indicate oval center position",posdef
  256.    ON (@key + 3) GOTO exit,get_rot,geom_constr,
  257.    xc     = @XVIEW
  258.    yc     = @YVIEW
  259.    zc     = @DEPTH
  260.  
  261.    IF (length == width)
  262.      GOTO same_rad
  263.    GOTO diff_rad
  264.  
  265. :same_rad
  266.    ARC xc,yc,zc,width,-45 + rot,45 + rot
  267.    ARC xc,yc,zc,width,45 + rot,135 + rot
  268.    ARC xc,yc,zc,width,135 + rot,-135 + rot
  269.    ARC xc,yc,zc,width,-135 + rot,-45 + rot
  270.    GOTO get_length
  271.  
  272. :diff_rad
  273.    IF (rad < width)
  274.      GOTO small_rad
  275.    GOTO large_rad
  276.  
  277. :small_rad
  278.    smrad = rad
  279.    lgrad = (2*length*smrad - length*length - width*width) / (2*(smrad - width))
  280.    GOTO angles
  281.  
  282. :large_rad
  283.    lgrad = rad
  284.    smrad = (2*width*lgrad - length*length - width*width) / (2*(lgrad - length))
  285.  
  286. :angles
  287.    tgang = (lgrad - width) / (length - smrad)
  288.    smang = ATAN(tgang)
  289.    lgang = ATAN2(1,tgang)
  290.    cosrot = cos(rot)
  291.    sinrot = sin(rot)
  292. :arcs
  293. REM right arc
  294.    x = xc + (length - smrad) * cosrot
  295.    y = yc + (length - smrad) * sinrot
  296.    ARC x,y,zc,smrad,(-smang + rot),(smang + rot)
  297.  
  298. REM top arc
  299.    x = xc + (lgrad -width) * sinrot
  300.    y = yc - (lgrad - width) * cosrot
  301.    ARC x,y,zc,lgrad,(smang + rot),(smang + 2*lgang + rot)
  302.  
  303. REM left arc
  304.    x = xc - (length - smrad) * cosrot
  305.    y = yc - (length - smrad) * sinrot
  306.    ARC x,y,zc,smrad,(smang + 2*lgang + rot),(smang + rot + 180)
  307.  
  308. REM bottom arc
  309.    x = xc - (lgrad - width) * sinrot
  310.    y = yc + (lgrad - width) * cosrot
  311.    ARC x,y,zc,lgrad,(smang + rot + 180),(-smang + rot)
  312.  
  313. :do_ctrlines
  314.    GETMENU "Do you want the oval center lines (YES) ?",\
  315.            "YES",\
  316.            "NO"
  317.    ON (@key + 3) GOTO exit,get_length,yes,do_ctrlines,yes,no,
  318.  
  319. :yes
  320.    ax = length + .1
  321.    ay = 0
  322.    bx = -(length + .1)
  323.    by = 0
  324.    lntype = 3
  325.    DOSUB sh_drwln
  326.  
  327.    ax = 0
  328.    ay = .1 + width
  329.    bx = 0
  330.    by = -(.1 + width)
  331.    lntype = 3
  332.    DOSUB sh_drwln
  333.  
  334. REM back to the begining
  335. :no
  336.    GOTO get_length
  337.  
  338. :exit
  339.    MODE NORMAL
  340.    CHAIN shapes
  341.    exit
  342.