Tek-Tips is the largest IT community on the Internet today!
Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!
-
Congratulations TugboatEng on being selected by the Eng-Tips community for having the most helpful posts in the forums last week. Way to Go!
show bearings and distances 1
- Thread starter vicman2
- Start date
![[thumbsup2]](/data/assets/smilies/thumbsup2.gif "[thumbsup2] [thumbsup2]")
Suppose I go ahead and complete the routine? Howz that? ![[ponder]](/data/assets/smilies/ponder.gif "[ponder] [ponder]")
well i have an old label routine for acad. have used them for both acad 14 & 2002. don't use them much now use eagle point, they are approx. 8 years old. try them for yourself, 25$ to register. they don't "time out" and if you locate the author and enjoy his product then let him know and send $$. see "readme.doc".
can't seem to include the zip file in this post, so therefore e-mail to request label routine.
lee@polysurveying.com
Intel P4 1.7 GHZ
768 RDRAM
Win 2000 Pro
Autocad 14, 2002 with EP 2.3.1
can't seem to include the zip file in this post, so therefore e-mail to request label routine.
lee@polysurveying.com
Intel P4 1.7 GHZ
768 RDRAM
Win 2000 Pro
Autocad 14, 2002 with EP 2.3.1
- Thread starter
- #5
diamondjim
Mechanical
Why not post your lisp file here
and let the guys see it and determine
why it will not load into 2000.
It should load unless you have some
type of memory limitation or not
have lisp feature on.
and let the guys see it and determine
why it will not load into 2000.
It should load unless you have some
type of memory limitation or not
have lisp feature on.
-
1
- #7
Here is a lisp file I've used since rel. 12 and still use in Map 5. It puts the dist & heading on the text layer and it the text layer doesn't exist then it creates it.
;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;* HDG.LSP *
;* Select 2 points and insert the distance/heading *
;* Stephen Motichek *
;* rev 2.0a 2-7-03 *
;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
(defun FOR_ANG (Ang_Strng / trash Deg_Mrk Min_Mrk Sec_Mrk Count New_Strng
First_Chr Temp_Strng Basis)
(setq trash Ang_Strng
New_Strng ""
Temp_Strng ""
Count 1
Deg_Mrk 0
Min_Mrk 0
Sec_Mrk 0)
(setq Basis (strlen Ang_Strng))
(while (<= Count Basis)
(setq First_Chr (strcat (substr Ang_Strng count 1)))
(cond
((= First_Chr (chr 100)) (setq Deg_Mrk Count))
((= First_Chr (chr 39)) (setq Min_Mrk Count))
((= First_Chr (chr 34)) (setq Sec_Mrk Count))
) ; end cond
(setq count (1+ count))
) ; end while
(if (/= Deg_Mrk 0)
(progn
(setq Temp_Strng (strcat (substr Trash 1 (- Deg_mrk 1))))
(setq New_Strng (strcat Temp_Strng "%%d"
)
); end progn
) ; end if
(if (/= Min_Mrk 0)
(progn
(setq Min_Len (- Min_mrk (1+ Deg_Mrk)))
(setq temp_strng (strcat (substr Trash (1+ Deg_mrk) Min_Len)))
(setq new_strng (strcat new_strng (chr 32) Temp_strng "'")
); end progn
) ;end if
(if (/= Sec_Mrk 0)
(setq new_strng (strcat new_strng (chr 32) (substr Trash (1+ Min_mrk))))
) ;end if
(if (or (/= Deg_Mrk 0) (/= Min_Mrk 0) (/= Sec_Mrk 0))
(setq Ang_Strng New_Strng) ; then
(setq Ang_Strng Trash) ; else angle is N, S, E, or W
) ; end if
); end for_ang
;==============================================================================
(defun add_commas (real_strng / neg temp_num2 trash temp_num int_part_strng
Str_Length Count Spot Frac_Part Next_chr Txt)
(setq Temp_Num (atof Real_strng)) ; convert string to float
(setq Temp_Num2 (fix Temp_Num))
(setq Int_Part (abs Temp_Num2))
(if (= (minusp Temp_Num) T)
(setq Neg "-" ; then
(setq Neg "" ; else
); end if
(setq Int_Part_Strng (itoa Int_Part)) ; convert integer part back to string
(setq Count 1) ; initialize counter
(setq Str_Length (strlen Real_Strng)) ; length of original string
(while (< Count Str_Length)
(setq Temp (strcat (substr Real_Strng Count 1)))
(if (= Temp (chr 46))
(setq Spot Count) ; then
); end if
(setq Count (1+ Count)) ; increment counter
); end while
(if (/= Spot Str_Length)
(setq Frac_Part (strcat (substr Real_Strng Spot))) ; then
(setq Frac_Part "" ; else
) ; end if
(setq Count 0) ; initialize counter
(setq New_Strng "" ; initialize a new string to be empty
(setq Basis (strlen Int_Part_Strng)) ; length of inter part of string
(while (< Count Basis)
(cond
((or (= Count 3) (= Count 6) (= Count 9) (= Count 12)) ; comma locations
(setq Next_Chr (strcat (substr Int_Part_Strng (- Basis Count) 1)))
(setq New_Strng (strcat Next_Chr (chr 44) New_Strng))
(setq Count (1+ Count))
);end cond #1
( ;else - no comma
(setq Next_Chr (strcat (substr Int_Part_Strng (- Basis Count) 1)))
(setq New_Strng (strcat Next_Chr New_Strng))
(setq Count (1+ Count))
);end cond #2
);end cond
);end while
(setq Txt (strcat Neg New_Strng Frac_Part)) ; putting the integer & float together
);end add_commas
(defun mlayer (name color ltype)
(if (tblsearch "layer" name) (command ".-layer" "s" name ""
(progn
(setq regmod (getvar "regenmode")(setvar "regenmode" 0)(command ".-layer" "m" name)
(if color (command "c" color name))
(if ltype (command "l" ltype name))
(command ""(command ".-layer" "s" name "" (setvar "regenmode" regmod)
);progn
);if
(princ)
);mlayer
;==============================================================================
(defun scl (x) (* (getvar "dimscale" x))
;============================ MAIN PROGRAM ====================================
(defun C:HDG (/ cla p1 p2 dist dist1 ang ang1 qua dist2
p2 ang2 txht p4 dist3 p5)
(setvar "cmdecho" 0)
(setq p1 (getpoint "\nStarting Point: ")
(setq p2 (getpoint p1 "\nEnding Point: ")
(setq ang (angle p1 p2))
(setq ang1 (angtos ang 4 4))
(cond
((and (>= ang 0) (<= ang 1.5708)) (setq qua 1))
((and (>= ang 4.71239)(< ang 6.2831853))(setq qua 1))
((and (> ang 1.5708)(< ang 4.71239))(setq qua 2))
)
(setq dist (distance p1 p2))
(setq dist1 (strcat (rtos dist 2 2) (chr 39)))
(setq dist1 (add_commas dist1)) ; add commas to string
(setq dist2 (/ dist 2))
(setq p3 (polar p1 ang dist2))
(setq ang2 (+ ang 1.5707963))
(setq p4 (polar p3 ang2 (scl 0.125)))
(setq txht (scl (getvar "dimtxt")) ; base text on dimtxt variable
(setq ang3 (- ang 1.5707963))
(setq dist3 (+ txht (scl 0.125)))
(setq p5 (polar p3 ang3 dist3))
(setq ang4 (for_ang ang1)) ; format angle string
(mlayer "text" "9" "continuous"
(command ".-layer" "s" "text" ""
(setq osmod (getvar "osmode")
(setvar "osmode" 0)
(if (= qua 1)
(progn
(command ".-text" "c" p4 txht ang1 dist1)
(command ".-text" "c" p5 txht ang1 ang4)
); end progn ; end then
(progn ; else
(command ".-text" "c" p4 txht ang1 dist1)
(command ".-rotate" "L" "" p3 180)
(command ".-text" "c" p5 txht ang1 ang4)
(command ".-rotate" "L" "" p3 180)
); end progn ; end else
)
(setvar "osmode" osmod)
(command ".-layer" "s" cla ""
);
Good Luck
Stephen E. Motichek
Project Consulting Services, Inc.
;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;* HDG.LSP *
;* Select 2 points and insert the distance/heading *
;* Stephen Motichek *
;* rev 2.0a 2-7-03 *
;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
(defun FOR_ANG (Ang_Strng / trash Deg_Mrk Min_Mrk Sec_Mrk Count New_Strng
First_Chr Temp_Strng Basis)
(setq trash Ang_Strng
New_Strng ""
Temp_Strng ""
Count 1
Deg_Mrk 0
Min_Mrk 0
Sec_Mrk 0)
(setq Basis (strlen Ang_Strng))
(while (<= Count Basis)
(setq First_Chr (strcat (substr Ang_Strng count 1)))
(cond
((= First_Chr (chr 100)) (setq Deg_Mrk Count))
((= First_Chr (chr 39)) (setq Min_Mrk Count))
((= First_Chr (chr 34)) (setq Sec_Mrk Count))
) ; end cond
(setq count (1+ count))
) ; end while
(if (/= Deg_Mrk 0)
(progn
(setq Temp_Strng (strcat (substr Trash 1 (- Deg_mrk 1))))
(setq New_Strng (strcat Temp_Strng "%%d"
)); end progn
) ; end if
(if (/= Min_Mrk 0)
(progn
(setq Min_Len (- Min_mrk (1+ Deg_Mrk)))
(setq temp_strng (strcat (substr Trash (1+ Deg_mrk) Min_Len)))
(setq new_strng (strcat new_strng (chr 32) Temp_strng "'"
)); end progn
) ;end if
(if (/= Sec_Mrk 0)
(setq new_strng (strcat new_strng (chr 32) (substr Trash (1+ Min_mrk))))
) ;end if
(if (or (/= Deg_Mrk 0) (/= Min_Mrk 0) (/= Sec_Mrk 0))
(setq Ang_Strng New_Strng) ; then
(setq Ang_Strng Trash) ; else angle is N, S, E, or W
) ; end if
); end for_ang
;==============================================================================
(defun add_commas (real_strng / neg temp_num2 trash temp_num int_part_strng
Str_Length Count Spot Frac_Part Next_chr Txt)
(setq Temp_Num (atof Real_strng)) ; convert string to float
(setq Temp_Num2 (fix Temp_Num))
(setq Int_Part (abs Temp_Num2))
(if (= (minusp Temp_Num) T)
(setq Neg "-"
; then(setq Neg ""
; else); end if
(setq Int_Part_Strng (itoa Int_Part)) ; convert integer part back to string
(setq Count 1) ; initialize counter
(setq Str_Length (strlen Real_Strng)) ; length of original string
(while (< Count Str_Length)
(setq Temp (strcat (substr Real_Strng Count 1)))
(if (= Temp (chr 46))
(setq Spot Count) ; then
); end if
(setq Count (1+ Count)) ; increment counter
); end while
(if (/= Spot Str_Length)
(setq Frac_Part (strcat (substr Real_Strng Spot))) ; then
(setq Frac_Part ""
; else) ; end if
(setq Count 0) ; initialize counter
(setq New_Strng ""
; initialize a new string to be empty(setq Basis (strlen Int_Part_Strng)) ; length of inter part of string
(while (< Count Basis)
(cond
((or (= Count 3) (= Count 6) (= Count 9) (= Count 12)) ; comma locations
(setq Next_Chr (strcat (substr Int_Part_Strng (- Basis Count) 1)))
(setq New_Strng (strcat Next_Chr (chr 44) New_Strng))
(setq Count (1+ Count))
);end cond #1
( ;else - no comma
(setq Next_Chr (strcat (substr Int_Part_Strng (- Basis Count) 1)))
(setq New_Strng (strcat Next_Chr New_Strng))
(setq Count (1+ Count))
);end cond #2
);end cond
);end while
(setq Txt (strcat Neg New_Strng Frac_Part)) ; putting the integer & float together
);end add_commas
(defun mlayer (name color ltype)
(if (tblsearch "layer" name) (command ".-layer" "s" name ""
(progn
(setq regmod (getvar "regenmode"
)(setvar "regenmode" 0)(command ".-layer" "m" name)(if color (command "c" color name))
(if ltype (command "l" ltype name))
(command ""
(command ".-layer" "s" name "" (setvar "regenmode" regmod));progn
);if
(princ)
);mlayer
;==============================================================================
(defun scl (x) (* (getvar "dimscale"
x));============================ MAIN PROGRAM ====================================
(defun C:HDG (/ cla p1 p2 dist dist1 ang ang1 qua dist2
p2 ang2 txht p4 dist3 p5)
(setvar "cmdecho" 0)
(setq p1 (getpoint "\nStarting Point: "
)(setq p2 (getpoint p1 "\nEnding Point: "
)(setq ang (angle p1 p2))
(setq ang1 (angtos ang 4 4))
(cond
((and (>= ang 0) (<= ang 1.5708)) (setq qua 1))
((and (>= ang 4.71239)(< ang 6.2831853))(setq qua 1))
((and (> ang 1.5708)(< ang 4.71239))(setq qua 2))
)
(setq dist (distance p1 p2))
(setq dist1 (strcat (rtos dist 2 2) (chr 39)))
(setq dist1 (add_commas dist1)) ; add commas to string
(setq dist2 (/ dist 2))
(setq p3 (polar p1 ang dist2))
(setq ang2 (+ ang 1.5707963))
(setq p4 (polar p3 ang2 (scl 0.125)))
(setq txht (scl (getvar "dimtxt"
)) ; base text on dimtxt variable(setq ang3 (- ang 1.5707963))
(setq dist3 (+ txht (scl 0.125)))
(setq p5 (polar p3 ang3 dist3))
(setq ang4 (for_ang ang1)) ; format angle string
(mlayer "text" "9" "continuous"
(command ".-layer" "s" "text" ""
(setq osmod (getvar "osmode"
)(setvar "osmode" 0)
(if (= qua 1)
(progn
(command ".-text" "c" p4 txht ang1 dist1)
(command ".-text" "c" p5 txht ang1 ang4)
); end progn ; end then
(progn ; else
(command ".-text" "c" p4 txht ang1 dist1)
(command ".-rotate" "L" "" p3 180)
(command ".-text" "c" p5 txht ang1 ang4)
(command ".-rotate" "L" "" p3 180)
); end progn ; end else
)
(setvar "osmode" osmod)
(command ".-layer" "s" cla ""
);
Good Luck
Stephen E. Motichek
Project Consulting Services, Inc.
![[3eyes]](/data/assets/smilies/3eyes.gif "[3eyes] [3eyes]")
- Thread starter
- #9
I searched my archives and came up with these. The one I am attempting to load is one of these but has been modified for Canadian use. The distances are in metres and decimals thereof ( a lttle legal mumbo jumbo from a surveyor's affidavit)and bearings are azmuiths measured from north, that is bearings are from 0 to 360 degrees measured clockwise from north.
;program to note the bearing and distance between two points
;or the two ends of a line for Architects and Civil Engineers
;who don't have a cogo package and need to label boundary lines
;you can change the layer names, colors, and linetypes as you
;see fit
;
(defun C:CLEAN (); delete this function if you already have it loaded
(setq atomlist (member 'C:CLEAN atomlist));'DONE
);close defun
;functions half,spcg,spc,rtd,and convert are all utility functions
;to clean up the main program
;
(defun half (pi) ;returns 90 degrees in radians
(/ pi 2))
(defun spcg (ts) ;returns line spacing = 1/2 text size
(/ ts 2))
(defun spc (ts) ;returns offset from end of line = 2 x text size
(* ts 2))
(defun rtd (ang / ) ;converts radians to degrees
(* (/ ang pi) 180.0))
(defun convert (angtext) ;replaces d in text string with degrees
;symbol
(setq newtext "" test nil)
(setq L (strlen angtext))
(setq n 4)
(while (<= n L)
(setq ds (substr angtext n 1))
(if (= ds "d"
(progn
(setq ds "%%d"
(setq test T)
(setq newtext (strcat (substr angtext 1 (1- n))
ds (substr angtext (1+ n))))
);close progn
);close if
(if (= T test)(setq n (1+ L)) (setq n (1+ n)))
);close while
(setq angtext newtext)
);close defun
;
;main program begins here
;cflag for centered, right justified, or left justified text location
;lflag for above or below line text location
;tflag for text content - bearing only, distance only, or both
;
(defun C
ISTNOTE ()
(graphscr)
(setq save (getvar "CLAYER");saves current layer
(setvar "CMDECHO" 0);turns off command echoing to screen
(setq cont "Y"initializes value for repeating program
(setq pstring (strcat "Text height <default="
(rtos (getvar "TEXTSIZE" 2 2) ">: ")
;sets default value for text height prompt
(command "LAYER" "MAKE" "BRG_DIST" "COLOR" "RED" "BRG_DIST" ""
;places text on new layer brg_dist with color=red
;a layer ltype command could be added here if desired
(setq tflag (strcase
(getstring "Bearing only, Distance only, or both - Type B, D, or BD
<default=BD>: "))
(if (= tflag ""(setq tflag "BD");default
(if (or (= tflag "B"(= tflag "D")
(progn
(setq lflag (strcase
(getstring "Locate text A, or B line <default=A>: "))
(if (= lflag "" (setq lflag "A")
);close progn - then clause of if statement
(progn
(setq lflag (strcase
(getstring "Locate text A, B, or AB line
<default=AB>: "))
(if (= lflag "" (setq lflag "AB")
);close progn - else clause of if statement
);close if
(setq cflag (strcase
(getstring "Right end, Centered, or Left end of line
<default=C>: "))
(if (= cflag "" (setq cflag "C");default
(setq ts (getdist pstring));sets text height
(if (= ts nil) (setq ts (getvar "TEXTSIZE"));default
(setvar "OSMODE" 9)
(while (= cont "Y"repeats with same values
(setq pt1 (osnap (getpoint "First point: " "node,endpoint")
(setq pt2 (osnap (getpoint "Second point: " "node,endpoint")
(setq dist (distance pt1 pt2))
(setq ang (angle pt1 pt2))
(setq disttext (strcat (rtos dist 2 2) "'");adds feet symbol to
;string
(setq angtext (angtos ang 4 4));converts angle to surveyor units
(if (> (strlen angtext) 6)(setq angtext (convert angtext)));see
;convert
(if (or (= lflag "A" (= lflag "B")
(progn
(cond
((= tflag "BD"(setq txt (strcat angtext " "
disttext)))
((= tflag "B"(setq txt angtext))
((= tflag "D"(setq txt disttext))
);close cond
);close progn
);close if
(cond
((= cflag "L"
(setq loc (polar pt1 ang (spc ts))))
((= cflag "C"
(setq loc (polar pt1 ang (/ dist 2))))
((= cflag "R"
(setq loc (polar pt1 ang (- dist (spc ts)))))
);close cond - starting location for text
(setq locOFF1 (polar loc (+ ang (half pi)) (spcg ts))); above
;line
(setq locOFF2 (polar loc (- ang (half pi)) (* (spcg ts) 3)));
;below line
(setq anglin (rtd ang)); sets text angle to proper units
(cond
((= cflag "L"
(cond
((= tflag "BD"
(cond
((= lflag "AB"
(command "TEXT" locOFF1 ts anglin angtext)
(command "TEXT" locOFF2 ts anglin disttext))
((= lflag "A"
(command "TEXT" locOFF1 ts anglin txt))
((= lflag "B"
(command "TEXT" locOFF2 ts anglin txt))
); close cond
); close expresion
((or (= tflag "B"(= tflag "D")
(cond
((= lflag "A"
(command "TEXT" locOFF1 ts anglin txt))
((= lflag "B"
(command "TEXT" locOFF2 ts anglin txt))
); close cond
); close expresion
); close cond - prints text in proper location and format
); close expresion = "L"
((/= cflag "L"
(cond
((= tflag "BD"
(cond
((= lflag "AB"
(command "TEXT" cflag locOFF1 ts anglin angtext)
(command "TEXT" cflag locOFF2 ts anglin
disttext))
((= lflag "A"
(command "TEXT" cflag locOFF1 ts anglin txt))
((= lflag "B"
(command "TEXT" cflag locOFF2 ts anglin txt))
); close cond
); close expresion
((or (= tflag "B"(= tflag "D")
(cond
((= lflag "A"
(command "TEXT" cflag locOFF1 ts anglin txt))
((= lflag "B"
(command "TEXT" cflag locOFF2 ts anglin txt))
); close cond
); close expresion
); close cond - prints text in proper location and format
); close expresion /= "L"
); close cond
(setq cont "N"
(prompt "To change variables type N and execute program again or
for"
(setq cont (strcase
(getstring " another with the same values type Y <default=N>:
"))
(if (null cont)(setq cont "N");do not repeat
);close while
(command "LAYER" "SET" save "" ;returns to original layer
'DONE;returns done at exit from program
);close defun
;*****************************************************************
;*****************************************************************
(defun COOR ()
;Wheatley/Williams Architects; 10/18/86
(defun toward (pivot rang rpt);pivot point, reference angle, ref. pt.
(setq d1 (/ (distance pivot rpt) 2))
(setq p1 (polar pivot (+ rang (* 0.5 pi)) d1))
(setq p2 (polar pivot (- rang (* 0.5 pi)) d1))
(if (< (distance p1 rpt)(distance p2 rpt))
(angle pivot p1)
(angle pivot p2)
));close if, close toward
(setvar "cmdecho" 0)
(setq hp (getpoint "\nHinge Point: ")
(setq sp (getpoint "\nStrike Point: ")
(setq sang (angle hp sp));strike angle
(setq width (distance hp sp))
(setq oface (getpoint "\nOpposite Face of Wall: ")
(setvar "blipmode" 0)
(command "line" hp "perp" oface ""
(setq ohp (getvar "lastpoint");opposite hinge point
(command "line" sp "perp" oface ""
(command "copy" "l" "" sp (polar sp sang 2))
(command "copy" "l" "" sp (polar sp (- sang pi)(+ width 4)))
(command "break" (polar hp sang (/ width 2)) "f" hp sp)
(command "break" (polar ohp sang (/ width 2)) "f" ohp (polar ohp sang width))
(setq dang (getangle hp "\nDoor Angle From Hinge Point: ")
(setq mang (+ (min dang sang)
(/ (setq diffang (abs (- dang sang))
) 2);difference angle, close divide
));close add, mid angle
(if (> diffang pi)(setq mang (+ mang pi)))
(setq amp (polar hp mang width))
(if (< (distance amp ohp)(distance amp hp));swing angle > 180
(progn (setq dang (angle sp hp))
(setq amp (polar hp (angle ohp hp) width))
(setq dstrt (polar hp (angle ohp hp) 2)));then
(setq dstrt (polar hp (toward hp dang sp) 2));else
);close if
(command "trace" 1 dstrt (polar dstrt dang width) ""
(command "arc" sp amp (polar hp dang width))
(setvar "cmdecho" 1)(setvar "blipmode" 1)
);close door
;
;
next one
;(C) 1989 * CADHELP! * 4390 E. COLLINS RD. *
;PORT ORCHARD, WA * 98366 * (206) 871-7672
;COGO1.LSP combines the individual line and arc notation programs
;into one
(vmon)
(setvar "cmdecho" 0)
(prompt "\nLoading .."
;set number of decimal places
(setq pr 2 (getvar "luprec")
(princ "."
;convert degrees to radians
(defun dtr (d)
(/ (* d pi) 180.0)
)
(princ "."
;convert radians to degrees
(defun rtd (r)
(/ (* r 180.0) pi)
)
(princ "."
;get input for arc notation
(defun ainp ()
(setq P1 (getpoint "\nFirst Point:"
P2 (getpoint P1"\nSecond Point:"
cp (osnap p1 "center"
ra (distance cp P1)
t1 "Text Height: <default = "
t2 " >: "
t3 (getvar "textsize")
(terpri)
(setq HT (getreal (strcat t1 (rtos t3 2 2) t2)))
(if (= HT nil)
(setq HT t3)
)
(setvar "textsize" ht)
)
(princ "."
;calculate arc length
(defun alnp ()
(setq B (polar P1 (angle P1 P2) (/ (distance P1 P2) 2))
BA (distance P1 cp)
BC (distance P1 P2)
AC (distance P2 cp)
S (/ (+ BC BA AC) 2)
mp (polar cp (angle cp B) ra)
)
(if (= (rtos ba 2 2) (rtos ac 2 2))
(progn
(setq A (angtos (* 2 (atan (sqrt (/ (* (- S BA) (- S BA))
(* S (- S BC)))))) 0 4))
(setq lentxt (* (/ (atof A) 360.0) (* pi 2 (distance P1 cp))))
)
(prompt "\nERROR: POINTS NOT EQUI-DISTANT FROM RADIUS POINT!!\n
OR PICK IN OPPOSITE SEQUENCE!"
)
(setq lentxt (rtos (abs lentxt) 2 pr))
(setq radtxt (rtos ra 2 pr))
)
(princ "."
;calculate delta and format it for printing
(defun adlt ()
(setq A (atof A)
D (fix A)
M (* 60 (- A D))
S (* 60 (- M (fix M)))
M (FIX M))
(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))
(setq deltatxt (strcat "DELTA = "
(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)) "''"
))
)
(princ "."
;routine to print data along a curve
(defun arctext ()
(setvar "blipmode" 0)
(setq st data
ra (distance cp P1)
mp (polar cp (angle cp B) ra)
sl (strlen st)
fd (* (/ (* ht sl) (* 2.0 pi side)) 360.0)
fa (/ (* fd pi) 180.0)
ai (/ fa sl)
a0 (+ (angle cp mp) (* di (/ fa 2.0)))
nn 0
ss1 (ssadd)
)
(while (< nn sl)
(setq ap (- a0 (* di (* nn ai)))
pt (polar cp ap side)
tr (- (/ (* 180.0 ap) pi) (* di 90.0))
nn (+ nn 1 )
)
(command "text" "c" pt ht tr (substr st nn 1))
(setq ss1 (ssadd (entlast) ss1))
)
(setq st st)
(setvar "blipmode" 1)
)
(princ "."
;puts arc length outside of arc
(defun CRVLNTHA ()
(ainp)
(alnp)
(setq di nil)
(setq data (strcat "L=" lentxt))
(if (< (cadr mp) (cadr cp))
(progn (setq di -1)
(setq side (+ ra (* ht 1.5)))
)
)
(if (>= (cadr mp) (cadr cp))
(progn (setq di 1)
(setq side (+ ra (/ ht 2)))
)
)
(arctext)
)
(princ "."
;puts arc length on radius point side of arc
(defun CRVLNTHB ()
(ainp)
(alnp)
(setq di nil)
(setq data (strcat "L=" lentxt))
(if (< (cadr mp) (cadr cp))
(progn (setq di -1)
(setq side (- ra (/ ht 2)))
)
)
(if (>= (cadr mp) (cadr cp))
(progn (setq di 1)
(setq side (- ra (* 1.5 ht)))
)
)
(arctext)
)
(princ "."
;input for line notations
(defun lli ()
(setq P1 (getpoint "\nFirst Point:"
P2 (getpoint p1"\nSecond Point:"
pangle (angle p1 p2)
mangle (angle p2 p1)
t1 "Text Height: <default = "
t2 " >: "
t3 (getvar "textsize"
)
(terpri)
(setq HT (getreal (strcat t1 (rtos t3 2 2) t2)))
(if (= HT nil)
(setq HT t3)
)
(setvar "textsize" ht)
)
(princ "."
;determine if bearings are true NORTH-SOUTH or EAST-WEST
(defun fszip ()
(if (and
(= (car P1) (car P2))
(< (cadr P1) (cadr P2))
)
(setq txtbng "NORTH"
)
(if (and
(< (car P1) (car P2))
(= (cadr P1) (cadr P2))
)
(setq txtbng "EAST"
)
(if (and
(= (car P1) (car P2))
(> (cadr P1) (cadr P2))
)
(setq txtbng "SOUTH"
)
(if (and
(> (car P1) (car P2))
(= (cadr P1) (cadr P2))
)
(setq txtbng "WEST"
)
)
(princ "."
;place text on top of line
(defun ltt ()
(if (> (car p2) (car p1))
(progn
(setq midpt (polar P1 pangle (/ (distance P1 P2) 2))
angp (+ pangle (dtr 90))
P3 (polar midpt angp ht)
)
)
(progn
(setq midpt (polar P2 mangle (/ (distance P1 P2) 2))
angp (+ mangle (dtr 90))
P3 (polar midpt angp ht)
)
)
)
)
(princ "."
;calculate bearing from coordinates and format for printing
(defun bearing ()
(setq O (- (car P2) (car P1))
T (- (cadr P2) (cadr P1))
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)
)
(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 P2) (cadr P1)) (setq G "S" (setq G "N")
(if (< (car P1) ( car P2)) (setq H "E" (setq H "W")
(setq txtbng (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
))
)
(princ "."
;bearing and distance side by side on top of line
(defun BRNGDSTA ()
(lli)
(ltt)
(if (or
(= 0 (- (car P1) (car P2)))
(= 0 (- (cadr P1) (cadr P2)))
)
(fszip)
(bearing)
)
(if (> (car p2) (car p1))
(command "text" "m" P3 ht (rtd pangle) (strcat txtbng
" " (rtos (distance P1 P2) 2 pr)))
(command "text" "m" P3 ht (rtd mangle) (strcat txtbng
" " (rtos (distance P1 P2) 2 pr)))
)
)
(princ "."
;bearing on top, distance on bottom of a line
(defun BOD ()
(lli)
(ltt)
(if (or
(= 0 (- (car P1) (car P2)))
(= 0 (- (cadr P1) (cadr P2)))
)
(fszip)
(bearing)
)
(if (> (car p2) (car p1))
(progn
(command "text" "m" P3 ht (rtd pangle) txtbng)
(setq angm (- pangle (dtr 90)))
(setq P3 (polar midpt angm ht))
(command "text" "m" P3 ht (rtd pangle) (rtos (distance P1 P2) 2 pr))
)
(progn
(command "text" "m" P3 ht (rtd mangle) txtbng)
(setq angm (- mangle (dtr 90)))
(setq P3 (polar midpt angm ht))
(command "text" "m" P3 ht (rtd mangle) (rtos (distance P1 P2) 2 pr))
)
)
)
(princ "."
;distance on top, bearing on bottom of a line
(defun DOB ()
(lli)
(ltt)
(if (or
(= 0 (- (car P1) (car P2)))
(= 0 (- (cadr P1) (cadr P2)))
)
(fszip)
(bearing)
)
(if (> (car p2) (car p1))
(progn
(command "text" "m" P3 ht (rtd pangle) (rtos (distance P1 P2) 2 pr))
(setq angm (- pangle (dtr 90)))
(setq P3 (polar midpt angm ht))
(command "text" "m" P3 ht (rtd pangle) txtbng)
)
(progn
(command "text" "m" P3 ht (rtd mangle) (rtos (distance P1 P2) 2 pr))
(setq angm (- mangle (dtr 90)))
(setq P3 (polar midpt angm ht))
(command "text" "m" P3 ht (rtd mangle) txtbng)
)
)
)
(princ "."
;distance only above the line
(defun DSTONLYA ()
(lli)
(ltt)
(command "text" "m" P3 ht (rtd pangle) (rtos (distance
P1 P2) 2 pr))
)
(princ "."
;distance only below the line
(defun DSTONLYB ()
(lli)
(ltt)
(setq angm (- pangle (dtr 90)))
(setq P3 (polar midpt angm ht))
(command "text" "m" P3 ht (rtd pangle) (rtos (distance
P1 P2) 2 pr))
)
(princ "."
;bearing only above the line
(defun BNGONLYA ()
(lli)
(ltt)
(if (or
(= 0 (- (car P1) (car P2)))
(= 0 (- (cadr P1) (cadr P2)))
)
(fszip)
(bearing)
)
(if (> (car p2) (car p1))
(command "text" "m" P3 ht (rtd pangle) txtbng)
(command "text" "m" P3 ht (rtd mangle) txtbng)
)
)
(princ "."
;bearing only below the line
(defun BNGONLYB ()
(lli)
(ltt)
(if (or
(= 0 (- (car P1) (car P2)))
(= 0 (- (cadr P1) (cadr P2)))
)
(fszip)
(bearing)
)
(if (> (car p2) (car p1))
(progn
(setq angm (- pangle (dtr 90)))
(setq P3 (polar midpt angm ht))
(command "text" "m" P3 ht (rtd pangle) txtbng)
)
(progn
(setq angm (- mangle (dtr 90)))
(setq P3 (polar midpt angm ht))
(command "text" "m" P3 ht (rtd mangle) txtbng)
)
)
)
(princ "."
;calc's curve data (delta,radius,length) and puts on dwg
(defun CURVDATA ()
(ainp)
(alnp)
(adlt)
(setq P5 (getpoint "\nWhere do you want curve number ?")
(command "circle" P5 (* 1.5 ht))
(setq CN (getstring "\nCurve number :")
(command "text" "m" P5 ht 0 CN)
(setq P4 (getpoint "\nWhere do you want curve data ?")
(command "text" P4 ht 0 deltatxt)
(command "text" "" (strcat "RADIUS = " radtxt))
(command "text" "" (strcat "LENGTH = " lentxt))
(setq P5 (polar P4 (dtr 180) (* 2 ht)))
(command "circle" P5 (* 1.5 ht))
(command "text" "m" P5 ht 0 CN)
)
(princ "."
;bearing and distance side by side on bottom of line
(defun BRNGDSTB ()
(lli)
(ltt)
(if (or
(= 0 (- (car P1) (car P2)))
(= 0 (- (cadr P1) (cadr P2)))
)
(fszip)
(bearing)
)
(if (> (car p2) (car p1))
(progn
(setq angm (- pangle (dtr 90)))
(setq P3 (polar midpt angm ht))
(command "text" "m" P3 ht (rtd pangle) (strcat txtbng
" " (rtos (distance P1 P2) 2 pr)))
)
(progn
(setq angm (- mangle (dtr 90)))
(setq P3 (polar midpt angm ht))
(command "text" "m" P3 ht (rtd mangle) (strcat txtbng
" " (rtos (distance P1 P2) 2 pr)))
)
)
)
(defun c:cogo1 ()
(prompt "ok"
)
(princ)
LASTONE
; DIMLINE.LSP
; Adds length and/or angle as text for any two specified points.
; John Meisl 1991 November
(vmon) ; Virtual Function Pager Command
(defun CL ( / AB AD DISP PRE PT1 PT2 TDIST D )
(load "TEXTMOD"
(load "RTD"
(load "DTR"
(setvar "cmdecho" 0)
(setq OO (getvar "OSMODE")
(setq AB (getvar "ANGBASE")
(setq AD (getvar "ANGDIR")
(setq DISP ""
(while (= DISP ""
(setq DISP (strcase (getstring "Display D)istance, A)ngle or B)oth? : "))
)
(command "osnap" "end"
(setq PT1 (getpoint "\nPick first end point : ")
(while (/= PT1 nil)
(setq PT2 (getpoint PT1 "\nPick second end point : ")
(setq TDIST (rtos (distance PT1 PT2)))
(if (= AD 0)
(setq ANG (RTD (- AB (angle PT1 PT2))))
(setq ANG (RTD (+ AB (angle PT2 PT1))))
)
(setq TANG (angtos (angle PT1 PT2)))
(command "osnap" "none"
(setq TIP (getpoint "Pick insertion point for middle of text : ")
(cond
((= DISP "D"
(setq D TDIST))
((= DISP "A"
(setq D TANG))
((= DISP "B"
(setq D (strcat TDIST " " TANG)))
)
(command "text" "middle" TIP ANG "X"
(TEXTMOD D)
(command "osnap" "end"
(setq PT1 (getpoint "\nPick first end point : ")
)
(setvar "OSMODE" OO)
)
(setq PT1 "Enter DL to restart"
;program to note the bearing and distance between two points
;or the two ends of a line for Architects and Civil Engineers
;who don't have a cogo package and need to label boundary lines
;you can change the layer names, colors, and linetypes as you
;see fit
;
(defun C:CLEAN (); delete this function if you already have it loaded
(setq atomlist (member 'C:CLEAN atomlist));'DONE
);close defun
;functions half,spcg,spc,rtd,and convert are all utility functions
;to clean up the main program
;
(defun half (pi) ;returns 90 degrees in radians
(/ pi 2))
(defun spcg (ts) ;returns line spacing = 1/2 text size
(/ ts 2))
(defun spc (ts) ;returns offset from end of line = 2 x text size
(* ts 2))
(defun rtd (ang / ) ;converts radians to degrees
(* (/ ang pi) 180.0))
(defun convert (angtext) ;replaces d in text string with degrees
;symbol
(setq newtext "" test nil)
(setq L (strlen angtext))
(setq n 4)
(while (<= n L)
(setq ds (substr angtext n 1))
(if (= ds "d"
(progn
(setq ds "%%d"
(setq test T)
(setq newtext (strcat (substr angtext 1 (1- n))
ds (substr angtext (1+ n))))
);close progn
);close if
(if (= T test)(setq n (1+ L)) (setq n (1+ n)))
);close while
(setq angtext newtext)
);close defun
;
;main program begins here
;cflag for centered, right justified, or left justified text location
;lflag for above or below line text location
;tflag for text content - bearing only, distance only, or both
;
(defun C
ISTNOTE ()(graphscr)
(setq save (getvar "CLAYER"
);saves current layer(setvar "CMDECHO" 0);turns off command echoing to screen
(setq cont "Y"
;initializes value for repeating program(setq pstring (strcat "Text height <default="
(rtos (getvar "TEXTSIZE"
2 2) ">: ");sets default value for text height prompt
(command "LAYER" "MAKE" "BRG_DIST" "COLOR" "RED" "BRG_DIST" ""
;places text on new layer brg_dist with color=red
;a layer ltype command could be added here if desired
(setq tflag (strcase
(getstring "Bearing only, Distance only, or both - Type B, D, or BD
<default=BD>: "
))(if (= tflag ""
(setq tflag "BD");default(if (or (= tflag "B"
(= tflag "D")(progn
(setq lflag (strcase
(getstring "Locate text A, or B line <default=A>: "
))(if (= lflag ""
(setq lflag "A"));close progn - then clause of if statement
(progn
(setq lflag (strcase
(getstring "Locate text A, B, or AB line
<default=AB>: "
))(if (= lflag ""
(setq lflag "AB"));close progn - else clause of if statement
);close if
(setq cflag (strcase
(getstring "Right end, Centered, or Left end of line
<default=C>: "
))(if (= cflag ""
(setq cflag "C");default(setq ts (getdist pstring));sets text height
(if (= ts nil) (setq ts (getvar "TEXTSIZE"
));default(setvar "OSMODE" 9)
(while (= cont "Y"
;repeats with same values(setq pt1 (osnap (getpoint "First point: "
"node,endpoint")(setq pt2 (osnap (getpoint "Second point: "
"node,endpoint")(setq dist (distance pt1 pt2))
(setq ang (angle pt1 pt2))
(setq disttext (strcat (rtos dist 2 2) "'"
);adds feet symbol to ;string
(setq angtext (angtos ang 4 4));converts angle to surveyor units
(if (> (strlen angtext) 6)(setq angtext (convert angtext)));see
;convert
(if (or (= lflag "A"
(= lflag "B")(progn
(cond
((= tflag "BD"
(setq txt (strcat angtext " " disttext)))
((= tflag "B"
(setq txt angtext))((= tflag "D"
(setq txt disttext)));close cond
);close progn
);close if
(cond
((= cflag "L"
(setq loc (polar pt1 ang (spc ts))))
((= cflag "C"
(setq loc (polar pt1 ang (/ dist 2))))
((= cflag "R"
(setq loc (polar pt1 ang (- dist (spc ts)))))
);close cond - starting location for text
(setq locOFF1 (polar loc (+ ang (half pi)) (spcg ts))); above
;line
(setq locOFF2 (polar loc (- ang (half pi)) (* (spcg ts) 3)));
;below line
(setq anglin (rtd ang)); sets text angle to proper units
(cond
((= cflag "L"
(cond
((= tflag "BD"
(cond
((= lflag "AB"
(command "TEXT" locOFF1 ts anglin angtext)
(command "TEXT" locOFF2 ts anglin disttext))
((= lflag "A"
(command "TEXT" locOFF1 ts anglin txt))
((= lflag "B"
(command "TEXT" locOFF2 ts anglin txt))
); close cond
); close expresion
((or (= tflag "B"
(= tflag "D")(cond
((= lflag "A"
(command "TEXT" locOFF1 ts anglin txt))
((= lflag "B"
(command "TEXT" locOFF2 ts anglin txt))
); close cond
); close expresion
); close cond - prints text in proper location and format
); close expresion = "L"
((/= cflag "L"
(cond
((= tflag "BD"
(cond
((= lflag "AB"
(command "TEXT" cflag locOFF1 ts anglin angtext)
(command "TEXT" cflag locOFF2 ts anglin
disttext))
((= lflag "A"
(command "TEXT" cflag locOFF1 ts anglin txt))
((= lflag "B"
(command "TEXT" cflag locOFF2 ts anglin txt))
); close cond
); close expresion
((or (= tflag "B"
(= tflag "D")(cond
((= lflag "A"
(command "TEXT" cflag locOFF1 ts anglin txt))
((= lflag "B"
(command "TEXT" cflag locOFF2 ts anglin txt))
); close cond
); close expresion
); close cond - prints text in proper location and format
); close expresion /= "L"
); close cond
(setq cont "N"
(prompt "To change variables type N and execute program again or
for"
(setq cont (strcase
(getstring " another with the same values type Y <default=N>:
"
))(if (null cont)(setq cont "N"
);do not repeat);close while
(command "LAYER" "SET" save ""
;returns to original layer'DONE;returns done at exit from program
);close defun
;*****************************************************************
;*****************************************************************
(defun C
OOR ();Wheatley/Williams Architects; 10/18/86
(defun toward (pivot rang rpt);pivot point, reference angle, ref. pt.
(setq d1 (/ (distance pivot rpt) 2))
(setq p1 (polar pivot (+ rang (* 0.5 pi)) d1))
(setq p2 (polar pivot (- rang (* 0.5 pi)) d1))
(if (< (distance p1 rpt)(distance p2 rpt))
(angle pivot p1)
(angle pivot p2)
));close if, close toward
(setvar "cmdecho" 0)
(setq hp (getpoint "\nHinge Point: "
)(setq sp (getpoint "\nStrike Point: "
)(setq sang (angle hp sp));strike angle
(setq width (distance hp sp))
(setq oface (getpoint "\nOpposite Face of Wall: "
)(setvar "blipmode" 0)
(command "line" hp "perp" oface ""
(setq ohp (getvar "lastpoint"
);opposite hinge point(command "line" sp "perp" oface ""
(command "copy" "l" "" sp (polar sp sang 2))
(command "copy" "l" "" sp (polar sp (- sang pi)(+ width 4)))
(command "break" (polar hp sang (/ width 2)) "f" hp sp)
(command "break" (polar ohp sang (/ width 2)) "f" ohp (polar ohp sang width))
(setq dang (getangle hp "\nDoor Angle From Hinge Point: "
)(setq mang (+ (min dang sang)
(/ (setq diffang (abs (- dang sang))
) 2);difference angle, close divide
));close add, mid angle
(if (> diffang pi)(setq mang (+ mang pi)))
(setq amp (polar hp mang width))
(if (< (distance amp ohp)(distance amp hp));swing angle > 180
(progn (setq dang (angle sp hp))
(setq amp (polar hp (angle ohp hp) width))
(setq dstrt (polar hp (angle ohp hp) 2)));then
(setq dstrt (polar hp (toward hp dang sp) 2));else
);close if
(command "trace" 1 dstrt (polar dstrt dang width) ""
(command "arc" sp amp (polar hp dang width))
(setvar "cmdecho" 1)(setvar "blipmode" 1)
);close door
;
;
next one
;(C) 1989 * CADHELP! * 4390 E. COLLINS RD. *
;PORT ORCHARD, WA * 98366 * (206) 871-7672
;COGO1.LSP combines the individual line and arc notation programs
;into one
(vmon)
(setvar "cmdecho" 0)
(prompt "\nLoading .."
;set number of decimal places
(setq pr 2 (getvar "luprec"
)(princ "."
;convert degrees to radians
(defun dtr (d)
(/ (* d pi) 180.0)
)
(princ "."
;convert radians to degrees
(defun rtd (r)
(/ (* r 180.0) pi)
)
(princ "."
;get input for arc notation
(defun ainp ()
(setq P1 (getpoint "\nFirst Point:"
P2 (getpoint P1"\nSecond Point:"
cp (osnap p1 "center"
ra (distance cp P1)
t1 "Text Height: <default = "
t2 " >: "
t3 (getvar "textsize"
)(terpri)
(setq HT (getreal (strcat t1 (rtos t3 2 2) t2)))
(if (= HT nil)
(setq HT t3)
)
(setvar "textsize" ht)
)
(princ "."
;calculate arc length
(defun alnp ()
(setq B (polar P1 (angle P1 P2) (/ (distance P1 P2) 2))
BA (distance P1 cp)
BC (distance P1 P2)
AC (distance P2 cp)
S (/ (+ BC BA AC) 2)
mp (polar cp (angle cp B) ra)
)
(if (= (rtos ba 2 2) (rtos ac 2 2))
(progn
(setq A (angtos (* 2 (atan (sqrt (/ (* (- S BA) (- S BA))
(* S (- S BC)))))) 0 4))
(setq lentxt (* (/ (atof A) 360.0) (* pi 2 (distance P1 cp))))
)
(prompt "\nERROR: POINTS NOT EQUI-DISTANT FROM RADIUS POINT!!\n
OR PICK IN OPPOSITE SEQUENCE!"
)
(setq lentxt (rtos (abs lentxt) 2 pr))
(setq radtxt (rtos ra 2 pr))
)
(princ "."
;calculate delta and format it for printing
(defun adlt ()
(setq A (atof A)
D (fix A)
M (* 60 (- A D))
S (* 60 (- M (fix M)))
M (FIX M))
(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))
(setq deltatxt (strcat "DELTA = "
(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)) "''"
))
)
(princ "."
;routine to print data along a curve
(defun arctext ()
(setvar "blipmode" 0)
(setq st data
ra (distance cp P1)
mp (polar cp (angle cp B) ra)
sl (strlen st)
fd (* (/ (* ht sl) (* 2.0 pi side)) 360.0)
fa (/ (* fd pi) 180.0)
ai (/ fa sl)
a0 (+ (angle cp mp) (* di (/ fa 2.0)))
nn 0
ss1 (ssadd)
)
(while (< nn sl)
(setq ap (- a0 (* di (* nn ai)))
pt (polar cp ap side)
tr (- (/ (* 180.0 ap) pi) (* di 90.0))
nn (+ nn 1 )
)
(command "text" "c" pt ht tr (substr st nn 1))
(setq ss1 (ssadd (entlast) ss1))
)
(setq st st)
(setvar "blipmode" 1)
)
(princ "."
;puts arc length outside of arc
(defun CRVLNTHA ()
(ainp)
(alnp)
(setq di nil)
(setq data (strcat "L=" lentxt))
(if (< (cadr mp) (cadr cp))
(progn (setq di -1)
(setq side (+ ra (* ht 1.5)))
)
)
(if (>= (cadr mp) (cadr cp))
(progn (setq di 1)
(setq side (+ ra (/ ht 2)))
)
)
(arctext)
)
(princ "."
;puts arc length on radius point side of arc
(defun CRVLNTHB ()
(ainp)
(alnp)
(setq di nil)
(setq data (strcat "L=" lentxt))
(if (< (cadr mp) (cadr cp))
(progn (setq di -1)
(setq side (- ra (/ ht 2)))
)
)
(if (>= (cadr mp) (cadr cp))
(progn (setq di 1)
(setq side (- ra (* 1.5 ht)))
)
)
(arctext)
)
(princ "."
;input for line notations
(defun lli ()
(setq P1 (getpoint "\nFirst Point:"
P2 (getpoint p1"\nSecond Point:"
pangle (angle p1 p2)
mangle (angle p2 p1)
t1 "Text Height: <default = "
t2 " >: "
t3 (getvar "textsize"
)
(terpri)
(setq HT (getreal (strcat t1 (rtos t3 2 2) t2)))
(if (= HT nil)
(setq HT t3)
)
(setvar "textsize" ht)
)
(princ "."
;determine if bearings are true NORTH-SOUTH or EAST-WEST
(defun fszip ()
(if (and
(= (car P1) (car P2))
(< (cadr P1) (cadr P2))
)
(setq txtbng "NORTH"
)
(if (and
(< (car P1) (car P2))
(= (cadr P1) (cadr P2))
)
(setq txtbng "EAST"
)
(if (and
(= (car P1) (car P2))
(> (cadr P1) (cadr P2))
)
(setq txtbng "SOUTH"
)
(if (and
(> (car P1) (car P2))
(= (cadr P1) (cadr P2))
)
(setq txtbng "WEST"
)
)
(princ "."
;place text on top of line
(defun ltt ()
(if (> (car p2) (car p1))
(progn
(setq midpt (polar P1 pangle (/ (distance P1 P2) 2))
angp (+ pangle (dtr 90))
P3 (polar midpt angp ht)
)
)
(progn
(setq midpt (polar P2 mangle (/ (distance P1 P2) 2))
angp (+ mangle (dtr 90))
P3 (polar midpt angp ht)
)
)
)
)
(princ "."
;calculate bearing from coordinates and format for printing
(defun bearing ()
(setq O (- (car P2) (car P1))
T (- (cadr P2) (cadr P1))
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)
)
(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 P2) (cadr P1)) (setq G "S"
(setq G "N")(if (< (car P1) ( car P2)) (setq H "E"
(setq H "W")(setq txtbng (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
))
)
(princ "."
;bearing and distance side by side on top of line
(defun BRNGDSTA ()
(lli)
(ltt)
(if (or
(= 0 (- (car P1) (car P2)))
(= 0 (- (cadr P1) (cadr P2)))
)
(fszip)
(bearing)
)
(if (> (car p2) (car p1))
(command "text" "m" P3 ht (rtd pangle) (strcat txtbng
" " (rtos (distance P1 P2) 2 pr)))
(command "text" "m" P3 ht (rtd mangle) (strcat txtbng
" " (rtos (distance P1 P2) 2 pr)))
)
)
(princ "."
;bearing on top, distance on bottom of a line
(defun BOD ()
(lli)
(ltt)
(if (or
(= 0 (- (car P1) (car P2)))
(= 0 (- (cadr P1) (cadr P2)))
)
(fszip)
(bearing)
)
(if (> (car p2) (car p1))
(progn
(command "text" "m" P3 ht (rtd pangle) txtbng)
(setq angm (- pangle (dtr 90)))
(setq P3 (polar midpt angm ht))
(command "text" "m" P3 ht (rtd pangle) (rtos (distance P1 P2) 2 pr))
)
(progn
(command "text" "m" P3 ht (rtd mangle) txtbng)
(setq angm (- mangle (dtr 90)))
(setq P3 (polar midpt angm ht))
(command "text" "m" P3 ht (rtd mangle) (rtos (distance P1 P2) 2 pr))
)
)
)
(princ "."
;distance on top, bearing on bottom of a line
(defun DOB ()
(lli)
(ltt)
(if (or
(= 0 (- (car P1) (car P2)))
(= 0 (- (cadr P1) (cadr P2)))
)
(fszip)
(bearing)
)
(if (> (car p2) (car p1))
(progn
(command "text" "m" P3 ht (rtd pangle) (rtos (distance P1 P2) 2 pr))
(setq angm (- pangle (dtr 90)))
(setq P3 (polar midpt angm ht))
(command "text" "m" P3 ht (rtd pangle) txtbng)
)
(progn
(command "text" "m" P3 ht (rtd mangle) (rtos (distance P1 P2) 2 pr))
(setq angm (- mangle (dtr 90)))
(setq P3 (polar midpt angm ht))
(command "text" "m" P3 ht (rtd mangle) txtbng)
)
)
)
(princ "."
;distance only above the line
(defun DSTONLYA ()
(lli)
(ltt)
(command "text" "m" P3 ht (rtd pangle) (rtos (distance
P1 P2) 2 pr))
)
(princ "."
;distance only below the line
(defun DSTONLYB ()
(lli)
(ltt)
(setq angm (- pangle (dtr 90)))
(setq P3 (polar midpt angm ht))
(command "text" "m" P3 ht (rtd pangle) (rtos (distance
P1 P2) 2 pr))
)
(princ "."
;bearing only above the line
(defun BNGONLYA ()
(lli)
(ltt)
(if (or
(= 0 (- (car P1) (car P2)))
(= 0 (- (cadr P1) (cadr P2)))
)
(fszip)
(bearing)
)
(if (> (car p2) (car p1))
(command "text" "m" P3 ht (rtd pangle) txtbng)
(command "text" "m" P3 ht (rtd mangle) txtbng)
)
)
(princ "."
;bearing only below the line
(defun BNGONLYB ()
(lli)
(ltt)
(if (or
(= 0 (- (car P1) (car P2)))
(= 0 (- (cadr P1) (cadr P2)))
)
(fszip)
(bearing)
)
(if (> (car p2) (car p1))
(progn
(setq angm (- pangle (dtr 90)))
(setq P3 (polar midpt angm ht))
(command "text" "m" P3 ht (rtd pangle) txtbng)
)
(progn
(setq angm (- mangle (dtr 90)))
(setq P3 (polar midpt angm ht))
(command "text" "m" P3 ht (rtd mangle) txtbng)
)
)
)
(princ "."
;calc's curve data (delta,radius,length) and puts on dwg
(defun CURVDATA ()
(ainp)
(alnp)
(adlt)
(setq P5 (getpoint "\nWhere do you want curve number ?"
)(command "circle" P5 (* 1.5 ht))
(setq CN (getstring "\nCurve number :"
)(command "text" "m" P5 ht 0 CN)
(setq P4 (getpoint "\nWhere do you want curve data ?"
)(command "text" P4 ht 0 deltatxt)
(command "text" "" (strcat "RADIUS = " radtxt))
(command "text" "" (strcat "LENGTH = " lentxt))
(setq P5 (polar P4 (dtr 180) (* 2 ht)))
(command "circle" P5 (* 1.5 ht))
(command "text" "m" P5 ht 0 CN)
)
(princ "."
;bearing and distance side by side on bottom of line
(defun BRNGDSTB ()
(lli)
(ltt)
(if (or
(= 0 (- (car P1) (car P2)))
(= 0 (- (cadr P1) (cadr P2)))
)
(fszip)
(bearing)
)
(if (> (car p2) (car p1))
(progn
(setq angm (- pangle (dtr 90)))
(setq P3 (polar midpt angm ht))
(command "text" "m" P3 ht (rtd pangle) (strcat txtbng
" " (rtos (distance P1 P2) 2 pr)))
)
(progn
(setq angm (- mangle (dtr 90)))
(setq P3 (polar midpt angm ht))
(command "text" "m" P3 ht (rtd mangle) (strcat txtbng
" " (rtos (distance P1 P2) 2 pr)))
)
)
)
(defun c:cogo1 ()
(prompt "ok"
)
(princ)
LASTONE
; DIMLINE.LSP
; Adds length and/or angle as text for any two specified points.
; John Meisl 1991 November
(vmon) ; Virtual Function Pager Command
(defun C
L ( / AB AD DISP PRE PT1 PT2 TDIST D )(load "TEXTMOD"
(load "RTD"
(load "DTR"
(setvar "cmdecho" 0)
(setq OO (getvar "OSMODE"
)(setq AB (getvar "ANGBASE"
)(setq AD (getvar "ANGDIR"
)(setq DISP ""
(while (= DISP ""
(setq DISP (strcase (getstring "Display D)istance, A)ngle or B)oth? : "
)))
(command "osnap" "end"
(setq PT1 (getpoint "\nPick first end point : "
)(while (/= PT1 nil)
(setq PT2 (getpoint PT1 "\nPick second end point : "
)(setq TDIST (rtos (distance PT1 PT2)))
(if (= AD 0)
(setq ANG (RTD (- AB (angle PT1 PT2))))
(setq ANG (RTD (+ AB (angle PT2 PT1))))
)
(setq TANG (angtos (angle PT1 PT2)))
(command "osnap" "none"
(setq TIP (getpoint "Pick insertion point for middle of text : "
)(cond
((= DISP "D"
(setq D TDIST))
((= DISP "A"
(setq D TANG))
((= DISP "B"
(setq D (strcat TDIST " " TANG)))
)
(command "text" "middle" TIP ANG "X"
(TEXTMOD D)
(command "osnap" "end"
(setq PT1 (getpoint "\nPick first end point : "
))
(setvar "OSMODE" OO)
)
(setq PT1 "Enter DL to restart"
- Status
Similar threads
