;|

Flex.lsp
Version history
3.2	2003/03/04	Localized variable NextPointFactor. Added variable for default curve type
			and layer color. Curve type was localized for the PEdit command.
3.1	2002/06/28	Anniversary (wedding) release. Update usage permissions.
3.0	2000/05/18	General use release.
2.1   	1994/03/31      Added code for correct Release 12 operation.
2.0	1992/06/28	Major revision to support defaults & splined polylines.
1.0	1989/09/09	Initial release.

Draw a zig-zag polyline. Used for flexible ductwork.

Copyright ©, 1989-2003, by R. Robert Bell.

3914 E Bridgeport Ave
Spokane WA 99217-6933
509.487.3312

Written permission must be obtained to modify this software.
Permission is granted to copy and use this software, as long
as the code and this header are unmodified.

Exception: the software may be modified to change the values 
for the following five variables only:

LayerName				
LayerColor
DefaultCurve
NextPointFactor				
ZigZagWidth				

R. ROBERT BELL PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
R. ROBERT BELL SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.
R. ROBERT BELL DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM
WILL BE UNINTERRUPTED OR ERROR FREE.

RobertB@AcadX.com

********************************************************* ** SUBR **
|;
(defun I:LastEnt (/ A B)				; subr to get true last entity
 (if (setq A (entlast))					; if there is an entity in drawing
  (while (setq B (entnext A))				; then while a new sub-entity
   (setq A B)						; reset entity name to new one
  ) ;_ closes while
 ) ;_ closes if
 A							; return entity name
) ;_ closes defun I:LastEnt
;|
********************************************************* ** SUBR **
|;
(defun I:VarSav						; environment save/set subr
		(Vars					; variable list to save & set
		 NewErr					; new error routine, if any
		 /					; local variables
		 Inc					; counter
		 VarNam					; variable name to save & set
		) ;_ closes variable declare
 (setvar "CmdEcho" 0)					; turn off command echo
 (graphscr)						; flip to graphic screen
 (command "._undo" "_begin")				; start group for undo
 (if (not *Var*)
  (setq							; then...
   *Var*
   (list						; make a list
    (cons "OSMode" (getvar "OSMode"))			; save current running osnaps
    (list (getvar "CLayer"))				; save current layer
   ) ;_ closes list
  ) ;_ closes setq
 ) ;_ closes if
 (setq
  Inc -1						; initialize for loop
 ) ;_ closes setq
 (repeat (length Vars)					; repeat for each variable received
  (setq
   Inc	 (1+ Inc)					; increment counter
   *Var*
	 (cons						; add old setvar setting to list
	  (cons	(setq VarNam (strcase (car (nth Inc Vars))))
		(getvar VarNam)
	  ) ;_ closes cons
	  *Var*						; setvar list
	 ) ;_ closes cons
  ) ;_ closes setq
  (setvar VarNam (eval (cadr (nth Inc Vars))))		; set setvar to new value
 )							; closes repeat
 (if (and NewErr (null OldErr))				; if new error routine, no old one
  (setq							; then remember old one, use new one
   OldErr  *Error*
   *Error* NewErr
  ) ;_ closes setq
 ) ;_ closes if
) ;_ closes defun I:VarSav
;|
********************************************************* ** SUBR **
|;
(defun I:VarRes						; environment restore
		(/					; local variables
		 VarNam					; variable name to restore
		 iKill					; counter for command kill loop
		) ;_ closes variable declare
 (setvar "CmdEcho" 0)					; turn off command echo
 (graphscr)						; flip to graphic screen
 (repeat (length *Var*)					; repeat for each variable received
  (setq
   VarNam (car *Var*)					; get first value off list
   *Var*  (cdr *Var*)					; save rest of list
   iKill  0						; initialize for kill loop
  ) ;_ closes setq
  (if (cdr VarNam)					; if a saved setvar
   (setvar (car VarNam) (cdr VarNam))			; then restore old variable setting
   (progn						; else at layer name to restore
    (while (and (< iKill 5) (> (getvar "CmdActive") 0))	; while active commands
     (command)						; attempt to kill command
     (setq iKill (1+ iKill))				; increment counter
    ) ;_ closes while
    (if	(< iKill 5)					; if command kill worked
     (progn						; then...
      (setq VarNam (car VarNam))			; get layer name
      (command "._layer" "_thaw" VarNam "_set" VarNam "") ; restore layer
      (command "._linetype" "_set" "_bylayer" "")	; reset linetype to standard
      (while (eq (logand (getvar "UndoCtl") 8) 8)	; while undo groups to finish
       (command "._undo" "_end")			; finish undo group
      ) ;_ closes while
     ) ;_ closes progn
    ) ;_ closes if
   ) ;_ closes progn
  ) ;_ closes if
 ) ;_ closes repeat
 (if OldErr						; if there was a new error routine
  (setq							; then...
   *Error* OldErr					; reset error routine
   NewErr  nil						; clear new error out of memory
   OldErr  nil						; clear old error out of memory
  ) ;_ closes setq
 ) ;_ closes if
 (setvar "CmdEcho" 1)					; turn on command echo
) ;_ closes defun I:VarRes
;|
********************************************************* ** SUBR **
|;
(defun I:Push						; push setvar value on to *Var* stack
	      (VarNam)					; setvar name to store
 (setq
  *Var*
  (cons (cons (strcase VarNam) (getvar VarNam)) *Var*)	; add list of setvar & value to list
 ) ;_ closes setq
) ;_ closes defun I:Push
;|
********************************************************* ** SUBR **
|;
(defun I:Pop						; pop value stored in *Var* stack
	     (VarNam)					; setvar name to retrieve
 (setvar VarNam (I:DXF (strcase VarNam) *Var*))		; restore old variable setting
) ;_ closes defun I:Pop
;|
********************************************************* ** SUBR **
|;
(defun I:DXF						; get "dxf" data from entity data list
	     (DXF					; "dxf" marker to find
	      EntData					; entity data list
	     ) ;_ closes variable declare
 (cdr (assoc DXF EntData))				; return data from entity's "dxf" data
) ;_ closes defun I:DXF
;|
********************************************************* ** SUBR **
|;
(defun I:ErrFlex
	 (Err)						; subr for error trap/variable restore 
	 (if (/= Err "Function cancelled")		; if program bombed, not <ctrl><c>
	  (princ (strcat "Error: " Err))		; then print error message
	 ) ;_ closes if
	 (command)
	 (command)					; issue a few <ctrl><c>
	 (setq SList nil)				; clear selection set
	 (I:VarRes)					; restore variables and OldErr
	 (princ)					; clean exit
) ;_ closes defun I:ErrFlex
;|
********************************************************* *** MAIN CODE ***
|;
(defun C:Flex
	      (/					; local variables
	       LayerName				; name of layer for flex duct
	       LayerColor				; color for layer
	       DefaultCurve				; default curve type
	       NextPointFactor				; factor for longer zag along pline
	       ZigZagWidth				; width (perp to pline) of zag * DimScale
	       Pt1					; 1st point of pline
	       Pt2					; 2nd point of pline
	       CurveType				; type of pline curve (fit or spline)
	       OK					; flag for next point loop
	       SList					; selection set
	       Mark					; absolute last entity in drawing
	       Ent					; entity data
	       EntN					; entity name
	       Vertex					; vertex data
	       Count					; number of points to process
	       Pt3					; point of mid-point of a zag line
	       Pt4					; point of a zag line
	       Inc					; counter
	       X					; math operation flag
	       Ang					; angle between Pt3 & Pt4
	       CList					; construction selection set
	      ) ;_ closes variable declare
 (I:VarSav '(("Highlight" 0) ("OrthoMode" 0)) I:ErrFlex); save & set environment

 (setq
  LayerName "Duct-Flex"					; THIS VALUE MAY BE CHANGED BY THE END USER
  LayerColor "7"		  			; THIS VALUE MAY BE CHANGED BY THE END USER
  DefaultCurve "Fit"					; THIS VALUE MAY BE CHANGED BY THE END USER
  		  					; valid values are "Fit" or "Spline"
  NextPointFactor 1.5					; THIS VALUE MAY BE CHANGED BY THE END USER
  ZigZagWidth (*
	       0.03125					; THIS VALUE MAY BE CHANGED BY THE END USER
	       (if (eq (getvar "DimScale") 0)
		1
		(getvar "DimScale")
	       ) ;_ closes if
	      ) ;_ closes *
 ) ;_ closes setq
 (if (tblsearch "Layer" LayerName)
  (command "._layer"
	   "_thaw"
	   LayerName
	   "_on"
	   LayerName
	   "_unlock"
	   LayerName
	   "_set"
	   LayerName
	   ""
  ) ;_ closes command
  (command "._layer"
	   "_make"
	   LayerName
	   "_color"
	   LayerColor
	   LayerName
	   ""
  ) ;_ closes command
 ) ;_ closes if
 (initget 1 "Fit Spline")				; disallow invalid
 (setq Pt1 (getpoint "\nSpecify first point or [Fit/Spline]: ")) ; get input
 (if (eq (type Pt1) 'STR)				; if input is a string
  (progn						; then...
   (setq CurveType Pt1)					; set the curve flag
   (initget 1)						; disallow null
   (setq Pt1 (getpoint "\nSpecify first point: "))	; get first point
  ) ;_ closes progn
  (setq CurveType DefaultCurve)				; else set curve flag to default
 ) ;_ closes if
 (initget 1)						; disallow null
 (setq Pt2 (getpoint Pt1 "\nSpecify second point: "))	; get next point
 (I:Push "OSMode")					; push current setting on to *Var* stack
 (setvar "OSMode" 0)					; turn off running osnaps
 (command "._line" Pt1 Pt2 "")				; draw a line
 (I:Pop "OSMode")					; pop last setting off *Var* stack
 (setq
  SList	(ssadd (entlast))				; begin a selection set of center line
  OK	T						; set flag
 ) ;_ closes setq
 (while	OK						; while still drawing lines
  (setq Pt1 (getvar "LastPoint"))			; used for next line command
  (setq Pt2 (getpoint Pt1 "\nSpecify next point: "))	; get next point
  (if Pt2						; if a point was chosen
   (progn						; then...
    (I:Push "OSMode")					; push current setting on to *Var* stack
    (setvar "OSMode" 0)					; turn off running osnaps
    (command "._line" Pt1 Pt2 "")			; draw next line
    (I:Pop "OSMode")					; pop last setting off *Var* stack
    (setq SList (ssadd (entlast) SList))		; add last line to selection set
   ) ;_ closes progn
   (progn						; else...
    (if	(> (sslength SList) 1)				; if more than 1 line is drawn
     (command "._pedit"
	      (ssname SList 0)
	      "_yes"
	      "_join"
	      SList
	      ""
	      (strcat "_" CurveType)
	      ""
     ) ;_ closes command
    ) ;_ closes if
    (setq OK nil)					; exit loop
   ) ;_ closes progn
  ) ;_ closes if
 ) ;_ closes while
 (setq
  Mark	(I:LastEnt)					; get absolute last entity
  SList	(ssadd)						; reinitalize selection set
  Ent	(entget (setq EntN (entlast)))			; save entity name and get info
 ) ;_ closes setq
 (if (eq (I:DXF 0 Ent) "POLYLINE")			; if center line is a polyline
  (progn						; then...
   (setq
    Vertex (entget (entnext (I:DXF -1 Ent)))		; get the first vertex
    Pt1	   (I:DXF 10 Vertex)				; save the start point
   ) ;_ closes setq
   (while Vertex					; while still finding a vertex
    (if	(eq "SEQEND" (I:DXF 0 Vertex))			; if found end of pline
     (setq Vertex nil)					; then exit loop
     (progn						; else...
      (setq
       Pt2    (I:DXF 10 Vertex)				; save vertex point as end point
       Vertex (entget (entnext (I:DXF -1 Vertex)))	; get next sub-entity
      ) ;_ closes setq
     ) ;_ closes progn
    ) ;_ closes if
   ) ;_ closes while
  ) ;_ closes progn
  (setq							; else...
   Pt1 (I:DXF 10 Ent)					; save start point of line
   Pt2 (I:DXF 11 Ent)					; save end point of line
  ) ;_ closes setq
 ) ;_ closes if
 (I:Push "OSMode")					; push current setting on to *Var* stack
 (setvar "OSMode" 0)					; turn off running osnaps
 (command "_.measure"
	  (cons EntN (list Pt1))
	  (/ ZigZagWidth NextPointFactor)
 )							; create points
 (while	Mark						; while points to gather
  (setq Mark (entnext Mark))				; get next entity
  (if Mark						; if there is one
   (setq SList (ssadd Mark SList))			; save it to the selection set
  ) ;_ closes if
 ) ;_ closes while
 (setq
  Mark	(entlast)					; get the last point
  Count	(- (sslength SList) 3)				; set counter to selection set size
  Ent	(entget (ssname SList 0))			; get entity data
  Pt3	(I:DXF 10 Ent)					; get coordinates of point
  Inc	1						; initialize for loop
  X	'+						; set math flag
 ) ;_ closes setq
 (command "._line" Pt1 Pt3 "")				; draw the first zig
 (setq CList (ssadd (entlast)))				; initialize construction list
 (repeat Count						; loop for all points
  (setq
   Ent (entget (ssname SList Inc))			; get next point
   Pt1 Pt3						; reset first point
   Pt3 (I:DXF 10 Ent)					; get second point of zag
   Inc (1+ Inc)						; increment counter
   Ang ((eval X) (angle Pt1 Pt3) (* pi 0.5))		; determine angle for next point
   Pt4 (polar Pt3 Ang ZigZagWidth)			; set next point
  ) ;_ closes setq
  (command "._line" "" Pt4 "")				; draw the zag
  (setq
   X	 (if (eq X '+)
	  '-
	  '+
	 )						; toggle math flag
   CList (ssadd (entlast) CList)			; add line to construction list
  ) ;_ closes setq
 ) ;_ closes repeat
 (setq
  Ent (entget (ssname SList Inc))			; get last point
  Pt3 (I:DXF 10 Ent)					; get coordinates of point
 ) ;_ closes setq
 (command "._line" "" Pt3 "")				; draw the second-to-last line
 (setq CList (ssadd (entlast) CList))			; add line to construction list
 (command "._line" Pt3 Pt2 "")				; draw the last line
 (setq CList (ssadd (entlast) CList))			; add last line to construction list
 (command "._erase" SList EntN "")			; erase points and centerline
 (command "._pedit" (entlast) "_yes" "_join" CList "" "") ; make zig-zags into pline
 (I:VarRes)						; restore environment
 (prin1)						; clean exit
) ;_ closes defun C:Flex