Line Labeling

I need a lisp routine to label lines with surveyors Units with bearing
(N39°16'24"E 12.36')
or without a bearing (12.36').
Any Help would be greatly appreciated
Reply to
Loading thread data ...
HiHo; I wrote this many years ago and it works with R2002. Load and type "bd", "enter", without the "s to run. Read the program header to see the options, Bearing/dist above/below on or off ect.
Reply to
I wrote one a few years ago. Probably you could download something better from some "official" site. Mine is pretty simple.
If you find nothing that suites, send me an email.
you will need to remove all superflous text though.
Reply to
HiHo; So, I can't attached a file to this email. Below is the program. ............................................................................ ...................................................... ;;;BD.lsp 9 Aug. 96 by Jiro ;;; Revisied by JIRO 14 May 97 ;;; Revisied by Jiro 18 Nov. 2002...OSNAP Fix for R14 and up. ;;; The variable "osnapcoord" , when set to 1, will work ;;;======================================================== ;;; This routine requires a FIXED HEIGHT TEXT-STYLE ;;; At the prompt "Start point:" pick a starting point, ;;; endpoint of a line, or ENTER the coordinates. OSNAPS are honored. ;;; The cmd-line display is similar to the PEDIT command. ;;; Bearing,Dist,Line,Flip,Start,stAck,eXit or pick-pt:" ;;; PRESS the following toggle's and.... or Spacebar ;;; b will turn on/off bearings annotation ;;; and will display a Bearing on the cmd line ;;; d will turn on/off distance annotation ;;; and will display a Distance on the cmd line ;;; L will turn on/off lines drawn from Start point to pick-pt ;;; and will display a -L- on the cmd line ;;; f will "Flip" the "Bear/Dist"to "Dist/Bear" ;;; a will "stAck" "Dist Bear /" or Flip for "/ Bear Dist" ;;; s will allow you to start annotating at a new Start point, ;;; while maintaining the current status of "BDL" ;;; x will EXIT this program ;;; or pick-a-point, [ OSNAP's are honored ] ;;; ;;;======================================================== (defun c:bd (/ SumVars ) ;========================================================== (defun *error* (msg) (princ msg) );end defun error
;========================================================== ; Set and Save System Variables ; REMBEMBER to edit the vlist list ;========================================================== (Defun pushvars ( ) (setq vlist '(("cmdecho" . 0) ("aunits" . 3) ("angdir" . 0) ("angbase" . 0) ("osnapcoord" . 1);This fixes it in 2002 ) );end setq (setq old_error *error*) (setvar "modemacro" ".") (ForEach pair vlist (Setq name (Strcase (CAR pair))) (If (Not (Assoc name sysvars)) (Setq sysvars (Cons (Cons name (GetVar name)) sysvars) ); setq );end if (If (CDR pair) (Setvar name (CDR pair)) );if );end foreach );end pushvars
;========================================================== ; Restore System Variables ;========================================================== (Defun popvars ( ) (ForEach pair sysvars (Setvar (CAR pair) (CDR pair)) ) (Setq *error* old_error) (Setq sysvars Nil) (setvar "modemacro" ".") (princ) );end popvars ;========================================================== ;;;Additional defun functions go here ;========================================================== (defun bd_main ( / ab ad ang1 ang2 at au b bo ce d do ds entla_a entla_d f gr l lo p1 p2 p3 s so st th to)
(if (= 0.0 (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))) (progn (alert "Change TEXTSTYLE\nto FixEd Height TEXT") (pushvars) ) ) (setq th (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE")))) b 1.0 bo "B" d 1.0 do "D" l 0 lo "" f 1.0 gr "B /
D " at 0 to "" switch 1 ) (grtext -1 gr) (while (= switch 1) (setq p1(getpoint "\nStart point:")) (grtext -1 gr) (while p1 (if (= b 1) (setq bo " B ") (setq bo " ")) (if (= d 1) (setq do " D ") (setq do " ")) (if (= l 1) (setq lo " -L- ") (setq lo " ")) (if (= at 1) (setq to "BD") (setq to "")) (if (= f 1) (if (= to "") (setq gr (strcat bo "/" do lo)) (setq gr (strcat do bo "/" lo)) );if (if (= to "") (setq gr (strcat do "/" bo lo)) (setq gr (strcat "/" bo do lo)) );if );if (grtext -1 gr) (initget 1 "B D L F S A X") (setq p2 (getpoint p1"\nBearing,Dist,Line,Flip,Start,stAck,eXit or pick-pt:")) (cond ((eq p2 "B") (setq b (- 1 b))) ((eq p2 "D") (setq d (- 1 d))) ((eq p2 "L") (setq l (- 1 l))) ((eq p2 "F") (setq f (* f -1.0))) ((eq p2 "S") (setq p1 nil)) ((eq p2 "A") (progn (setq at (- 1 at)) (if (and (= at 1) (not (and (= b 1) (= d 1)))) (progn (alert "Both Bear & Dist\nMust be on\nTurning On NOW !\nSee CMD line") (setq b 1 d 1 );setq );progn );if ));eq p2 A ((eq p2 "X") (setq p1 nil switch nil )) ((eq (type p2) 'LIST) (progn (grtext -1 gr) (if (= l 1.0) (command "LINE" p1 p2 "") ) (setq ang1 (angle p1 p2) ang2 (angle p2 p1) ds (distance p1 p2) p3 (polar p1 (angle p1 p2) (/ ds 2.0)) p1 p2 st (angtos ang1 4 4) st (if (equal "d" (substr st 5 1)) (strcat (substr st 1 4) "%%d" (substr st 6)) (strcat (substr st 1 3) "%%d" (substr st 5))) );setq (if(and (> ang1 (/ pi 2.0)) (< ang1 (* pi 1.5))) (setq ang1 ang2)) (if (= b 1) (progn (command "TEXT" "J" "M" (polar p3 (+ ang1 (* f (/ pi 2.0))) th) ang1 st);cmd );progn );if
(if (= d 1) (progn (if (= at 0) (command "TEXT" "J" "M" (polar p3 (- ang1 (* f (/ pi 2.0))) th) ang1 (rtos ds 2 2));cmd
(command "TEXT" "J" "M" (polar p3 (+ ang1 (* f (/ pi 2.0))) (* 2.5 th)) ang1 (rtos ds 2 2));cmd );if );progn );if );progn );equal type p2 list );cond );while 2 );while 1 );end bd_main ;========================================================== ;;;Start of main program ;========================================================== ;;; The rest of the program goes here
(pushvars) (bd_main) (popvars)
;;; And ends here ;========================================================== (princ) );end c:bd
............................................................................ ........................................................
Reply to
I can see it just fine, 3 times :D
Reply to

PolyTech Forum website is not affiliated with any of the manufacturers or service providers discussed here. All logos and trade names are the property of their respective owners.