;Construct a line at an angle from selected line. UANGLE and ROTX are defun'd within.
;
;
;	AUTHOR: Henry C. Francis
;		425 N. ASHE ST.
;		SOUTHERN PINES, N.C. 28387
;		All rights reserved without prejudice.
;
;	Copyright:	5-14-93
;	Edited:		5-4-00
;
(defun C:ANGL ( / );e0ang e1ang e2ang pt2 andr vdis osmode celtype cecolor snapang)
       (setq aperture (getvar "APERTURE") osmode (getvar "OSMODE")
             celtype (getvar "CELTYPE") cecolor (getvar "CECOLOR") snapang (getvar "SNAPANG"))
       (setvar "CMDECHO" 0)
;;;         (setvar "OSMODE" 1)
       (setvar "APERTURE" 5)
           (setq pt1 (getpoint "\nPoint to Turn from"))
             (rotx pt1)
;;;             (setvar "OSMODE" 512)
             (setq pt2 (upoint 1 "" "Vector to Turn from" nil pt1))
;;;             (setvar "OSMODE" 0)
             (setq e1ang (uangle 1 "" "Angle to Turn" nil pt1))
	     (setq vdis (distance pt1 pt2))
	     (setq e2ang (angle pt1 pt2))
	     (setq e0ang (+ e1ang e2ang))
	     (setq andr (strcat "@" (rtos vdis) "<" (angtos e0ang)))
	     (command ".line" pt1 andr "")
           (if (eq "(" (substr cecolor 3 1)) (setq cecolor (substr cecolor 1 1)))
           (setvar "APERTURE" aperture) (setvar "OSMODE" osmode)
           (setvar "SNAPANG" snapang)
           (command ".linetype" "s" celtype ""
                    ".color" cecolor)
   (princ)
);defun C:ANGL
;* UANGLE User interface angle function 
;* BIT (1 for no null, 0 for none) and KWD key word ("" for none) are same as
;* for INITGET. MSG is the prompt string, to which a default real in rads is
;* added as <DEF> (nil for none), and a : is added. BPT is base point (nil
;* for none).
;*
(defun uangle (bit kwd msg def bpt / inp)
  (if def 
    (setq msg (strcat "\n" msg " <" (angtos def) ">: ")
          bit (* 2 (fix (/ bit 2)))
    )
    (setq msg (strcat "\n" msg ": "))
  )
  (initget bit kwd)
  (setq inp
    (if bpt
       (getangle msg bpt)
       (getangle msg)
  ) )
  (if inp inp def)
);defun
;*
(princ)
(defun rotx (pt1 / sset sslen count)
  (setq factr 1
        sset (ssget "c" (list (-(car pt1) factr)(-(cadr pt1) factr))
                        (list (+(car pt1) factr)(+(cadr pt1) factr)))
        count 0)
  (if sset (setq sslen (sslength sset))(setq sslen 0))
  (while
    (< count sslen)
        (if
            (equal "LINE" (cdr (assoc 0 (entget (ssname sset count)))))
          (progn
            (setvar "SNAPANG"
                    (angle (cdr (assoc 10 (entget (ssname sset count))))
                           (cdr (assoc 11 (entget (ssname sset count))))
                    );angle
            );setvar
            (setq count (+ sslen 1))
          );progn
          (setq count (+ count 1))
        );if
  );while
(setq sset nil)
);defun ROTX.LSP
;*
(princ)
;*