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

Robert

Reply to
Robert
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
bestafor

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.

melkor@[superfluoustext]socket.net

you will need to remove all superflous text though.

Reply to
roy

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

............................................................................ ........................................................ "Robert" wrote in message news:fIvJf.1368$ snipped-for-privacy@bignews6.bellsouth.net...

Reply to
bestafor

I can see it just fine, 3 times :D

Reply to
The-trooper

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.