; The Codewriting Workbook
; Creating Computational Architecture in AutoLISP
; by Robert J. Krawczyk
; Princeton Architectural Press, 2008
; --------------------------------------------------------------------------
; CH05A_lasercut.LSP
; --------------------------------------------------------------------------
; Disclaimer: The information contained in this file is distributed on an
; "as is" basis, without warranty.  Although every precaution has been taken
; in the preparation of this work, the author and publisher shall not have 
; any liability to any person or entity with respect to any loss or damage
; caused or alleged to be caused directly or indirectly by the information
; contained in this work.
; --------------------------------------------------------------------------
;-----------------------------------
(defun dtr (a) (* pi (/ a 180.0)))
(defun rtd (a) (/ (* a 180.0) pi))
(defun tan (a) (/ (sin a) (cos a)))
;-----------------------------------
;-----------------------------------
; VT - top view
(defun c:vt ()     
  (command "vpoint" "r" 270 90)
  (command "zoom" "e" "ucs" "v" "zoom" ".9x")
  (princ)
)
; VL - left view
(defun c:vl ()     
  (command "vpoint" "r" 180 0)
  (command "zoom" "e" "ucs" "v" "zoom" ".9x")
  (princ)
)
; VR - right view
(defun c:vr ()     
  (command "vpoint" "r" 0 0)
  (command "zoom" "e" "ucs" "v" "zoom" ".9x")
  (princ)
)
; VF - front view
(defun c:vf ()     
  (command "vpoint" "r" 270 0)
  (command "zoom" "e" "ucs" "v" "zoom" ".9x")
  (princ)
)
; VB - back view
(defun c:vb ()     
  (command "vpoint" "r" 90 0)
  (command "zoom" "e" "ucs" "v" "zoom" ".9x")
  (princ)
)
; VSW - SW view
(defun c:vsw ()     
  (command "vpoint" "r" 270 90)
  (command "ucs" "v")
  (command "vpoint" "r" 225 45)
  (command "zoom" "e" "zoom" ".9x")
  (princ)
)
; VSE - SE view
(defun c:vse ()     
  (command "vpoint" "r" 270 90)
  (command "ucs" "v")
  (command "vpoint" "r" 315 45)
  (command "zoom" "e" "zoom" ".9x")
  (princ)
)
; VNE - NE view
(defun c:vne ()     
  (command "vpoint" "r" 270 90)
  (command "ucs" "v")
  (command "vpoint" "r" 45 45)
  (command "zoom" "e" "zoom" ".9x")
  (princ)
)
; VNW - NW view
(defun c:vnw ()     
  (command "vpoint" "r" 270 90)
  (command "ucs" "v")
  (command "vpoint" "r" 135 45)
  (command "zoom" "e" "zoom" ".9x")
  (princ)
)
;-----------------------------------
; proglc01 - 3D view of model
; proglc02 - three part section cut,
;            create dwg for cutting
;-----------------------------------
(defun proglc01 ()
 ; 3D view of laser cut model
 (setvar "CMDECHO" 0)
 ; clear drwg 
 (command ".LAYER" "SET" "0" "")
 (command ".LAYER"
  "UNLOCK" "2D*,3D*"
  "THAW" "2D*,3D*"
  "ON" "2D*,3D*" "")
 (c:vt)
 (command ".ZOOM" "e") 
 (command ".LAYER" "MAKE" "3DSECT"
  "MAKE" "3DBASE" "MAKE" "3DID" "")
 (command ".LAYER" "MAKE" "2DTEXT" 
  "MAKE" "2DCUT" "MAKE" "2DLAYOUT" "")
 (command ".LAYER" "SET" "0" "")
 (command ".LAYER" "COLOR" 
  "7" "*" "")  
 (command ".LAYER" "COLOR" 
  "1" "2DCUT" "")  
 (command ".LAYER" "COLOR" 
  "3" "2DTEXT" "")
 (command ".LAYER"
  "OFF" "2D*"
  "FREEZE" "2D*"  
  "LOCK" "2D*"  "") 
 (command ".LAYER" "ON" "3D*" "")
 (command ".ERASE" "ALL" "")
 ; get boundary points and parameters
 (prompt 
  "\nPROGLC01 - 3D laser cut model")
 ; start  
 (setq spnt (list 0.0 0.0 0.0))
 ; script and model ids 
 (setq scriptid (getstring))
 (setq modelid (getstring))
 (setq modelid 
  (substr (strcase modelid) 1 1))
 ; overall dimensions
 (setq clen (getdist))
 (setq cwid (getdist))
 (setq zedge (getdist))
 (setq zmid (getdist)) 
 ; bottom edge length   
 (setq eblenfact (getreal)) 
 (setq eblsang (getreal)) 
 (setq ebleang (getreal)) 
 (setq eblenfunc (getstring)) 
 ; top edge length   
 (setq etlenfact (getreal))
 (setq etlsang (getreal))
 (setq etleang (getreal))
 (setq etlenfunc (getstring))
 ; edge height  
 (setq ehgtfact (getreal))
 (setq ehsang (getreal))
 (setq eheang (getreal))
 (setq ehgtfunc (getstring))
 ; midpoint height  
 (setq mhgtfact (getreal))
 (setq mhsang (getreal))
 (setq mheang (getreal))
 (setq mhgtfunc (getstring))
 ; midpoint offset 
 (setq zmidoff (getdist))
 (setq mhoffsang (getreal))
 (setq mhoffeang (getreal))
 (setq mhgtofffunc (getstring))
 ; fillet radius 
 (setq frad (getdist))
 ; frame offsets
 (setq foff (getdist))
 (setq noff (getdist))
 (setq nboff (getdist))
 ; model dimensions  
 (setq modellen (getdist)) 
 (setq bthick (getdist)) 
 (setq bwid (getdist)) 
 (setq blen (getdist))
 ; 
 ; set model parms
 (setq numtimes 
  (fix (/ modellen bthick)))
 ; model scale
 (setq mscale 
  (/ modellen clen))       
 (setq mclen 
  (* clen mscale))
 (setq mcwid 
  (* cwid mscale))
 (setq cpnt 
  (list mclen (/ mcwid 2.0) 0.0))  
 (setq mzedge 
  (* zedge mscale))
 (setq mzmid 
  (* zmid mscale))
 (setq mzmidoff 
  (* zmidoff mscale))
 (setq mfrad (* frad mscale)) 
 (setq mfoff (* foff mscale)) 
 (setq mnoff (* noff mscale)) 
 (setq mnboff (* nboff mscale)) 
 ;
 ; compute line length, width of box
 (setq linelen 
  (- (nth 1 cpnt) (nth 1 spnt)))
 ; compute increment across box
 (setq xinc 
  (/ (- (nth 0 cpnt) (nth 0 spnt))
  (- numtimes 1)))
 ; computer ang inc
 (setq blanginc 
  (/ (- ebleang eblsang) 
  (- numtimes 1)))
 (setq tlanginc 
  (/ (- etleang etlsang) 
  (- numtimes 1)))
 (setq eanginc 
  (/ (- eheang ehsang) 
  (- numtimes 1)))
 (setq manginc 
  (/ (- mheang mhsang) 
  (- numtimes 1)))
 (setq oanginc 
  (/ (- mhoffeang mhoffsang)
  (- numtimes 1)))
 ; set first point and first x coord
 (setq xpnt spnt)
 (setq xpt (nth 0 spnt))
 ; 
 ; set angle computations
 (if (= (strcase eblenfunc) "SIN") 
  (defun blfuncang (xrad) (sin xrad))
  (defun blfuncang (xrad) (cos xrad))
 )
 (if (= (strcase etlenfunc) "SIN") 
  (defun tlfuncang (xrad) (sin xrad))
  (defun tlfuncang (xrad) (cos xrad))
 )
 (if (= (strcase ehgtfunc) "SIN") 
  (defun efuncang (xrad) (sin xrad))
  (defun efuncang (xrad) (cos xrad))
 )
 (if (= (strcase mhgtfunc) "SIN") 
  (defun mfuncang (xrad) (sin xrad))
  (defun mfuncang (xrad) (cos xrad))
 )
 (if (= (strcase mhgtofffunc) "SIN") 
  (defun ofuncang (xrad) (sin xrad))
  (defun ofuncang (xrad) (cos xrad))
 )
 ; start start angs
 (setq blang eblsang)
 (setq tlang etlsang)
 (setq eang ehsang)
 (setq mang mhsang)
 (setq oang mhoffsang) 
 ; set extrude height
 (command ".ELEV" 0.0 0.0)
 ;   
 ; start pts for sections 
 (setq sxcpnt (- (nth 0 spnt) 1.0))
 (setq xcpnt sxcpnt) 
 (setq ycpnt
  (- (nth 1 cpnt)
  (+ (* linelen 3.0) 1.1)))
 ; loop to repeat sections
 (setq nsect 0) 
 (repeat numtimes
  ; compute bottom endpoint
  (setq line1 (* linelen eblenfact)) 
  (setq line2 (* (* (* linelen
   (- 1.0 eblenfact))
   (abs (blfuncang (dtr blang))))))
  (setq newlen (+ line1 line2))
  (setq epnt3
   (polar xpnt (dtr 90) newlen))
  (setq epnt4
   (polar xpnt (dtr 270) newlen))
  ; compute top endpoint
  (setq line1 (* linelen etlenfact)) 
  (setq line2 (* (* (* linelen
   (- 1.0 etlenfact))
   (abs (tlfuncang (dtr tlang))))))
  (setq newlen (+ line1 line2))
  (setq epnt1
   (polar xpnt (dtr 90) newlen))
  (setq epnt2
   (polar xpnt (dtr 270) newlen))
  ; compute outside height
  (setq line1 (* mzedge ehgtfact)) 
  (setq line2 (* (* (* mzedge
   (- 1.0 ehgtfact))
   (abs (efuncang (dtr eang))))))
  (setq newzedge (+ line1 line2))
  (setq epnt1 (list
   (nth 0 epnt1) (nth 1 epnt1)
   newzedge))
  (setq epnt2 (list
   (nth 0 epnt2) (nth 1 epnt2)
   newzedge))
  ; compute midpoint offset
  (setq newzmidoff (* (* mzmidoff
   (ofuncang (dtr oang)))))
  (setq mpnt (list
   (nth 0 xpnt) (+ (nth 1 xpnt)
   newzmidoff) 0.0))
  ; compute midpoint height
  (setq line1 (* mzmid mhgtfact)) 
  (setq line2 (* (* (* mzmid
   (- 1.0 mhgtfact))
   (abs (mfuncang (dtr mang))))))
  (setq newzmid (+ line1 line2))
  (setq mpnt (list
   (nth 0 mpnt) (nth 1 mpnt)
   newzmid))
  ; inc section
  (setq nsect (+ nsect 1))
  ; extrude 3DPOLY for 3D  
  (setvar "CLAYER" "3DSECT")
  (command ".3DPOLY" epnt3 epnt1
   mpnt epnt2 epnt4 epnt3 "")
  (command ".EXTRUDE" "LAST" ""
   bthick )
  ; versions prior to 2007 use
  ;(command ".EXTRUDE" "LAST" ""
  ; bthick "0" ) 
  (command ".ZOOM" "E")
  ; inc x coord
  (setq xpt (+ xpt xinc))
  (setq xpnt
   (cons xpt (cdr xpnt)))
  ; inc angs
  (setq blang
   (+ blang blanginc))
  (setq tlang
   (+ tlang tlanginc))
  (setq eang
   (+ eang eanginc))
  (setq mang
   (+ mang manginc))
  (setq oang
   (+ oang oanginc))
 )
 ; base 3D
 (setq epnt2 (list
  (- (nth 0 spnt) 1.0)
  (+ (nth 1 cpnt) 1.0) 0.0))
 (setq epnt3 (list
  (+ (nth 0 cpnt) 1.0)
  (+ (nth 1 cpnt) 1.0) 0.0))
 (setq epnt4 (list
  (+ (nth 0 cpnt) 1.0)
  (* (+ (nth 1 cpnt) 1.0)
  -1.0) 0.0))
 (setq epnt5 (list
  (- (nth 0 spnt) 1.0)
  (* (+ (nth 1 cpnt) 1.0)
  -1.0) 0.0))
 (setvar "CLAYER" "3DBASE")
 (command ".3DFACE" epnt2 epnt3
  epnt4 epnt5  "")
 (command ".ZOOM" "e")
 ; id text
 (setq epnt1 (list
  (+ (nth 0 spnt) 0.5)
  (+ (nth 1 cpnt) 2.5) 0.0))  
 (setvar "CLAYER" "3DID")
 (command ".TEXT" epnt1 (/ 1.0 4.0)
  "0" (strcat scriptid "/"
  (rtos clen 4 2) "/"
  (rtos cwid 4 2 ) "/"
  (rtos zedge 4 2 ) "/"
  (rtos zmid 4 2 ) "/"
  (rtos modellen 4 2 ) "/"
  (itoa numtimes) "/" )
 )
 ; reset layers 
 (command ".LAYER" "SET" "0" "")
 (c:vsw)
 (command ".HIDE")
 (princ)
)
;-----------------------------------
;-----------------------------------
(defun proglc02 ()
 ; laser cut drwg
 ; three part section cut
 ; red = cut
 ; green = etch 
 (setvar "CMDECHO" 0)
 ; clear drwg 
 (command ".LAYER" "SET" "0" "")
 (command ".LAYER"
  "UNLOCK" "2D*,3D*"
  "THAW" "2D*,3D*"
  "ON" "2D*,3D*" "")
 (c:vt)
 (command ".ZOOM" "e") 
 (command ".LAYER" "MAKE" "3DSECT"
  "MAKE" "3DBASE" "MAKE" "3DID" "")
 (command ".LAYER" "MAKE" "2DTEXT" 
  "MAKE" "2DCUT" "MAKE" "2DLAYOUT" "")
 (command ".LAYER" "SET" "0" "")
 (command ".LAYER" "COLOR" 
  "7" "*" "")  
 (command ".LAYER" "COLOR" 
  "1" "2DCUT" "")  
 (command ".LAYER" "COLOR" 
  "3" "2DTEXT" "")
 (command ".LAYER"
  "OFF" "3D*" 
  "FREEZE" "3D*"  
  "LOCK" "3D*"  "") 
 (command ".LAYER"
  "ON" "2D*" "")
 (command ".ERASE" "ALL" "")
 ; get boundary points and parameters
 (prompt 
  "\nPROGLC02 - laser cut drwg")
 ; start  
 (setq spnt (list 0.0 0.0 0.0))
 ; script and model ids 
 (setq scriptid (getstring))
 (setq modelid (getstring))
 (setq modelid 
  (substr (strcase modelid) 1 1))
 ; overall dimensions
 (setq clen (getdist))
 (setq cwid (getdist))
 (setq zedge (getdist))
 (setq zmid (getdist)) 
 ; bottom edge length   
 (setq eblenfact (getreal)) 
 (setq eblsang (getreal)) 
 (setq ebleang (getreal)) 
 (setq eblenfunc (getstring)) 
 ; top edge length   
 (setq etlenfact (getreal))
 (setq etlsang (getreal))
 (setq etleang (getreal))
 (setq etlenfunc (getstring))
 ; edge height  
 (setq ehgtfact (getreal))
 (setq ehsang (getreal))
 (setq eheang (getreal))
 (setq ehgtfunc (getstring))
 ; midpoint height  
 (setq mhgtfact (getreal))
 (setq mhsang (getreal))
 (setq mheang (getreal))
 (setq mhgtfunc (getstring))
 ; midpoint offset 
 (setq zmidoff (getdist))
 (setq mhoffsang (getreal))
 (setq mhoffeang (getreal))
 (setq mhgtofffunc (getstring))
 ; fillet radius 
 (setq frad (getdist))
 ; frame offsets
 (setq foff (getdist))
 (setq noff (getdist))
 (setq nboff (getdist))
 ; model dimensions  
 (setq modellen (getdist)) 
 (setq bthick (getdist)) 
 (setq bwid (getdist)) 
 (setq blen (getdist))
 ; 
 ; set model parms
 (setq numtimes 
  (fix (/ modellen bthick)))
 ; model scale
 (setq mscale 
  (/ modellen clen))       
 (setq mclen 
  (* clen mscale))
 (setq mcwid 
  (* cwid mscale))
 (setq cpnt 
  (list mclen (/ mcwid 2.0) 0.0))  
 (setq mzedge 
  (* zedge mscale))
 (setq mzmid 
  (* zmid mscale))
 (setq mzmidoff 
  (* zmidoff mscale))
 (setq mfrad (* frad mscale)) 
 (setq mfoff (* foff mscale)) 
 (setq mnoff (* noff mscale)) 
 (setq mnboff (* nboff mscale)) 
 ;
 ; compute line length, width of box
 (setq linelen 
  (- (nth 1 cpnt) (nth 1 spnt)))
 ; compute increment across box
 (setq xinc 
  (/ (- (nth 0 cpnt) (nth 0 spnt))
  (- numtimes 1)))
 ; computer ang inc
 (setq blanginc 
  (/ (- ebleang eblsang) 
  (- numtimes 1)))
 (setq tlanginc 
  (/ (- etleang etlsang) 
  (- numtimes 1)))
 (setq eanginc 
  (/ (- eheang ehsang) 
  (- numtimes 1)))
 (setq manginc 
  (/ (- mheang mhsang) 
  (- numtimes 1)))
 (setq oanginc 
  (/ (- mhoffeang mhoffsang)
  (- numtimes 1)))
 ; set first point
 (setq xpnt spnt)
 ; 
 ; set angle computations
 (if (= (strcase eblenfunc) "SIN") 
  (defun blfuncang (xrad) (sin xrad))
  (defun blfuncang (xrad) (cos xrad))
 )
 (if (= (strcase etlenfunc) "SIN") 
  (defun tlfuncang (xrad) (sin xrad))
  (defun tlfuncang (xrad) (cos xrad))
 )
 (if (= (strcase ehgtfunc) "SIN") 
  (defun efuncang (xrad) (sin xrad))
  (defun efuncang (xrad) (cos xrad))
 )
 (if (= (strcase mhgtfunc) "SIN") 
  (defun mfuncang (xrad) (sin xrad))
  (defun mfuncang (xrad) (cos xrad))
 )
 (if (= (strcase mhgtofffunc) "SIN") 
  (defun ofuncang (xrad) (sin xrad))
  (defun ofuncang (xrad) (cos xrad))
 )
 ; start start angs
 (setq blang eblsang)
 (setq tlang etlsang)
 (setq eang ehsang)
 (setq mang mhsang)
 (setq oang mhoffsang) 
 ; set extrude height
 (command ".ELEV" 0.0 0.0)
 ;   
 ; loop to repeat sections
 (setq nsect 0) 
 (repeat numtimes
  ; compute bottom endpoint
  (setq line1 (* linelen eblenfact)) 
  (setq line2 (* (* (* linelen 
   (- 1.0 eblenfact)) 
   (abs (blfuncang (dtr blang))))))
  (setq newlen (+ line1 line2))
  (setq epnt1 
   (polar xpnt (dtr 90) newlen))
  (setq epnt2 
   (polar xpnt (dtr 270) newlen))
  ; compute top endpoint
  (setq line1 (* linelen etlenfact)) 
  (setq line2 (* (* (* linelen 
   (- 1.0 etlenfact)) 
   (abs (tlfuncang (dtr tlang))))))
  (setq newlen (+ line1 line2))
  (setq epnt3 
   (polar xpnt (dtr 90) newlen))
  (setq epnt4 
   (polar xpnt (dtr 270) newlen))
  ; compute outside height
  (setq line1 (* mzedge ehgtfact)) 
  (setq line2 (* (* (* mzedge 
   (- 1.0 ehgtfact)) 
   (abs (efuncang (dtr eang))))))
  (setq newzedge (+ line1 line2))
  (setq epnt3 (list 
   (+ (nth 0 epnt3) newzedge)
   (nth 1 epnt3) ))
  (setq epnt4 (list
   (+ (nth 0 epnt4) newzedge)
   (nth 1 epnt4) ))
  ; compute midpoint offset
  (setq newzmidoff 
   (* (* mzmidoff 
   (ofuncang (dtr oang)))))
  (setq epnt5 (list 
   (nth 0 xpnt) (+ (nth 1 xpnt)
   newzmidoff)))
  ; compute midpoint height
  (setq line1 (* mzmid mhgtfact)) 
  (setq line2 (* (* (* mzmid 
   (- 1.0 mhgtfact)) 
   (abs (mfuncang (dtr mang))))))
  (setq newzmid (+ line1 line2))
  (setq epnt5 
   (list (+ (nth 0 epnt5) newzmid)
   (nth 1 epnt5) ))
  ; center slot
  (setq xpntc (list 
   (nth 0 xpnt) (nth 1 xpnt) ))
  (setq epnt6 (list 
   (nth 0 xpntc) 
   (+ (nth 1 xpntc) (/ 1.0 4.0)) ))
  (setq epnt7 (list 
   (+ (nth 0 xpntc) (/ 1.0 32.0)) 
   (+ (nth 1 xpntc) (/ 1.0 4.0)) ))
  (setq epnt10 (list 
   (+ (nth 0 xpntc) (/ 1.0 32.0)) 
   (nth 1 xpntc) ))
  (setq epnt8 (list 
   (+ (nth 0 xpntc) (/ 1.0 32.0))
   (- (nth 1 xpntc) (/ 1.0 4.0)) ))
  (setq epnt9 (list 
   (nth 0 xpntc) 
   (- (nth 1 xpntc) (/ 1.0 4.0)) ))
  ; inc section 
  (setq nsect (+ nsect 1))
  ; 
  ; pline for 2D 
  (setvar "CLAYER" "2DCUT")
  (command ".PLINE" epnt6 epnt1 
   epnt3 epnt5 epnt4 epnt2 epnt9 "C")
  (command ".ZOOM" "E" ".ZOOM" "0.6x")
  ;
  ; fillet corners
  (if (> mfrad 0.0) (progn
   (command ".FILLET" "R" mfrad)
   (command ".FILLET" "P" epnt1)
  ))
  ; duplicate by offset
  (if (> mfoff 0.0) (progn
   (setq opnt (list 
    (- (nth 0 epnt6) mfoff) 
    (nth 1 epnt6)))
   (command ".OFFSET" mfoff epnt6 
    opnt "")
  ))
  ; top tab cut
  (command ".PLINE" epnt6 epnt7 
   epnt10 epnt8 epnt9 "")
  ; bottom tab cut
  (if (> mfoff 0.0) (progn
   (setq epnt6 (list 
    (- (nth 0 xpntc) mfoff)
    (+ (nth 1 xpntc) (/ 1.0 4.0)) ))
   (setq epnt7 (list 
    (+ (- (nth 0 xpntc) mfoff) 
    (/ 1.0 32.0))
    (+ (nth 1 xpntc) (/ 1.0 4.0)) ))
   (setq epnt10 (list
    (+ (- (nth 0 xpntc) mfoff)
    (/ 1.0 32.0)) (nth 1 xpntc) ))
   (setq epnt8 (list
    (+ (- (nth 0 xpntc) mfoff) 
    (/ 1.0 32.0))
    (- (nth 1 xpntc) (/ 1.0 4.0)) ))
   (setq epnt9 (list 
    (- (nth 0 xpntc) mfoff)
    (- (nth 1 xpntc) (/ 1.0 4.0)) ))
   (command ".PLINE" epnt6 epnt7 
    epnt10 epnt8 epnt9 "")
  ))
  (command ".ZOOM" "E" ".ZOOM" "0.6x")
  ; negative frame
  (if (> mnoff 0.0) (progn
   (setq xpnt1 (list
    (- (nth 0 xpntc) (+ mfoff mnboff))
    (+ (+ (nth 1 xpntc) (/ mcwid 2))
    (* mnoff 2)) ))
   (setq xpnt2 (list 
    (- (nth 0 xpntc) (+ mfoff mnboff))
    (- (- (nth 1 xpntc) (/ mcwid 2))
    (* mnoff 2)) ))
   (setq xpnt3 (list
    (+ (nth 0 xpnt1) 
    (+ (max mzedge mzmid)
    (+ (* mnoff 3) mnboff)))
    (nth 1 xpnt1) ))
   (setq xpnt4 (list 
    (+ (nth 0 xpnt2) 
    (+ (max mzedge mzmid) 
    (+ (* mnoff 3) mnboff)))
    (nth 1 xpnt2) ))
   (command ".PLINE" xpnt1 xpnt3 
    xpnt4 xpnt2 xpnt1 "")
  ))
  ; add sect number
  ; positive
  (command ".TEXT" 
   (list (+ (nth 0 xpntc) (/ 1.0 16.0))
   (nth 1 xpntc)) (/ 1.0 16.0) "-90"
   (strcat modelid "-" (itoa nsect)))
  (command ".CHPROP" "last" "" 
   "LAYER" "2DTEXT" "")
  ; positive
  (if (> mfoff 0.0) (progn
   (setvar "CLAYER" "2DTEXT")
   (command ".TEXT" (list 
    (+ (- (nth 0 xpntc) mfoff) 
    (/ 1.0 128.0)) 
    (+ (nth 1 xpntc) (/ 3.0 4.0)))
    (/ 1.0 16.0) "-90"
    (strcat modelid "-" (itoa nsect)))
  ))
  ; negative
  (if (> mnoff 0.0) (progn
   (setvar "CLAYER" "2DTEXT")
   (command ".TEXT" (list 
    (+ (nth 0 xpntc) 
    (+ (max mzedge mzmid) 
    (* mnoff 1))) (nth 1 xpntc))
    (/ 1.0 16.0) "-90"
    (strcat modelid "-" (itoa nsect)))
  ))
  (command ".ZOOM" "E" ".ZOOM" "0.6x")
  ; next location
  (setq xnext (+ (+ 0 (+ 
   (max mzedge mzmid) 
   (+ (* mnoff 3) mnboff))) 
   (/ 1.0 8.0)) )
  (setq ynext (+ (+ 
   (/ mcwid 1) 
   (* (+ mnoff mfoff) 2)) 
   (/ 1.0 4.0)))
  (setq xpnt (list 
   (+ (nth 0 xpnt) xnext)
   (nth 1 xpnt) ))
  (if (> (+ (nth 0 xpnt) xnext) 
   (+ (nth 0 spnt) bwid)) (progn
   (setq xpnt (list 
    (nth 0 spnt) 
    (- (nth 1 xpnt) ynext)))
  ))
  ; inc ang
  (setq blang (+ blang blanginc))
  (setq tlang (+ tlang tlanginc))
  (setq eang (+ eang eanginc))
  (setq mang (+ mang manginc))
  (setq oang (+ oang oanginc))
 )
 ; layout 2D
 (command ".LAYER"
  "SET" "2DLAYOUT" "")
 (setq epnt1 (list 
  (- (nth 0 spnt) 0.5) 
  (+ (nth 1 cpnt) 0.75) 0.0))
 (setq epnt2 (list 
  (+ (nth 0 epnt1) bwid)
  (nth 1 epnt1) 0.0))
 (setq epnt3 (list 
  (+ (nth 0 epnt1) bwid)
  (- (nth 1 epnt1) blen) 0.0))
 (setq epnt4 (list 
  (- (nth 0 spnt) 0.5)
  (nth 1 epnt3) 0.0))
 (command ".PLINE" epnt1 epnt2
  epnt3 epnt4 epnt1 "")
 ; cut length
 (setq minpt (getvar "EXTMIN"))
 (setq maxpt (getvar "EXTMAX")) 
 (setq cutlen 
  (fix (+ 0.5 (abs (- (nth 1 minpt)
  (nth 1 maxpt))))))  
 ; id text
 (setq epnt1 (list 
  (- (nth 0 spnt) 2.0) 
  (nth 1 epnt3) 0.0))
 (command ".TEXT" epnt1
  (/ 1.0 4.0) "90"
  (strcat scriptid "/" 
  (rtos clen 4 2) "/" 
  (rtos cwid 4 2 ) "/" 
  (rtos zedge 4 2 ) "/"
  (rtos zmid 4 2 ) "/" 
  (rtos modellen 4 2 ) "/" 
  (itoa numtimes) "/" 
  (rtos bwid 4 2) "x" 
  (rtos cutlen 4 2) "/")
 ) 
 ; reset layers 
 (command ".LAYER" "SET" "0" "")
 (c:vt)
 (princ)
)
;-----------------------------------
;-----------------------------------
;-----------------------------------
(defun modcurve ( ctype cdist cang / 
 newcdist )
 (setq ctype (strcase ctype))
 ; NONE or undefined
 (setq newcdist cdist)
 ; 01 = SIN(x) 
 (if (= (substr ctype 1 3) "S01")
  (setq newcdist 
  (* (sin (dtr cang)) cdist)))
 ; 02 = nSIN(x)
 (if (= (substr ctype 1 3) "S02")
  (setq newcdist 
  (* (* (+ 1.0 (/ (rem cang 360) 360.0))
  (sin (dtr cang))) cdist))  )
 ; 03 = SIN(nx) 
 (if (= (substr ctype 1 3) "S03") 
  (setq newcdist 
  (* (sin (dtr (* (+ 1.0 (/ 
  (rem cang 360) 360.0)) cang))) cdist)))
 ; 04 = SIN(x)+SIN(2x)
 (if (= (substr ctype 1 3) "S04")
  (setq newcdist 
  (* (+ (sin (dtr cang)) 
  (sin (dtr (* cang 2)))) cdist)))
 ; 05 = SIN(2x)+SIN(3x)
 (if (= (substr ctype 1 3) "S05")
  (setq newcdist 
  (* (+ (sin (dtr (* cang 2))) 
  (sin (dtr (* cang 3)))) cdist)))
 ; 06 = SIN(x)+SIN(2x)+SIN(3x)
 (if (= (substr ctype 1 3) "S06")
  (setq newcdist 
  (* (+ (sin (dtr cang)) 
  (+ (sin (dtr (* cang 2))) 
  (sin (dtr (* cang 3))))) cdist)))
 ; 01 = COS(x) 
 (if (= (substr ctype 1 3) "C01")
  (setq newcdist 
  (* (cos (dtr cang)) cdist)))
 ; 02 = nCOS(x)
 (if (= (substr ctype 1 3) "C02")
  (setq newcdist 
  (* (* (+ 1.0 (/ (rem cang 360) 360.0))
  (cos (dtr cang))) cdist)))
 ; 03 = COS(nx) 
 (if (= (substr ctype 1 3) "C03")
  (setq newcdist 
  (* (cos (dtr (* (+ 1.0 (/ 
  (rem cang 360) 360.0)) cang))) cdist)))
 ; 04 = COS(x)+COS(2x)
 (if (= (substr ctype 1 3) "C04")
  (setq newcdist 
  (* (+ (cos (dtr cang)) 
  (cos (dtr (* cang 2)))) cdist)))
 ; 05 = COS(2x)+COS(3x)
 (if (= (substr ctype 1 3) "C05")
  (setq newcdist 
  (* (+ (cos (dtr (* cang 2))) 
  (cos (dtr (* cang 3)))) cdist)))
 ; 06 = COS(x)+COS(2x)+COS(3x)
 (if (= (substr ctype 1 3) "C06")
  (setq newcdist 
  (* (+ (cos (dtr cang)) 
  (+ (cos (dtr (* cang 2))) 
  (cos (dtr (* cang 3))))) cdist)))
 ; 
 ; check to make ABS
 (if (= (substr ctype 4 1) "A")
  (setq newcdist (abs newcdist))
 )   
 ; check to make -ABS
 (if (= (substr ctype 4 2) "AN")
  (setq newcdist (* newcdist -1.0))
 )   
 ; return value
 (+ newcdist 0)
)
;-----------------------------------
; load solid modelling DLL
(arxload "geom3d")
;-----------------------------------
;-----------------------------------