;;;Translate plines w/ arcs to plines w/ mult. straight segments for use
;;;with DTM TIN's for contouring.  Rounds out pline arcs via a suitable no.
;;;of straight segments.  The determiner is based on small angle deflection.
;;;
;;;>	Author:	Henry C. Francis
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 5-10-96
;;;>		   EDITED: 10-06-2005
;;;
(DEFUN c:plxl (/ found)
  (SETQ	osmod (GETVAR "osmode")
	fltot 0
	incrn 0
  ) ;_ end of setq
  (SETVAR "osmode" 0)
  (SETQ	usrdeg (ureal 1
		      ""
		      "Deflection angle (< 5 degrees)"
		      (IF usrdeg
			usrdeg
			5.0
		      ) ;_ end of if
	       ) ;_ end of ureal
  ) ;_ end of setq
  (SETQ usrrad (* (/ usrdeg 180.0000) PI))
  (SETQ pliness (SSGET '((0 . "POLYLINE"))))
  (IF pliness
    (PROGN
      (COMMAND ".undo" "m")
      (SETQ plinesslen
	     (SSLENGTH pliness)
	    sscount 0
      ) ;_ end of setq
      (WHILE (< sscount plinesslen)
	(SETQ currpline (SSNAME pliness sscount))
	(SETQ plent (ENTGET currpline))
	(SETQ plvert (ENTGET (ENTNEXT (CDAR plent))))
	(PROGN
	  (ENTMAKE
	    (LIST
	      (ASSOC 0 plent)
	      (ASSOC 8 plent)
	      (ASSOC 66 plent)
	      (ASSOC 10 plent)
	      (ASSOC 70 plvert)
	    ) ;_ end of list
	  ) ;_ end of entmake
	  (ENTMAKE
	    (LIST
	      (ASSOC 0 plvert)
	      (ASSOC 10 plvert)
	    ) ;_ end of list
	  ) ;_ end of entmake
;;;----repeat this until the end of the polyline
	  (WHILE (/= (CDR (ASSOC 0 (ENTGET (ENTNEXT (CDAR plvert)))))
		     "SEQEND"
		 ) ;_ end of /=
;;;------if it begins an arc segment
	    (IF	(/= (CDR (ASSOC 42 plvert)) 0)
;;;--------do this
	      (PROGN
		(SETQ found T)
		(SETQ plnvert (ENTGET (ENTNEXT (CDAR plvert))))
		(SETQ strt40 (CDR (ASSOC 40 plvert)))
		(SETQ end41 (CDR (ASSOC 41 plvert)))
		(SETQ fpt1 (CDR (ASSOC 10 plvert)))
		(SETQ fpt2 (CDR (ASSOC 10 plnvert)))
		(SETQ chrdl (DISTANCE fpt1 fpt2))
		(SETQ theta (ATAN (CDR (ASSOC 42 plvert))))
		(SETQ psi (- (/ PI 2) (ABS theta)))
		(SETQ phi (* (ABS theta) 4))
		(SETQ chang (ANGLE fpt1 fpt2))
		(SETQ arcr (ABS	(/ (* (DISTANCE fpt1 fpt2) (SIN psi))
				   (* 2 (COS theta) (SIN (* 2 theta)))
				) ;_ end of /
			   ) ;_ end of abs
		) ;_ end of setq
		(SETQ arcc
		       (IF (> theta 0)
			 (POLAR fpt1 (+ (- chang theta) psi) arcr)
			 (POLAR fpt1 (- (- chang theta) psi) arcr)
		       ) ;_ end of if
		) ;_ end of setq
		(SETQ fenl    (* phi arcr)
		      count   (1+ (FIX (/ phi usrrad)))
		      plwinc  (/ (- strt40 end41) count)
		      plwe    (+ strt40 plwinc)
		      incra   (/ phi count)
		      incrn   0
		      initang (ANGLE arcc fpt1)
		) ;_ end of setq
		(WHILE
		  (> count 0)
		   (SETQ incrn (1+ incrn))
		   (SETQ plwb plwe
			 plwe (- plwe plwinc)
		   ) ;_ end of setq
		   (IF (< theta 0)
		     (SETQ fpt4
			    (POLAR arcc (- initang (* incrn incra)) arcr)
		     ) ;_ end of setq
		     (SETQ fpt4
			    (POLAR arcc (+ initang (* incrn incra)) arcr)
		     ) ;_ end of setq
		   ) ;_ end of if
		   (PROGN
		     (ENTMAKE
		       (LIST
			 (CONS 0 "VERTEX")
			 (ASSOC 8 plvert)
			 (CONS 10 fpt4)
		       ) ;_ end of list
		     ) ;_ end of entmake
		     (GRDRAW fpt1 fpt4 1 1)
		   ) ;_ end of progn
		   (SETQ fpt1  fpt4
			 count (1- count)
		   ) ;_ end of setq
		) ;_ end of while
		(SETQ plvert (ENTGET (ENTNEXT (CDAR plvert))))
	      ) ;_ end of progn
;;;--------or else it begins a line segment so do this
	      (PROGN
		(SETQ fpt1 (CDR (ASSOC 10 plvert)))
		(SETQ fpt2
		       (CDR (ASSOC 10 (ENTGET (ENTNEXT (CDAR plvert)))))
		) ;_ end of setq
		(SETQ fenl (DISTANCE fpt1 fpt2))
		(ENTMAKE
		  (LIST
		    (CONS 0 "VERTEX")
		    (ASSOC 8 plvert)
		    (CONS 10 fpt2)
		  ) ;_ end of list
		) ;_ end of entmake
		(GRDRAW fpt1 fpt2 1 1)
		(SETQ fpt1 fpt2)
		(SETQ plvert (ENTGET (ENTNEXT (CDAR plvert))))
	      ) ;_ end of progn
	    ) ;_ end of if
	  ) ;_ end of while
	  (IF found
	    (PROGN
	      (ENTMAKE
		(LIST
		  (CONS 0 "SEQEND")
		) ;_ end of list
	      ) ;_ end of entmake
              (ENTDEL currpline)
	    ) ;_ end of progn
	    (PROGN
	      (ENTMAKE)
	      (COMMAND ".redraw")
	      (PRINC "\nPolyline contains no arcs. ")
	    ) ;_ end of progn
	  ) ;_ end of if
	) ;_ end of progn
	(SETQ sscount (1+ sscount))
      ) ;_ end of WHILE
    ) ;_ end of progn
  ) ;_ end of if
  (PRINC)
) ;_ end of defun

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