How do I edit lisp to work in any UTM Zone?

[Jonathan3891]

I have a lisp that will place a point by entering DMS or DD coordinats. But it only works in UTM zone 13.

How do I make it work for any UTM zone?

(defun c:PDMS (/ *error* which coord)
  (vl-load-com)
  (defun *error* (msg)
	(if (member
   msg
   '("console break" "Function cancelled" "quit / exit abort")
 )
	  (setq *error* outtahere)
	)
  )
  (initget 1 "DMS DD")   ; choose dms or dd
  (setq
	which (strcase (getkword "Dms or Decimal degrees: (DMS or DD) "))
  )
  (if (= which "DMS")
	(setq lat  (angtof (getstring "Latitude: ") 1) ; if dms
   long (angtof (getstring "Longitude: ") 1)
	)
	(setq lat  (angtof (getstring "Latitude: ") 0) ; if dd
   long (angtof (getstring "Longitude: ") 0)
	)
  )
  (geo2utm lat long)   ; convert this lat/long to utm
  (setq coord (list east north)) ; this is the start point
  (setvar "pdmode" 34)
  (command "point" coord)  ; place point
  (while (/= coord "")	; repeat
	(if (= which "DMS")
	  (setq lat  (angtof (getstring "Latitude: ") 1)
	 long (angtof (getstring "Longitude: ") 1)
	  )
	  (setq lat  (angtof (getstring "Latitude: ") 0)
	 long (angtof (getstring "Longitude: ") 0)
	  )
	)
	(if (or (= long nil) (= lat nil))
	  (progn	; if lat or long nil
 (setq *error* outtahere) ; reset *error*
 (setq coord "")   ; end the pline command
	  )
	  (progn	; if not nil
 (geo2utm lat long)  ; calculate next utm coord
 (setq coord (list east north)) ; put as a list
	  )
	)

	(command coord)   ; enter next point or end
  )	 ; end while
  (princ)
)	 ; end defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Converts from geographic to utm. Works for utm NAD 27 or 83 only.
;;;Takes two arguments, first the lat and then the long as reals in 
;;;radians. Note that west longitude is entered as positive.		
(defun geo2utm
		(lat   long  /   a c1	c2	c3   c4 c5
  c6	c7	ce1   ce2 ce3   ce4   ce5   ce6 cm
  cp	den   emult es1 es2   fan   fe   Flattening
  ma	MajorAxis   MinorAxis   nad   r   sfac smerid
  sp	sp2   t2   t4 TP	v	 vr   w W1
  W2	W3	W4   W5 X	 z0	z1   z2 z3
  z4	z5	z6   zn zone
		)
  (setq nad (ade_projgetwscode))
  (setq temperr *error*)
  (if (= nad "")
	(setq *error* trapnocrdsys)
  )
  (setq a (+ (vl-string-search "-" nad) 1))

  (if (not (or (= (substr nad 1 (1- a)) "UTM27")
		(= (substr nad 1 (1- a)) "UTM83")
	)
	  )
	(progn
	  (setq *error* trapnot27or83)
	  (setq a nil)
	)
  )
  (if (= (substr nad (strlen nad)) "F")
	(progn
	  (setq *error* trapnotM)
	  (setq a nil)
	)
  )
  (setq zone (atoi (substr nad (+ 1 a))))
  (if (/= zone 13)
	(progn
	  (setq *error* not13)
	  (setq a nil)
	)
  )
;;;;;;;;;;;;;;;;;;;;;;;; define the ellipse
  (if (= (substr nad 1 (1- a)) "UTM27")
	(setq MajorAxis  6378206.4  ; NAD27
   Flattening 294.9786982
	)
	(setq MajorAxis  6378137.0  ; NAD83
   Flattening 298.257223563
	)
  )
  (setq MinorAxis (* MajorAxis (/ (- Flattening 1.0) Flattening))
 es1   (- 1.0 (* (/ MinorAxis MajorAxis) (/ MinorAxis MajorAxis)))
 es2   (/ es1 (- 1.0 es1))
 sfac   0.99960000000
 fe   500000.00000000
 fan   0.0
 cm   (/ (* (- (* 6.0 zone) 183.0) pi) 180.0)
 ma   (* MajorAxis (- 1.0 es1))
 ce1   (+ 43659.0 (* 693693.0 (/ es1 16.0)))
 ce2   (+ 11025.0 (* (/ es1 4.0) ce1))
 ce3   (+ 175.0 (* (/ es1 64.0) ce2))
 ce4   (+ 45.0 (* (/ es1 4.0) ce3))
 ce5   (+ 3.0 (* (/ es1 16.0) ce4))
 ce6   (+ 1.0 (* (/ es1 4.0) ce5))
 c1   ce6
 c2   (- c1 1.0)
 c3   (*
	  es1
	  (/ es1 32.0)
	  (+
		15.0
		(*
   es1
   (+
	 (/ 175.0 12.0)
	 (*
	   es1
	   (+
		 (/ 3675.0 256.0)
		 (* es1
	 (+ (/ 14553.0 1024.0) (/ (* es1 231231.0) 16384.0))
		 )
	   )
	 )
   )
		)
	  )
	)
 c4   (*
	  es1
	  es1
	  es1
	  (+
		(/ 35.0 96.0)
		(* es1
	(+ (/ 735.0 2048.0)
	   (* es1
		  (+ (/ 14553.0 40960.0) (/ (* es1 232231.0) 655360.0))
	   )
	)
		)
	  )
	)
 c5   (* es1
	   es1
	   es1
	   es1
	   (+ (/ 315.0 1024.0)
   (* es1 (+ (/ 6237.0 20480.0) (/ (* es1 99099.0) 327680.0)))
	   )
	)
 c6   (* es1
	   es1
	   es1
	   es1
	   es1
	   (+ (/ 693.0 2560.0) (/ (* es1 11011.0) 40960.0))
	)
 c7   (/ (* es1 es1 es1 es1 es1 es1 1001.0) 4096.0)
 w   (- (* -1.0 long) cm)
  )
  (if (>= long pi)
	(setq w (- (* 2.0 pi) w))
  )
  (setq emult -1.0)
  (if (<= w 0.0)
	(setq emult 1.0)
  )
  (setq w	  (abs w)
 sp	 (sin lat)
 sp2	(* sp sp)
 cp	 (cos lat)
 tp	 (/ (sin lat) (cos lat))
 t2	 (* tp tp)
 t4	 (* t2 t2)
 den	(- 1.0 (* es1 sp2))
 v	  (/ majoraxis (sqrt den))
 r	  (/ (* v (- 1 es1)) den)
 vr	 (/ v r)
 x	  (* w w cp cp)
 zn	 (+ c5 (* sp2 (+ c6 (* sp2 c7))))
 smerid (* ma
	(- (* c1 lat)
	   (* sp
   cp
   (+ c2 (* sp2 (+ c3 (* sp2 (+ c4 (* sp2 zn))))))
	   )
	)
		)
 z0	 (/ (* x v tp) 2.0)
 z1	 (- 1385.0 (* t2 (- 3111.0 (* t2 (- 543.0 t2)))))
 z2	 (- (* vr (+ 1.0 (* vr 4.0))) t2)
 z3	 (- 1.0 (* t2 32.0))
 z4	 (- 28.0 (* 168.0 t2))
 z5	 (- 88.0 (* 192.0 t2))
 z6	 (- z3 (* vr (- z4 (* vr z5))))
  )

;;; Calculate northing
  (setq north (+ smerid
   (* z0
	  (+ 1.0
		 (* (/ x 12.0)
	 (+ z2
		(* (/ x 30.0)
	(- t4
	   (+ (* vr (- (* 2.0 t2) (* vr z6)))
		  (* (/ x 56.0) z1)
	   )
	)
		)
	 )
		 )
	  )
   )
	   )
  )
  (setq north (- (* north sfac) fan))
  (if (< north 0.0)
	(setq north (* -1.0 (+ north 10000000.0))
	)
  )

;;; Calculate easting
  (setq w1   (+ 61.0 (* 479.0 t2 -1.0) (* 179.0 t4) (* t4 t2 -1.0))
 w2   (- 4.0 (* 24.0 t2))
 w3   (+ 1.0 (* t2 8.0))
 w4   (+ w3 (* vr w2))
 w5   (* w v cp)
 east (* w5
  (+ 1.0
	 (* (/ x 6.0)
		(+ (- vr t2)
	(* (/ x 20.0)
	   (+ (- t4 (* vr (- (* 2.0 t2) (* vr w4))))
		  (* (/ x 42.0) w1)
	   )
	)
		)
	 )
  )
	  )
  )
  (setq east (+ (* -1.0 east emult sfac) fe))
)	 ;end defun

(defun trapnocrdsys (errmsg /)
  (setq *error* temperr)
  (alert "The coordinate system has not been set correctly.")
  (princ)
)
(defun trapnot27or83 (errmsg /)
  (setq *error* temperr)
  (alert "The routine only works for NAD27 or 83.")
  (princ)
)
(defun trapnotM (errmsg /)
  (setq *error* temperr)
  (alert "The coordinate system is not set to meters.")
  (princ)
)
(defun not13 (errmsg /)
  (setq *error* temperr)
  (alert "The drawing isn't zone 13!.")
  (princ)
)
(defun outtahere (errmsg /)
  (setq *error* temperr)
  (princ)
)