Creating Traverse Line Using Bearing,Distance

; func dms final out put variable is strdeg
; convert angles in degs to rads
(defun dtr (a)
(* pi (/ a 180.00))
)

(defun rtd (a)
(/ (* a 180.00) pi)
)
(defun arl (/ ang ctrpt dist doc endpt ent half obj pick space ss1 ss2 stpt delta endang startang)
(vl-load-com)
(setq doc (vla-get-activedocument (vlax-get-acad-object))
space (if (= (getvar "cvport") 1)
(vla-get-paperspace doc)
(vla-get-modelspace doc)
)
)

(setq ss2 (ssget "L" '((0 . "LINE"))))


(setq obj (vlax-ename->vla-object (ssname ss2 0))
pick (vlax-get obj 'endpoint)
)

(setq half (/ (vla-get-length obj) 2.0)
dist (vlax-curve-getdistatpoint obj
(vlax-curve-getclosestpointto obj pick)))
(if (< half dist)
(setq stPt (vlax-get obj 'startpoint)
endPt (vlax-get obj 'endpoint)
)
(setq stPt (vlax-get obj 'endpoint)
endPt (vlax-get obj 'startpoint)
)
)
(setq rad (getdist endPt "\nRadius of arc: ")
ang (angle stPt endPt)
ctrPt (polar endPt (- ang (/ pi 2)) rad)
startang (+ pi (- ang (/ pi 2)))
delta (getangle "\nDelta or Enter to input arc length: ")
)
(if (= delta nil)
(progn
(setq arc (getreal "\nEnter Arc Length: ")
delta (* (/ arc rad) (/ 180 pi))
delta(abs (* pi (/ delta 180.0))))))


(if (minusp rad)
(setq startang (angle ctrPt endPt)
endang (+ startang delta))
(setq endang (angle ctrPt endPt)
startang (- startang delta))
)
(vlax-invoke space 'addarc ctrPt (abs rad) startang endang)
(setq curveobj (vlax-ename->vla-object (entlast))
endpoint (vlax-curve-getStartPoint curveobj)
startpoint (vlax-curve-getendPoint curveobj))
)

(princ)






(defun dms ()
(setq deg (getreal "\nEnter degs: "))
(if (= deg nil)
(setq deg 0))
(setq mins (getreal "\nEnter mins: "))
(if (= mins nil)
(setq mins 0))
(setq sec (getreal "\nEnter secs: "))
(if (= sec nil)
(setq sec 0))
(setq ang_degs (+ deg (/ mins 60.0) (/ sec 3600.0))))

;error trapper
(defun c:trav (/ *error*)
(setq b (getvar "osmode"))

(defun *Error* (Err)
(cond
(or
(not Err)
(member Err (quote ("console break" "Function cancelled" "quit
/ exit abort")))
)
)
(princ (strcat "\nError: " Err))

(if b
(setvar "osmode" b)
)

(princ)
)



(setq b (getvar "osmode"))
(setvar "osmode" 0)
(graphscr)
(setq Stpt (Getpoint "\nPick starting point or Enter for Lastpoint: "))
(if (null stpt)(setq stpt (getvar "LASTPOINT")))

(while (setq d (getstring "\nEnter Distance or [Arc]: "))
(if (= (strcase d) "A")
(progn
(arl)
(if (minusp rad)
(setvar "lastpoint" startpoint)
(setvar "lastpoint" endpoint))
(c:trav))
(progn
(setq d (atof d))
(print "4=NW | 1=NE")
(print "-----+----- 5=Last bearing")
(print "3=SW | 2=SE Enter quadrant: ")
(initget "1 2 3 4 5")
(setq quad (atof (getKword)))
(if (= quad 5)(setq bear bear)
(progn
(dms)
(cond ((= quad 1)(setq bear (- 90.0 ang_degs)))
((= quad 2)(setq bear (+ 270.0 ang_degs)))
((= quad 3)(setq bear (- 270.0 ang_degs)))
((= quad 4)(setq bear (+ 90.0 ang_degs)))
); end cond
); end progn
); end if
))




(setq newpt (polar stpt (dtr bear) d))
(command "LINE" stpt newpt "")
(setq stpt newpt)
(setvar "LASTPOINT" newpt)

(cond
((= quad 1) (princ (strcat "N" (rtos deg 2 0) "-" (rtos mins 2 0) "-" (rtos sec 2 0) "E" " " "Dist=" (rtos d 2 2))))
((= quad 2) (princ (strcat "S" (rtos deg 2 0) "-" (rtos mins 2 0) "-" (rtos sec 2 0) "E" " " "Dist=" (rtos d 2 2))))
((= quad 3) (princ (strcat "S" (rtos deg 2 0) "-" (rtos mins 2 0) "-" (rtos sec 2 0) "W" " " "Dist=" (rtos d 2 2))))
((= quad 4) (princ (strcat "N" (rtos deg 2 0) "-" (rtos mins 2 0) "-" (rtos sec 2 0) "W" " " "Dist=" (rtos d 2 2))))
((= quad 5) (princ "\nUsed Last Bearing" ))
(t nil)

)

) ; end while
(*error* nil)
)