;;;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, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 5-14-93
;;;>		   EDITED: 06-29-2006
;;;
(DEFUN angl_error (msg /)
  (PRINC (STRCAT "\nError: " msg))
  (IF oldanglosmode
    (SETVAR "OSMODE" oldanglosmode)
  ) ;_ end of IF
  (IF (AND oldanglcecolor (EQ "(" (SUBSTR oldanglcecolor 3 1)))
    (SETQ oldanglcecolor (SUBSTR oldanglcecolor 1 1))
  ) ;_ end of if
  (IF oldanglaperture
    (SETVAR "APERTURE" oldanglaperture))
  (IF oldanglosmode
    (SETVAR "OSMODE" oldanglosmode))
  (IF oldanglsnapang
    (SETVAR "SNAPANG" oldanglsnapang))
  (SETQ *error* orig_anglerror)
  (PRINC)
) ;_ end of DEFUN
(DEFUN C:ANGL (/);e0ang e1ang e2ang pt2 andr vdis osmode celtype cecolor snapang)
  (SETQ orig_anglerror *error*
        *error* angl_error
  ) ;_ end of SETQ
  (SETQ	oldanglaperture (GETVAR "APERTURE")
	oldanglosmode   (GETVAR "OSMODE")
	oldanglceltype  (GETVAR "CELTYPE")
	oldanglcecolor  (GETVAR "CECOLOR")
	oldanglsnapang  (GETVAR "SNAPANG")
  ) ;_ end of setq
  (SETVAR "OSMODE" 0)
  (SETVAR "CMDECHO" 0)
  (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 oldanglcecolor 3 1))
    (SETQ oldanglcecolor (SUBSTR oldanglcecolor 1 1))
  ) ;_ end of if
  (SETVAR "APERTURE" oldanglaperture)
  (SETVAR "OSMODE" oldanglosmode)
  (SETVAR "SNAPANG" oldanglsnapang)
  (COMMAND ".linetype" "s" oldanglceltype "" ".color" oldanglcecolor) ;_ end of command
  (PRINC)
)
;;;
;;;* UPOINT User interface point 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 point variable
;;;* is added as <DEF> (nil for none), and a : is added. BPT is base point
;;;* (nil for none).
;;;*
(DEFUN upoint (bit kwd msg def bpt / inp)
  (IF def
    (IF	(EQ (TYPE def) 'STR)
      (SETQ msg	(STRCAT "\n" msg " <" def ">:")
	    bit	(* 2 (FIX (/ bit 2)))
      ) ;_ end of setq
      (PROGN
	(SETQ pts (STRCAT
		    (RTOS (CAR def))
		    ","
		    (RTOS (CADR def))
		    (IF
		      (AND (CADDR def) (= 0 (GETVAR "FLATLAND")))
		       (STRCAT "," (RTOS (CADDR def)))
		       ""
		    ) ;_ end of if
		  )
	      msg (STRCAT "\n" msg " <" pts ">: ")
	      bit (* 2 (FIX (/ bit 2)))
	) ;_ end of setq
      ) ;_ end of progn
    ) ;_ end of if
    (SETQ msg (STRCAT "\n" msg ": "))
  )					;if a default was supplied
  (INITGET bit kwd)
  (SETQ	inp
	 (IF bpt
	   (GETPOINT msg bpt)
	   (GETPOINT msg)
	 ) ;_ end of if
  )
  (IF inp
    inp
    def
  ) ;_ end of if
)
;;;* 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)))
    ) ;_ end of setq
    (SETQ msg (STRCAT "\n" msg ": "))
  ) ;_ end of if
  (INITGET bit kwd)
  (SETQ	inp
	 (IF bpt
	   (GETANGLE msg bpt)
	   (GETANGLE msg)
	 ) ;_ end of if
  ) ;_ end of setq
  (IF inp
    inp
    def
  ) ;_ end of if
)
(PRINC)
(defun rotx (pt1 / );abase nxent
  (setq abase (nentselp pt1))
  (if abase
    (if
      (or
        (eq(cdr(assoc 0(entget(nth 0 abase))))"TEXT")
        (eq(cdr(assoc 0(entget(nth 0 abase))))"LINE")
        (eq(cdr(assoc 0(entget(nth 0 abase))))"VERTEX")
        (eq(cdr(assoc 0(entget(nth 0 abase))))"POLYLINE")
        (eq(cdr(assoc 0(entget(nth 0 abase))))"LWPOLYLINE")
        (eq(cdr(assoc 0(entget(car abase))))"LINE")
      )
    (progn
      (setq basent (entget (nth 0 abase)))
      (cond
        ((eq(cdr(assoc 0 basent))"LWPOLYLINE")
         (setq lwptslst nil)
         (foreach n basent
           (if (eq (car n) 10)
             (setq lwptlst (append lwptlst (list (cdr n))))
           )
         )
         (setq pntcnt 0
               pntlen (length lwptlst)
         )
         (while (< pntcnt (1- pntlen))
;;;           (princ "\nAngle=")
;;;           (princ (angle (nth pntcnt lwptlst)(nth (1+ pntcnt) lwptlst)))
;;;           (princ "\nAngle=")
;;;           (princ (angle (nth pntcnt lwptlst)(cadr abase)))
;;;           (princ "\nSIN=")
;;;           (princ (SIN(-(angle (nth pntcnt lwptlst)(nth (1+ pntcnt) lwptlst))
;;;                        (angle (nth pntcnt lwptlst)(cadr abase))
;;;                      )
;;;                  )
;;;           )
           (IF (AND
                 (< (ABS(SIN(-(angle (nth pntcnt lwptlst)(nth (1+ pntcnt) lwptlst))
                              (angle (nth pntcnt lwptlst)(cadr abase)))))
                    0.04
                 )
                 (<(distance (nth pntcnt lwptlst)(cadr abase))
                   (distance (nth pntcnt lwptlst)(nth (1+ pntcnt) lwptlst)))
                 (<(distance (nth (1+ pntcnt) lwptlst)(cadr abase))
                   (distance (nth pntcnt lwptlst)(nth (1+ pntcnt) lwptlst)))
               )
             (progn
               (setq pt001 (nth pntcnt lwptlst))
               (setq pt002 (nth (1+ pntcnt) lwptlst))
               (setvar "SNAPANG"
                       (angle pt001
                              pt002
                       );angle
               );setvar
             )
           )
           (setq pntcnt (1+ pntcnt))
         )
        )
        ((eq(cdr(assoc 0 basent))"VERTEX")
         (COND
           ((EQ(TYPE(CAR(LAST abase)))'ENAME)
            (SETQ nxent (entget(entnext(cdr(assoc -1 basent))))
                  xr_edata (ENTGET(CAR(LAST abase))))
              (setvar "SNAPANG"
                      (+(angle (cdr (assoc 10 basent))
                               (cdr (assoc 10 nxent))
                        );angle
                        (CDR (ASSOC 50 xr_edata)))
              );setvar
            )
           (T
             (setq nxent (entget(entnext(cdr(assoc -1 basent)))))
             (setvar "SNAPANG"
                     (angle (cdr (assoc 10 basent))
                            (cdr (assoc 10 nxent))
                     );angle
             );setvar
            ))
        )
        ((eq(cdr(assoc 0 basent))"LINE")
         (COND
           ((EQ(TYPE(CAR(LAST abase)))'ENAME)
            (SETQ xr_edata (ENTGET(CAR(LAST abase))))
              (setvar "SNAPANG"
                      (+(angle (cdr (assoc 10 basent))
                               (cdr (assoc 11 basent))
                        );angle
                        (CDR (ASSOC 50 xr_edata)))
              );setvar
            )
          (T
            (setvar "SNAPANG"
                    (angle (cdr (assoc 10 basent))
                           (cdr (assoc 11 basent))
                    );angle
            );setvar
           )
        ))
        ((eq(cdr(assoc 0 basent))"TEXT")
         (COND
           ((EQ(TYPE(CAR(LAST abase)))'ENAME)
            (SETQ xr_edata (ENTGET(CAR(LAST abase))))
              (setvar "SNAPANG"
                      (+(cdr (assoc 50 basent))
                        (CDR (ASSOC 50 xr_edata)))
              );setvar
            )
           (T
             (setvar "SNAPANG" (cdr(assoc 50 basent)))
            )
        ))
      );cond
    )
    (princ (strcat"\nSelection for ROTX is "(cdr(assoc 0(entget(nth 0 abase))))". "))
    );if
    (progn
      (setq snap_pt2 (getpoint pt1 "\nPick second point for Snapang: "))
      (setvar "SNAPANG" (angle pt1 snap_pt2))
    )
  );if
  (setq rotang (getvar"snapang")
        nvwang (*(/(-(* 2 pi)rotang)pi)180)
  )
  (if (>= nvwang 180)
    (setq altang (- nvwang 180))
    (setq altang (+ nvwang 180))
  )
;  (c:svang)
  (princ "\nUse SVANG to set Viewtwist to X-hairs. ")
  (princ)
);defun ROTX.LSP
(PRINC)

;|«Visual LISP© Format Options»
(72 2 40 2 T "end of " 60 9 2 0 0 T T nil T)
;*** DO NOT add text below the comment! ***|;