home *** CD-ROM | disk | FTP | other *** search
/ Current Shareware 1994 January / SHAR194.ISO / cad_util / v8n8_cad.zip / RADTICS.LSP < prev    next >
Lisp/Scheme  |  1993-07-23  |  2KB  |  55 lines
  1. (defun *error* (msg)
  2.   (princ msg)
  3.   (princ)
  4. );defun
  5. (defun C:RAD ( / ce bm ds arc1 ent1 rad rad1 dist1 ang1         ang2 ang3 ang4 dist2 dist3 rad2 ang5 pt1 pt2 pt3 t4   
  6.     nam count)
  7.   (setq ce (getvar "cmdecho"))
  8.   (setq bm (getvar "blipmode"))
  9.   (setq ds (getvar "dimscale"))
  10.   (setvar "cmdecho" 0)
  11.   (setvar "blipmode" 0)
  12.   (setq count 0)
  13.   (while (= count 0)
  14.     (setq
  15.       arc1 (entsel "\nSelect Arc:")
  16.       ent1 (entget (car arc1))
  17.       nam (cdr (assoc 0 ent1))
  18.     );setq
  19.     (if (/= nam "ARC")
  20.       (progn
  21.         (princ "\nNot an arc, try again!
  22.  <polylines not allowed>")
  23.         (setq arc1 nil)
  24.         (setq ent1 nil)
  25.       );progn
  26.       (setq count 1)
  27.     );if
  28.   );while
  29.   (setq
  30.       rad (cdr (assoc 40 ent1))
  31.       rad1 (+ rad (* 0.01 ds))
  32.       dist1 (sqrt (- (* rad1 rad1) (* rad rad)))
  33.       ang1 (cdr (assoc 50 ent1))
  34.       ang2 (cdr (assoc 51 ent1))
  35.       ang3 (+ ang1 (atan dist1 rad))
  36.       ang4 (/ (- ang2 ang1) 2.0)
  37.       dist2 (* rad (/ (sin ang4) (cos ang4)))
  38.       dist3 (+ dist2 (* 0.09 ds))
  39.       rad2 (sqrt (+ (* dist3 dist3) (* rad rad)))
  40.       ang5 (+ ang1 (atan dist3 rad))
  41.       pt2 (cdr (assoc 10 ent1))
  42.       pt1 (polar pt2 (+ ang1 ang4) rad)
  43.       pt3 (polar pt2 ang3 rad1)
  44.       pt4 (polar pt2 ang5 rad2)
  45.   );setq
  46.   (command
  47.       "ucs" "s" "curorig" "Y"
  48.       "ucs" "w"
  49.       "line" pt3 pt4 ""
  50.       "mirror" "L" "" pt1 pt2 ""
  51.       "ucs" "r" "curorig"
  52.   );command  (setvar "cmdecho" ce)
  53.   (setvar "blipmode" bm)
  54.   (princ)
  55. );defun