Azimuth & Distance Labeling
Vivian S. Yamashita
of lines? Right now I list the line, write the information on paper and
then type it in the file.
I do occasional survey drafting and don't feel the need to purchase some
of the more sophisticated programs that do this automatically.
Any help would be greatly appreciated.
Vivian Yamashita
CAD Ink
David Doane
Vivian S. Yamashita <ksf...@lava.net> wrote in article
<377FEE...@lava.net>...
Vivian,
Some time ago I wrote a program to enable one to enter a bearing and a
distance, and it would draw a line, or polyline, from coordinate point to
coordinate point, and optionally label the line. A companion program just
labels existing lines or points picked with bearing and distance. A third
program will measure and label an arc, giving the length of the arc, arc
radius, chord length and bearing.
When I first wrote it, for short segments I used an arrow to the
information. Later I converted it to create a table and list the segment
numbers with their bearing and distance.
This may only work in the WCS, and I don't remember considering viewtwist,
but that could be remedied, I think.
Does this sound like something you had in mind? If so, email me direct and
indicate exactly what you would want it to do so I can clean it up a bit.
It was only written for in-house use, and would come with no garantees.
What freebies do? <g>
--
Dave D
David Doane
Lectro-Mech Services
lectr...@cyberportal.net
(remove '-' for Email)
Owen Wengerd
>Has anyone come across a lisp routine to label the azimuth and distance
>of lines?
Take a look at DIMPL.ZIP on my freebies page:
http://www.manusoft.com/freebies.htm
--
Owen Wengerd
President, ManuSoft ==> http://www.manusoft.com
VP Americas, CADLock, Inc. ==> http://www.cadlock.com
Randy Benson
modify it:
HTH,
Randy
;*** Anotu.lsp -
;***AnNOTate a line, bearing stacked above distance, prompt to flip only
(defun err (msg)
(if (and oldos) (setvar "OSMODE" oldos))
(if (and oldcmd) (setvar "CMDECHO" 0))
(setq args '(olderr oldos oldcmd ed ang brg dst mp mp1 ts en ss yesno))
(foreach arg args (set arg nil))
(command nil nil nil)
(grtext) ;restores status and menu areas
;
;------------------------------------ if user did not cancel program, print
message
(if (not (member msg '("console break" "Function cancelled" "*Cancel*")))
(progn ;then program bug
(prompt
(strcat "Program ERROR: " ;print error message
(if
(> 11 (read (getvar "ACADVER"))) ;if R10 or earlier
"" ;add nothing
(progn ;add error number
(setq errno (itoa (getvar "ERRNO")))
(setvar "ERRNO" 0)
errno
)
)
" "
msg
)
)
)
)
(command "UNDO" "E")
(setvar "CMDECHO" oldcmd)
(setq *error* olderr)
(princ)
)
; RADTOBRG.lsp- converts a radian angle to list of (quadrant bearing)
(defun radtobrg (rads / 2PI)
(setq 2PI (* 2.0 PI))
(while (> rads 2PI) (setq rads (- rads 2PI))) ; normalize rads
(while (< rads 0.0) (setq rads (+ rads 2PI))) ; so that 0 <= rads <= 2PI
(cond((<= rads (* PI 0.5))
(setq quad 1 tdeg (* (/ 180.0 PI) (- (* PI 0.5) rads))
)
)
((and (> rads (* PI 0.5)) (<= rads PI))
(setq quad 4 tdeg (* (/ 180.0 PI) (- rads (* PI 0.5)))
)
)
((and (> rads PI) (<= rads (* PI 1.5)))
(setq quad 3 tdeg (* (/ 180.0 PI) (- (* PI 1.5) rads))
)
)
((and (> rads (* PI 1.5)) (<= rads 2PI))
(setq quad 2 tdeg (* (/ 180.0 PI) (- rads (* PI 1.5)))
)
)
)
(setq deg (fix tdeg) ; integer degrees
tmin (* (- tdeg deg) 60.0) ; floating minutes
mins (fix tmin) ; integer minutes
tsec (* (- tmin mins) 60.0) ; floating seconds
sec (atoi (rtos tsec 2 0)) ; integer seconds
)
(if (= 60 sec)
(progn
(setq sec 0
mins (1+ mins)
)
)
)
(setq tdeg (+ deg (/ mins 100.0000) (/ tsec 10000.0000)))
(list quad tdeg)
)
(defun c:anotu ( / olderr oldos oldcmd ed ang brg dst mp mp1 ts en ss yesno)
(setq
olderr *error*
*error* err
oldos (getvar "OSMODE")
oldcmd (getvar "CMDECHO")
)
(command "._UNDO" "BEG")
(setvar "OSMODE" 0)
(setvar "CMDECHO" 0)
(setq ed (entget (car (entsel "\nPick line to annotate: "))))
(setq ang (angle (cdr (assoc 10 ed)) (cdr (assoc 11 ed))))
(setvar "snapang" ang)
(radtobrg ang)
(if (= 1 (strlen (itoa mins))) (setq mins (strcat "0" (itoa mins)))
(setq mins (itoa mins))
)
(if (= 1 (strlen (itoa sec))) (setq sec (strcat "0" (itoa sec)))
(setq sec (itoa sec))
)
(cond ((= 1 quad)
(setq brg (strcat "N"(itoa deg)"%%160"mins"'" sec "\"E"))
)
((= 2 quad)
(setq ang (+ ang pi))
(setq brg (strcat "N"(itoa deg)"%%160"mins"'" sec "\"W"))
)
((= 3 quad)
(setq ang (+ ang pi))
(setq brg (strcat "N"(itoa deg)"%%160"mins"'" sec "\"E"))
)
((= 4 quad)
(setq brg (strcat "N"(itoa deg)"%%160"mins"'" sec "\"W"))
)
)
(setq dst (strcat (rtos
(distance (cdr (assoc 10 ed)) (cdr (assoc 11 ed))) 2 2) "'")
)
(setq mp
(mapcar
'*
(mapcar
'+
(cdr (assoc 10 ed))
(cdr (assoc 11 ed))
)
'(0.5 0.5 0.5)
)
)
(setq ts (getvar "TEXTSTYLE"))
(setq mp1
(polar mp
(+ ang (/ pi 2))
(/ (cdr (assoc 40 (tblsearch "STYLE" ts))) 2.0)
)
mp2
(polar mp
(- ang (/ pi 2))
(* (cdr (assoc 40 (tblsearch "STYLE" ts))) 1.5)
)
)
(command "text" "c" mp2 (angtos ang 0 1) dst)
(setq en (entlast))
(setq ss (ssadd en))
(command "text" "c" mp1 (angtos ang 0 1) brg)
(setq en (entlast))
(setq ss (ssadd en ss))
(initget 0 "Yes No")
(setq yesno (getkword "\Rotate? <N>"))
(if
(and
yesno
(= (strcase yesno) "YES")
)
(command "rotate" ss "" mp1 "180")
)
(while
(and
(setq p1 (getpoint mp1 "\nDistance to move both: "))
(< 1 (distance mp1 p1))
)
(command "MOVE" ss "" mp1 p1)
)
(command "._SELECT" ss "")
(setvar "CMDECHO" oldcmd)
(setvar "OSMODE" oldos)
(command "._UNDO" "END")
(setq *error* olderr
olderr nil
)
(princ)
)
Vivian S. Yamashita <ksf...@lava.net> wrote in message
news:377FEE...@lava.net...