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 / LNPARTAN.CDL < prev    next >
Encoding:
Text File  |  1989-03-08  |  3.5 KB  |  149 lines
  1.  
  2. REM     date:     030787 simon izraelevitz
  3.  
  4. REM     task:     creates a line tangent to an arc or circle and
  5. REM               parallel to another line. Works from any view
  6.  
  7. REM     restrictions: arc and line must be coplanars.
  8. REM     -----------------------------------------------
  9.  
  10.    CLEAR
  11.    accuracy = 0.00005
  12.    ARRAY  vm[9]
  13.    ARRAY  vm1[9]
  14.  
  15. :ind_ln
  16. REM     *** get base line
  17.    SET mask,2
  18.    GETENT  "Indicate line", etype
  19.    IF (@KEY <= -2)
  20.       GOTO exit
  21.  
  22.    p1wx = @FLTDAT[0]
  23.    p1wy = @FLTDAT[1]
  24.    p1wz = @FLTDAT[2]
  25.    p2wx = @FLTDAT[3]
  26.    p2wy = @FLTDAT[4]
  27.    p2wz = @FLTDAT[5]
  28.  
  29. :ind_arc
  30. REM     *** get arc
  31. SET mask,3
  32.    GETENT  "Indicate arc or circle", etype
  33.    ON (@KEY + 3) GOTO exit,ind_ln,ind_arc,
  34.    cvx = @FLTDAT[0]
  35.    cvy = @FLTDAT[1]
  36.    cvz = @FLTDAT[2]
  37.    rad = @FLTDAT[3]
  38.    arcview = @INTDAT[8]
  39.  
  40. REM     *** save cursor pick
  41.    crvx = @XCURSOR
  42.    crvy = @YCURSOR
  43.  
  44. REM     *** define arc view 
  45.    GETVIEW arcview,avm
  46.  
  47. REM     *** store present construction view
  48.    CALL memcpy,vm,0,@CVIEWMAT,0,9
  49.  
  50. REM     *** map arc view z-axis to present view
  51.    CALL xfmwv,vm,avm[2],avm[5],avm[8],av,bv,cv
  52.    dv = -cvz
  53. REM     *** calculate intersection of cursor pick and plane of definition
  54. REM         of arc
  55.    crvz = -(av*crvx + bv*crvy + dv)/cv
  56.  
  57. REM     *** map cursor pick to arc view coord.
  58.    CALL xfmvw,vm,crvx,crvy,crvz,crwx,crwy,crwz
  59.    CALL xfmwv,avm,crwx,crwy,crwz,crvx,crvy,crvz
  60.  
  61. REM     *** map line to arc view coord.
  62.    CALL xfmwv,avm,p1wx,p1wy,p1wz,p1vx,p1vy,p1vz
  63.    CALL xfmwv,avm,p2wx,p2wy,p2wz,p2vx,p2vy,p2vz
  64.  
  65. REM     *** check if line and arc are coplanar
  66.    IF ((abs(p1vz-cvz) > accuracy) || (abs(p2vz-cvz) > accuracy))
  67.       GOTO error1
  68.  
  69. REM     *** define line unit vector, arc view coord.
  70.    dx = p2vx - p1vx
  71.    dy = p2vy - p1vy
  72.    dz = p2vz - p1vz
  73.    magn = sqrt(dx*dx + dy*dy + dz*dz)
  74.    IF (magn <= accuracy)
  75.       GOTO error2
  76.    uvx = dx/magn
  77.    uvy = dy/magn
  78.    uvz = dz/magn
  79.  
  80. REM     *** line coefficients, arc view coord
  81.    xc = uvy
  82.    yc = -uvx
  83.    ind = p1vy*uvx - p1vx*uvy
  84.  
  85. REM     *** distance from center of arc to line
  86.    dist1 = abs(cvx*xc + cvy*yc + ind)/sqrt(xc*xc + yc*yc)
  87.  
  88. REM     *** distance from cursor pick to line
  89.    dist2 = abs(crvx*xc + crvy*yc + ind)/sqrt(xc*xc + yc*yc)
  90.  
  91. REM     *** calculate vector normal to base line in the direction
  92. REM         of the cursor pick
  93.    pdist = abs((crvx - p1vx)*uvx + (crvy - p1vy)*uvy)
  94.    pjx   = p1vx + pdist*uvx
  95.    pjy   = p1vy + pdist*uvy
  96.    cjvx  = (crvx - pjx)/dist2
  97.    cjvy  = (crvy - pjy)/dist2
  98.  
  99. REM     *** define solution flag
  100.    IF (dist1 >= rad)
  101.       GOTO flag1
  102.    IF (dist2 >= rad)
  103.       GOTO flag2
  104.    GOTO flag3
  105.  
  106. :flag1  
  107.    flag = (dist2 - dist1)/(abs(dist2 - dist1))
  108.    GOTO distance
  109.  
  110. :flag2  
  111.    flag = 1
  112.    GOTO distance
  113.  
  114. :flag3  
  115.    flag = -1
  116.  
  117. :distance        
  118. REM     *** distance from solution tangent line to base line
  119.    dis = abs(dist1 + flag*rad)
  120.  
  121. REM     *** solution line, view coord
  122.    s1vx = p1vx + (dis*cjvx)
  123.    s1vy = p1vy + (dis*cjvy)
  124.    s1vz = p1vz
  125.    s2vx = p2vx + (dis*cjvx)
  126.    s2vy = p2vy + (dis*cjvy)
  127.    s2vz = p2vz
  128.  
  129. REM *** map line to world coord.
  130.    CALL xfmvw,avm,s1vx,s1vy,s1vz,s1wx,s1wy,s1wz
  131.    CALL xfmvw,avm,s2vx,s2vy,s2vz,s2wx,s2wy,s2wz
  132.  
  133.    LINE  s1wx,s1wy,s1wz,s2wx,s2wy,s2wz
  134.    GOTO ind_arc
  135.  
  136. :error1
  137.    PROMPT  " Base line and arc are not coplanar...Select again "
  138.    WAIT 2
  139.    GOTO ind_ln
  140.  
  141. :error2
  142.    PROMPT  " Zero length line... Select again."
  143.    WAIT 2
  144.    GOTO ind_ln
  145.  
  146. :exit
  147.    SET mask
  148.    EXIT
  149.