Add DEG MIN SEC to bearings (angles)

contact lost

I need a routine that will ask the user how many degrees, mins, secs they wish to add to any text on the dwg that has this format: 123%%d45'12". Sometimes the whole subdivision rotates slightly and the bearings need to be updated by a few seconds, mins or even degrees.Alternatively if anyone had at least a function similar to DTR (Degrees to Radians)and RTD (Radians to Degrees) that will accept and extract input like 3%%d45'12" respectively would also help. I BASICALLY NEED TO CONVERT TEXT OBJECTS FROM THIS 123%%d45'12" FORMAT TO RADIANS AND VICE VERSA. Thanks a milion av@computersupport.itgo.com

contact lost

Here is the code for Distances and vearings. The Lisp routine is "MIDA". ;; Insert Bearing and distances.(Defun error (msg) (princ "Exit...") (princ msg) (Setvar "osmode" 0) (Terpri))(Defun nsew () (SetQ BNG " ") (if (and (= (car pt1) (car pt2)) (< (cadr pt1) (cadr pt2))) (SetQ BNG "north") );if (if (and (< (car pt1) (car pt2)) (= (cadr pt1) (cadr pt2))) (SetQ BNG "east") );if (if (and (= (car pt1) (car pt2)) (> (cadr pt1) (cadr pt2))) (SetQ BNG "south") );if (if (and (> (car pt1) (car pt2)) (= (cadr pt1) (cadr pt2))) (SetQ BNG "west") );if);Defun(Defun bearing (/ A D M S O T G AZMTH) (SetQ O (- (car pt2) (car pt1)) T (- (cadr pt2) (cadr pt1)) AZMTH (/ (* (atan (/ O T)) 180.0) pi) A (abs AZMTH) D (fix A) M (* 60 (- A D)) S (* 60 (- M (fix M))) M (fix M) );SetQ (if (= "60" (rtos s 2 0)) (SetQ M (+ 1 m))) (if (= "60" (rtos s 2 0)) (SetQ S 0)) (if (= "60" (rtos m 2 0)) (SetQ D (+ 1 d))) (if (= "60" (rtos m 2 0)) (SetQ M 0)) (if (< (cadr pt2) (cadr pt1)) (SetQ G "S") (SetQ G "N")) (if (< (car pt1) (car pt2)) (SetQ H "E") (SetQ H "W")) (SetQ BNG (strcat G "" (if (< D 10) (strcat "0" (rtos D 2 0)) (rtos D 2 0)) "d" (if (< M 10) (strcat "0" (rtos M 2 0)) (rtos M 2 0)) "'" (if (< S 10) (strcat "0" (rtos S 2 0)) (rtos S 2 0)) "''" "" H)) );SetQ(Defun C:MIDA (/ pt pt1 pt2 l ang d pt) (chklayer "1608") (Command "layer" "c" 7 "1608" "") (uvar) (SetQ act T) (Setvar "osmode" 35) (SetQ pt1 (getpoint "\nFrom...") pt1 (list (car pt1) (cadr pt1)) ) (While act (SetQ pt2 (getpoint pt1 "\nTo...") pt2 (list (car pt2) (cadr pt2)) d (distance pt1 pt2) l (rtos d) ang (angle pt1 pt2) pt (polar pt1 ang (/ d 2)) ) (nsew) (If (Eq BNG " ") (bearing)) (if (and (> ang (/ pi 2)) (< ang (* 1.5 pi))) (SetQ ang (+ ang pi)) ) (SetQ pt (polar pt (+ ang 1.570796) #htxt)) (Princ (Strcat "\nDistance = " l " Azimute = " BNG)) (PrinC) (SetQ yesno (ukword 1 "Yes No" "Add Distance to Drawing ? [Y/N] " yesno)) (If (Eq yesno "Yes") (Progn (SetQ pt (polar pt (+ ang 1.570796) #htxt)) (entmake (list (cons 0 "text") (cons 8 "1608") (list 10 (car pt) (cadr pt)) (cons 40 #htxt) (cons 1 l) (cons 50 ang) (cons 51 10) (cons 72 1) (list 11 (car pt) (cadr pt)))) (SetQ pt (polar pt (+ ang 1.570796) (- 0.0 (* #htxt 2.0)))) (entmake (list (cons 0 "text") (cons 8 "1608") (list 10 (car pt) (cadr pt)) (cons 40 #htxt) (cons 1 BNG) (cons 50 ang) (cons 51 10) (cons 72 1) (list 11 (car pt) (cadr pt)))) ) ) (SetQ pt1 pt2) ) ;while (Princ) (Setvar "osmode" 0))

contact lost

Thanks for your prompt response Raam.I have tried the routine but even after REMming out some functions that were not included I had trouble running it.egIN AUTOCAD I GET:Command: midaFrom...To...; error: incorrect object to bind: TIN ICAD I GET:From...To...error: bad argument type(POLAR PT (+ ANG 1.57080) #HTXT) (SETQ PT (POLAR PT (+ ANG 1.57080) #HTXT)) (WHILE ACT (SETQ PT2 (GETPOINT PT1 "\nTo...") PT2 (LIST (CAR PT2) (CADR PT2)) D (DISTANCE PT1 PT2) L (RTOS D) ANG (ANGLE PT1 PT2) PT (POLAR PT1 ANG (/ D 2))) (NSEW) (IF (EQ BNG " ") (BEARING)) (IF (AND (> ANG (/ PI ..........==================================================================I could probably get around the errors but I don't think the routine will do what I want. Tell me Raam, does it add a brg to an existing one. For example: If on screen we have a bunch of bearings (as I have a routine to do this) and at a later stage the subdivision has rotated say by 1degree and 10 seconds will this number be added to the existing brgs? So if I had 3 brgs on screen: 90°30'20", 178°21'30 and 32°33'50" then I should get this after running the new routine: 91°30'30", 179°21'40 and 33°34' respectively.I BASICALLY NEED TO CONVERT TEXT OBJECTS FROM THIS 123%%d45'12" FORMAT TO RADIANS AND VICE VERSA so that I can ask the user how many deg, min, sec they need to add or subtract from the existing BRGs converting this to RADIANS add it to the existing BRG (which will also be converted to radians) do the sum on the 2 figures and then convert it back to DEGREES, MINUTES, SECONDS format and update the existing brg on the screen.Thanks again for your generocity and please point out where I have gone wrong with your code.Best regardsAndreas

contact lost

Sorry.Forgot to add the routines that are common to all my other routines.Here are the rest of thos routines :(DEFUN uvar (/ tmp size) (If (= (GetVar "UserR1") 0) (SetVar "UserR1" (Getreal "\nSCALE.. 1: "))) (SetVar "TEXTSIZE" (* (Getvar "userR1") 0.0017)) (SetQ #knm (getvar "userR1")) (SetQ #htxt (getvar "TEXTSIZE")) (Setvar "DIMSCALE" (/ #knm 100.0)) (Setvar "HPSCALE" (/ #knm 100.0)) (SetVar "DIMTXT" (* (* (Getvar "userR1") 0.0017) (Getvar "DIMSCALE")));;; (SetVar "DIMTXT" (/ (* (Getvar "userR1") 0.0017) (Getvar "DIMSCALE"))) (Setvar "ltscale" (/ #knm 100.0)) (SetQ tmp (Getvar "pdmode")) (Cond ((Eq tmp 32) (SetQ size 2.3)) ((Eq tmp 33) (SetQ size 2.3)) (t (SetQ size 1.0) ) ) (SetVar "PDSIZE" (* #knm 0.0005 size)))(defun chklayer (layr / ts) (setq ts (tblsearch "LAYER" layr)) (if (null ts) (Princ (strcat "\nBuilding a New Layer " (strcase layr))) (progn (if (= (logand 1 (cdr (assoc 70 ts))) 1) (command "LAYER" "T" layr "") ) ) ) (command "LAYER" "N" layr "")) ; end defun;* UKWORD User key word. DEF, if any, must match one of the KWD strings;* BIT (1 for no null, 0 for none) and KWD key word ("" for none) are same as;* for INITGET. MSG is the prompt string, to which a default string is added as;* (nil or "" for none), and a : is added.;(defun ukword (bit kwd msg def / inp) (if (and def (/= def "")) ;test for both nil and null string (setq msg (strcat "\n" msg "<" def ">: ") ;string'em with default bit ( 2 (fix (/ bit 2))) ;a default and no null bit code conflict so );setq ;this reduces bit by 1 if odd, to allow null (if (= " " (substr msg (strlen msg) 1)) ;no def, if last char is space (setq msg (strcat "\n" (substr msg 1 (1- (strlen msg))) ": ")) ;then strip space (setq msg (strcat "\n" msg ": ")) ;else msg OK ) );if,if (initget bit kwd) ;initialize the key words (setq inp (getkword msg)) ;and use the GET command (if inp inp def) ;compare the results, return appropriate value);defun