;Place polyline with small-angle-deflection segments instead of arcs.
;Useful for generating TINs that will follow curves.  (see PLXL for
;converting existing polylines w/ arcs).
;
;	AUTHOR: HENRY C. FRANCIS
;		425 N. ASHE ST.
;		SOUTHERN PINES, NC 28387
;              
;		All rights reserved without prejudice.
;
;	Copyright:	5-10-96
;	Edited:		5-10-96
;
(defun c:plcont ( / arcb fensta clspt fpt chrdl strtl clclf count fpt1 fpt2 fpt3 fpt4 fpt5 arcs arcc fltot)
(setq osmod (getvar"osmode")
      fltot 0)
(setvar "osmode" 0)
(entmake (list (cons 0 "endblk")))
  (setq dimsc (getvar"dimscale"))
  (setq aorln " Arc/<Line first point>")
  (cond
    ((eq modf "XIST")
      (setq cirad (* dimsc 0.03125))
      (setq fensta "Existing"))
    ((not(eq modf "XIST"))
      (setq cirad (* dimsc 0.0469))
      (setq fensta "Proposed"))
  );cond
  (while(not fpt1)
    (setq fpt (upoint 0 "Arc Line" (strcat fensta " contour" aorln) nil nil))
    (cond
      ((eq fpt "Arc")
        (setq aorln " Line/<Arc first point>"))
      ((eq fpt "Line")
        (setq aorln " Arc/<Line first point>"))
      (fpt
        (setq fpt1 fpt
              clspt fpt1
              strtl 1))
    );cond
  );while
  (entmake
    (list
      (cons 0 "POLYLINE")
      (cons 66 1)
      (cons 10 fpt)
    )
  )
  (entmake
    (list
      (cons 0 "VERTEX")
      (cons 10 fpt)
    )
  )
  (while
    (and
      (not clclf)
      (if(eq fpt "Arc")
        (setq fpt2 (upoint 0 "Close" (strcat fensta " contour Close/<Arc next point>") nil fpt1))
        (if(or(not fpt2)(< strtl 3))
          (progn
            (setq strtl (1+ strtl))
            (setq fpt2 (upoint 0 "Arc" (strcat fensta " contour Arc/<Line next point>") nil fpt1))
          );progn
          (setq fpt2 (upoint 0 "Arc Close" (strcat fensta " contour Arc/Close/<Line next point>") nil fpt1))
        );if
      );if
    );and
    (if(eq fpt2 "Close")
      (setq fpt2 clspt
            clclf T)
    );if
      (if
        (or
          (eq fpt2 "Arc")
          (eq fpt "Arc")
        );or
        (progn
        (cond
          ((eq fpt "Arc")
            (setq chrdl (distance fpt1 fpt2))
            (bulge))
        );cond
        (if(eq fpt2 "Arc")
          (progn
            (if clclf
              nil
              (setq fpt2 (upoint 0 "Close" (strcat fensta " contour Close/<Arc next point>") nil fpt1))
            );if
            (if(eq fpt2 "Close")
              (setq fpt2 clspt
                    clclf T)
            );if
            (setq chrdl (distance fpt1 fpt2))
            (bulge)
            (while (>= chrdl (* arcr 2))
              (progn
                (princ (strcat"\nChord length greater than or equal to 2r <" (rtos(/ chrdl 2))" min.>"))
                (setq arcr nil)
                (bulge)
              );progn
            );while
            (setq fpt "Arc")
          );progn
        );if
        (if(eq fpt2 "Close")
          (setq fpt2 clspt
                clclf T)
        );if
        (setq chrdl (distance fpt1 fpt2))
        (bulge)
        (while (>= chrdl (* arcr 2))
          (progn
            (princ (strcat"\nChord length greater than or equal to 2r <" (rtos(/ chrdl 2))" min.>"))
            (setq arcl nil)
            (bulge)
          );progn
        );while
        (progn
          (setq incla(*(atan(/ chrdl(* 2 arcr))(sqrt(- 1(*(/ chrdl(* 2 arcr))(/ chrdl(* 2 arcr))))))2)
                oangs (/(- pi incla)2)
                langl (angle fpt1 fpt2)
                lpt (polar fpt1 (+ langl oangs) arcr)
                rpt (polar fpt1 (- langl oangs) arcr)
          );setq
          (if
            (or
              (and
                (<(distance lpt arcc)(distance rpt arcc))
                (<(distance lpt arcs)(distance rpt arcs))
              );and
              (and
                (>(distance lpt arcc)(distance rpt arcc))
                (>(distance lpt arcs)(distance rpt arcs))
              );and
            );or
            (setq incla (-(+ pi pi)incla))
          );if
          (setq fenl (* incla arcr)
                count (1+(fix(/ fenl (* dimsc 0.5))))
                incrn (1- count)
          );setq
          (while
            (> count 0)
            (if(<(distance lpt arcc)(distance rpt arcc))
              (if(<(distance lpt arcs)(distance rpt arcs))
                (setq ipt lpt
                      incra (+(angle ipt fpt2)(*(/ incla incrn)(1- count)))
                      fpt4 (polar ipt incra arcr)
                      fpt3 (polar fpt1 (angle fpt1 fpt4)(* dimsc 0.0625))
                      fpt5 (polar fpt4 (+(angle fpt1 fpt4)pi) (* dimsc 0.0625))
                );setq
                (setq ipt lpt
                      incra (-(angle ipt fpt2)(*(/ incla incrn)(1- count)))
                      fpt4 (polar ipt incra arcr)
                      fpt3 (polar fpt1 (angle fpt1 fpt4)(* dimsc 0.0625))
                      fpt5 (polar fpt4 (+(angle fpt1 fpt4)pi) (* dimsc 0.0625))
                );setq
              );if
              (if(>(distance lpt arcs)(distance rpt arcs))
                (setq ipt rpt
                      incra (-(angle ipt fpt2)(*(/ incla incrn)(1- count)))
                      fpt4 (polar ipt incra arcr)
                      fpt3 (polar fpt1 (angle fpt1 fpt4)(* dimsc 0.0625))
                      fpt5 (polar fpt4 (+(angle fpt1 fpt4)pi) (* dimsc 0.0625))
                );setq
                (setq ipt rpt
                      incra (+(angle ipt fpt2)(*(/ incla incrn)(1- count)))
                      fpt4 (polar ipt incra arcr)
                      fpt3 (polar fpt1 (angle fpt1 fpt4)(* dimsc 0.0625))
                      fpt5 (polar fpt4 (+(angle fpt1 fpt4)pi) (* dimsc 0.0625))
                );setq
              );if
            );if
            (if(eq(1- count)incrn)
              nil
              (progn
                (entmake
                  (list
                    (cons 0 "VERTEX")
                    (cons 10 fpt4)
                  )
                )
                (grdraw fpt1 fpt4 7)
              );progn
            );if
            (setq fpt1 fpt4
                  count (1- count)
            );setq
            (setq fpt nil)
          );while
        );progn
        );progn
      (progn
      (setq fenl (distance fpt1 fpt2))
        (entmake
          (list
            (cons 0 "VERTEX")
            (cons 10 fpt2)
          )
        )
        (grdraw fpt1 fpt2 7)
        (setq fpt1 fpt2)
      );progn
      );if
    (setq arcc nil arcs nil arcm nil)
    (setq fltot (+ fltot fenl))
  );while
  (entmake
    (list
      (cons 0 "SEQEND")
    );list
  );entmake
(setvar "osmode" osmod)
(setq arcb nil)
(princ)
);defun
;********
(defun bulge ( / )
  (if(eq arcm "Bulge")
    (progn
    (if(and fpt2 chrdl arcs)
      nil
      (progn
        (setq arcb (ureal 1 "Radius" "Arc Radius/<Bulge>" (if arcb arcb nil)))
        (if(eq arcb "Radius")
          (progn
            (setq arcm nil arcb nil)
            (bulge)
          );progn
          (progn
            (cond
              ((not fpt2)
                (setq fpt2 (upoint 0 "Close" (strcat fensta " contour Close/<Arc next point>") nil fpt1))
                (if(eq fpt2 "Close")
                  (setq fpt2 clspt
                        clclf T)
                ));if ;not
            );cond
            (setq chrdl (distance fpt1 fpt2))
            (setq arcr
              (/
                (* chrdl(sin(-(atan(/ chrdl 2)arcb)(atan(/ arcb(/ chrdl 2))))))
                (sin(* 2(- pi(* 2(atan(/ chrdl 2)arcb)))))
              )
            );setq
            (setq arcs (upoint 1 "" "Pick side for arc" nil nil))
            (if
              (<(distance lpt arcs)(distance rpt arcs))
                (setq arcc rpt)
                (setq arcc lpt)
            );if
          );progn
        );if
      );progn
    );if
    );progn
    (if(or(not arcc)(not arcs)(not arcr))
      (progn
        (setq arcm (ureal 1 "Bulge" "Arc Bulge/<Radius>" (if arcr arcr nil)))
        (if(eq arcm "Bulge")
          (bulge)
          (progn
            (setq arcr arcm arcm nil)
            (setq arcc (upoint 1 "" "Pick side for arc center" nil nil))
            (setq arcs (upoint 1 "" "Pick side for arc" nil nil))
          );progn
        );if
      );progn
    );if
  );if
  (princ)
);defun