LISP Rountines

REPOST FROM 7/29/04

I've just recently re-entered the AutoCad society after several years and
many things have been forgotten. As time flies by, as it normally does, I
am in need of a LISP that I do not have the time to research and write.
Therefore, I'm requesting if someone has a routine that they could share
with me concerning the following areas:

All of these are text to be displayed inside or near a titleblock
NORTH ARROW- To be displayed according to the UCS of viewport.
SCALE - To be displayed according to the UCS of viewport.
PROJECT NAME - To reflect the name of project given on the cover
sheet
DRAWING NAME - To reflect the layout tab name
DATE - To reflect the date of project given on the cover sheet
DWG NAME - To reflect the actual Windows file name, minus the
".dwg"
# OF SHEETS - To reflect the total number of LAYOUTS of all
dwgs in the project folder
JOB # - To reflect the parent folder name of project folder

If anyone has any routines described here please reply or contact me at:

 

Attached is a north arrow lsp routine.



; NARW.LSP
; DRAWS NORTH ARROW/GRID ARROW AT ANY SPECIFIED DIRECTION
(defun c:narw ( / ds g:ts p1 angr p2 ts txt p3 p4 p6 p5l p7lp8l p5r p7r p8r
garw dir angg p2g p3g p4g p6g p5gl p5gr p7gl p7gr p8gl p8gr p2gl
pgl pgr p2l p2r ppl ppr txt1 txt2)
(graphscr)
;(setvar "dimscale" 1)
(prompt "Draws a North Arrow and Grid Arrow at any specified direction: ")
(terpri)
(setq ds (getvar "dimscale")
g:ts (* 0.125 ds)
p1 (getpoint "\nPick/Enter location of North Arrow: ")
angr (getangle p1 "\nEnter angle of North Arrow (East 0 degrees-you MUST enter a No.): ")
p2 (polar p1 angr (* 1.0625 ds))
ts (* 0.3125 ds)
txt "N"
p3 (polar p1 (+ angr pi)(* 1.0625 ds))
p4 (polar p1 angr (* 0.5625 ds))
p6 (polar p3 angr (* 0.50 ds))
)
(if (<= (car p1)(car p2))
(progn
(setq p5l (polar p4 (+ angr (* 0.75 pi))
(* (/ 0.09375 (cos (/ pi 4.0))) ds))
p7l (polar p6 (+ angr (* 0.75 pi))
(* (/ 0.0625 (cos (/ pi 4.0))) ds))
p8l (polar p7l (+ angr pi)(* 0.50 ds))
)
)
)
(if (> (car p1)(car p2))
(progn
(setq p5r (polar p4 (- angr (* 0.75 pi))
(* (/ 0.09375 (cos (/ pi 4.0))) ds))
p7r (polar p6 (- angr (* 0.75 pi))
(* (/ 0.0625 (cos (/ pi 4.0))) ds))
p8r (polar p7r (+ angr pi)(* 0.50 ds))
)
)
)
(cond
(
(and (>= angr 0)(<= angr (/ pi 2.0)))
(command "-layer" "s" "2" ""
"line" p2 p3 "" "solid" p4 p5l p2 "" ""
"solid" p3 p8l p6 p7l "" "style" "COMPLEX" "COMPLEX" "0" "" "" "" "" ""
"text" "m" p1 ts (rtd (angle p1 p2)) txt
"style" "romans" "" "" "" "" "" "")
)
)
(cond
(
(and (> angr (/ pi 2.0))(<= angr pi))
(command "-layer" "s" "2" ""
"line" p2 p3 "" "solid" p4 p5r p2 "" ""
"solid" p3 p8r p6 p7r ""
"style" "COMPLEX" "COMPLEX" "0" "" "" "" "" ""
"text" "m" p1 ts (rtd (angle p2 p1)) txt
"style" "romans" "" "" "" "" "" "")
)

)
(cond
(
(and (> angr pi)(< angr (* 1.5 pi)))
(command "-layer" "s" "2" ""
"line" p2 p3 "" "solid" p4 p2 p5r "" ""
"solid" p8r p3 p7r p6 ""
"style" "COMPLEX" "COMPLEX" "0" "" "" "" "" ""
"text" "m" p1 ts (rtd (angle p2 p1)) txt
"style" "romans" "" "" "" "" "" "" "")
)
)
(cond
(
(and (>= angr (* 1.5 pi))(< angr (* 2 pi)))
(command "-layer" "s" "2" ""
"line" p2 p3 "" "solid" p4 p2 p5l "" ""
"solid" p8l p3 p7l p6 ""
"style" "COMPLEX" "COMPLEX" "0" "" "" "" "" ""
"text" "m" p1 ts (rtd (angle p1 p2)) txt
"style" "romans" "" "" "" "" "" "")
)
)
(initget "Y N")
(setq garw (getkword "\nDo you want to show a Grid Arrow ? Yes or < No >: "))
(if (null garw)(setq garw "N"))
(if (= garw "Y")(c:narwg))
(princ)
)
;
(defun c:narwg ()
(progn
(initget 1 "L R")
(setq dir
(getkword "\nEnter direction of Grid Arrow from North Arrow <L/R>: "))
(initget 1)
(setq angg (getangle "\nEnter Grid Arrow rotation angle from North Arrow: "))
(if (= dir "L")(setq angrg (+ angr angg)))
(if (= dir "R")(setq angrg (- angr angg)))
(setq p2g (polar p1 angrg (* 1.0625 ds))
p3g (polar p1 (+ angrg pi)(* 1.0625 ds))
p4g (polar p1 angrg (* 0.5625 ds))
p6g (polar p3g angrg (* 0.50 ds))
)
(if (<= (car p1)(car p2g))
(progn
(setq p5gl (polar p4g (+ angrg (* 0.75 pi))
(* (/ 0.09375 (cos (/ pi 4.0))) ds))
p5gr (polar p4g (+ (angle p1 p3g)(* 0.25 ds))
(* (/ 0.09375 (cos (/ pi 4.0))) ds))
p7gl (polar p6g (+ angrg (* 0.75 pi))
(* (/ 0.0625 (cos (/ pi 4.0))) ds))
p7gr (polar p6g (+ (angle p1 p3g)(* 0.25 ds))
(* (/ 0.0625 (cos (/ pi 4.0))) ds))
p8gl (polar p7gl (+ angrg pi)(* 0.50 ds))
p8gr (polar p7gr (+ angrg pi)(* 0.50 ds))
p2gl (polar p2g (- angrg (/ pi 2.0))(* 0.0625 ds))
pgl (polar (polar p2g (angle p1 p2g)(* 0.0625 ds))
(- (angle p1 p3g)(/ pi 2.0))(* 0.0625 ds))
pgr (polar (polar p2g (angle p1 p2g)(* 0.0625 ds))
(+ (angle p1 p3g)(/ pi 2.0))(* 0.1875 ds))
p2l (polar p1 (- angr (/ angg 2.0))(* 1.3125 ds))
p2r (polar p1 (+ angrg (/ angg 2.0))(* 1.3125 ds))
ppl (polar (polar p2 (angle p1 p2)(* 0.0625 ds))
(+ (angle p1 p2)(/ pi 2.0))(* 0.0625 ds))
ppr (polar (polar p2 (angle p1 p2)(* 0.0625 ds))
(- (angle p1 p2)(/ pi 2.0))(* 0.1875 ds))
)
)
)
(if (> (car p1)(car p2g))
(progn
(setq p5gr (polar p4g (+ (angle p1 p3g)(* 0.25 pi))
(* (/ 0.09375 (cos (/ pi 4.0))) ds))
p5gl (polar p4g (+ angrg (* 0.75 pi))
(* (/ 0.09375 (cos (/ pi 4.0))) ds))
p7gr (polar p6g (+ (angle p1 p3g)(* 0.25 pi))
(* (/ 0.0625 (cos (/ pi 4.0))) ds))
p7gl (polar p6g (+ angrg (* 0.75 pi))
(* (/ 0.0625 (cos (/ pi 4.0))) ds))
p8gr (polar p7gr (+ angrg pi)(* 0.50 ds))
p8gl (polar p7gl (+ angrg pi)(* 0.50 ds))
p2gr (polar p2g (+ angrg (/ pi 2.0))(* 0.1875 ds))
pgr (polar (polar p2g (angle p1 p2g)(* 0.0625 ds))
(- (angle p1 p2g)(/ pi 2.0))(* 0.0625 ds))
pgl (polar (polar p2g (angle p1 p2g)(* 0.0625 ds))
(+ (angle p1 p2g)(/ pi 2.0))(* 0.1875 ds))
p2l (polar p1 (+ angr (/ angg 2.0))(* 1.3125 ds))
p2r (polar p1 (+ angrg (/ angg 2.0))(* 1.3125 ds))
ppl (polar (polar p2 (angle p1 p2)(* 0.0625 ds))
(+ (angle p1 p2)(/ pi 2.0))(* 0.1875 ds))
ppr (polar (polar p2 (angle p1 p2)(* 0.0625 ds))
(- (angle p1 p2)(/ pi 2.0))(* 0.0625 ds))
)
)
)
(setq txt1 "GRID" txt2 "PLATFORM")
(command "-layer" "s" "2" "")
(if (= dir "L")
(progn
(cond
(
(and (>= angrg 0)(<= angrg (/ pi 2.0)))
(command "line" p4g p5gl p2g p3g p8gl p7gl p6g "")
(cond (
(and (>= angr 0)(<= angr (/ pi 2.0)))
(command "-layer" "s" "0" ""
"text" pgl g:ts (rtd angrg) txt1
"text" ppr g:ts (rtd angr) txt2))
)
(cond (
(and (> angr (/ pi 2.0))(<= angr pi))
(command "-layer" "s" "0" ""
"text" "r" pgl g:ts (rtd (angle p1 p3g)) txt1
"text" "r" ppr g:ts (rtd (angle p1 p3)) txt2))
)
(cond (
(and (> angr pi)(<= angr (* 1.5 pi)))
(command "-layer" "s" "0" ""
"text" "r" pgl g:ts (rtd (angle p1 p3g)) txt1
"text" "r" ppr g:ts (rtd (angle p1 p3)) txt2))
)
(cond (
(and (> angr (* 1.5 pi))(< angr (* 2.0 pi)))
(command "-layer" "s" "0" ""
"text" pgl g:ts (rtd angrg) txt1
"text" ppr g:ts (rtd angr) txt2))
)
)
)
(cond
(
(and (> angrg (/ pi 2.0))(<= angrg pi))
(command "line" p4g p5gr p2g p3g p8gr p7gr p6g "")
(cond (
(and (>= angr 0)(<= angr (/ pi 2.0)))
(command "-layer" "s" "0" ""
"text" "r" pgl g:ts (rtd angrg) txt1
"text" ppr g:ts (rtd angr) txt2))
)
(cond (
(and (> angr (/ pi 2.0))(<= angr pi))
(command "-layer" "s" "0" ""
"text" "r" pgl g:ts (rtd (angle p1 p3g)) txt1
"text" "r" ppr g:ts (rtd (angle p1 p3)) txt2))
)
(cond (
(and (> angr pi)(<= angr (* 1.5 pi)))
(command "-layer" "s" "0" ""
"text" "r" pgr g:ts (rtd (angle p1 p3g)) txt1
"text" "r" ppl g:ts (rtd (angle p1 p3)) txt2))
)
(cond (
(and (> angr (* 1.5 pi))(< angr (* 2.0 pi)))
(command "-layer" "s" "0" ""
"text" pgr "r" g:ts (rtd angrg) txt1
"text" ppl g:ts (rtd angr) txt2))
)
)
)
(cond
(
(and (> angrg pi)(< angrg (* 1.5 pi)))
(command "line" p4g p5gr p2g p3g p8gr p7gr p6g "")
(cond (
(and (>= angr 0)(<= angr (/ pi 2.0)))
(command "-layer" "s" "0" ""
"text" "r" pgl g:ts (rtd (angle p1 p3g)) txt1
"text" ppr g:ts (rtd angr) txt2))
)
(cond (
(and (> angr (/ pi 2.0))(<= angr pi))
(command "-layer" "s" "0" ""
"text" "r" pgl g:ts (rtd (angle p1 p3g)) txt1
"text" "r" ppr g:ts (rtd (angle p1 p3)) txt2))
)
(cond (
(and (> angr pi)(<= angr (* 1.5 pi)))
(command "-layer" "s" "0" ""
"text" "r" pgl g:ts (rtd (angle p1 p3g)) txt1
"text" "r" ppr g:ts (rtd (angle p1 p3)) txt2))
) (cond (
(and (> angr (* 1.5 pi))(< angr (* 2.0 pi)))
(command "-layer" "s" "0" ""
"text" pgr "r" g:ts (rtd (angle p1 p3g)) txt1
"text" ppl g:ts (rtd angr) txt2))
)
)
)
(cond
(
(and (>= angrg (* 1.5 pi))(< angrg (* 2 pi)))
(command "line" p4g p5gl p2g p3g p8gl p7gl p6g "")
(cond (
(and (>= angr 0)(<= angr (/ pi 2.0)))
(command "-layer" "s" "0" ""
"text" pgr g:ts (rtd angrg) txt1
"text" ppl g:ts (rtd angr) txt2))
)
(cond (
(and (> angr (/ pi 2.0))(<= angr pi))
(command "-layer" "s" "0" ""
"text" pgr g:ts (rtd angrg) txt1
"text" "r" ppr g:ts (rtd (angle p1 p3)) txt2))
)
(cond (
(and (> angr pi)(<= angr (* 1.5 pi)))
(command "-layer" "s" "0" ""
"text" pgr g:ts (rtd angrg) txt1
"text" "r" ppr g:ts (rtd (angle p1 p3)) txt2))
)
(cond (
(and (> angr (* 1.5 pi))(< angr (* 2.0 pi)))
(command "-layer" "s" "0" ""
"text" pgl g:ts (rtd angrg) txt1
"text" ppr g:ts (rtd angr) txt2))
)
)
)
)
)
(if (= dir "R")
(progn
(cond ((and (>= angrg 0)(<= angrg (/ pi 2.0)))
(command "line" p4g p5gl p2g p3g p8gl p7gl p6g "")
(cond ((and (>= angr 0)(<= angr (/ pi 2.0)))
(command "-layer" "s" "0" ""
"text" pgr g:ts (rtd angrg) txt1
"text" ppl g:ts (rtd angr) txt2))
)
(cond ((and (> angr (/ pi 2.0))(<= angr pi))
(command "-layer" "s" "0" ""
"text" pgl g:ts (rtd angrg) txt1
"text" "r" ppl g:ts (rtd (angle p1 p3)) txt2))
)
(cond ((and (> angr pi)(<= angr (* 1.5 pi)))
(command "-layer" "s" "0" ""
"text" pgl g:ts (rtd angrg) txt1
"text" "r" ppl g:ts (rtd (angle p1 p3)) txt2))
)
(cond ((and (> angr (* 1.5 pi))(< angr (* 2.0 pi)))
(command "-layer" "s" "0" ""
"text" pgl g:ts (rtd angrg) txt1
"text" ppr g:ts (rtd angr) txt2))
)
)
)
(cond ((and (> angrg (/ pi 2.0))(<= angrg pi))
(command "line" p4g p5gr p2g p3g p8gr p7gr p6g "")
(cond ((and (>= angr 0)(<= angr (/ pi 2.0)))
(command "-layer" "s" "0" ""
"text" "r" pgl g:ts (rtd (angle p1 p3g)) txt1
"text" ppr g:ts (rtd angr) txt2))
)
(cond ((and (> angr (/ pi 2.0))(<= angr pi))
(command "-layer" "s" "0" ""
"text" "r" pgr g:ts (rtd (angle p1 p3g)) txt1
"text" "r" ppl g:ts (rtd (angle p1 p3)) txt2))
)
(cond ((and (> angr pi)(<= angr (* 1.5 pi)))
(command "-layer" "s" "0" ""
"text" "r" pgr g:ts (rtd (angle p1 p3g)) txt1
"text" "r" ppl g:ts (rtd (angle p1 p3)) txt2))
)
(cond ((and (> angr (* 1.5 pi))(< angr (* 2.0 pi)))
(command "-layer" "s" "0" ""
"text" pgr "r" g:ts (rtd (angle p1 p3g)) txt1
"text" ppr g:ts (rtd angr) txt2))
)
)
)
(cond ((and (> angrg pi)(< angrg (* 1.5 pi)))
(command "line" p4g p5gr p2g p3g p8gr p7gr p6g "")
(cond ((and (>= angr 0)(<= angr (/ pi 2.0)))
(command "-layer" "s" "0" ""
"text" "r" pgl g:ts (rtd (angle p1 p3g)) txt1
"text" ppr g:ts (rtd angr) txt2))
)
(cond ((and (> angr (/ pi 2.0))(<= angr pi))
(command "-layer" "s" "0" ""
"text" "r" pgr g:ts (rtd (angle p1 p3g)) txt1 "text" "r" ppl g:ts (rtd (angle p1 p3)) txt2))
)
(cond ((and (> angr pi)(<= angr (* 1.5 pi)))
(command "-layer" "s" "0" ""
"text" "r" pgr g:ts (rtd (angle p1 p3g)) txt1
"text" "r" ppl g:ts (rtd (angle p1 p3)) txt2))
)
(cond ((and (> angr (* 1.5 pi))(< angr (* 2.0 pi)))
(command "-layer" "s" "0" ""
"text" "r" pgr g:ts (rtd (angle p1 p3g)) txt1
"text" ppr g:ts (rtd angr) txt2))
)
)
)
(cond
((and (>= angrg (* 1.5 pi))(< angrg (* 2 pi))) (command "line" p4g p5gl p2g p3g p8gl p7gl p6g "")
(cond ((and (>= angr 0)(<= angr (/ pi 2.0)))
(command "-layer" "s" "0" ""
"text" pgr g:ts (rtd angrg) txt1
"text" ppl g:ts (rtd angr) txt2))
)
(cond ((and (> angr (/ pi 2.0))(<= angr pi))
(command "-layer" "s" "0" ""
"text" pgr g:ts (rtd angrg) txt1
"text" "r" ppr g:ts (rtd (angle p1 p3)) txt2))
)
(cond ((and (> angr pi)(<= angr (* 1.5 pi)))
(command "-layer" "s" "0" ""
"text" pgr g:ts (rtd angrg) txt1
"text" "r" ppl g:ts (rtd (angle p1 p3)) txt2))
)
(cond ((and (> angr (* 1.5 pi))(< angr (* 2.0 pi)))
(command "-layer" "s" "0" ""
"text" pgr g:ts (rtd angrg) txt1
"text" ppl g:ts (rtd angr) txt2))
)
)
)
)
)
)
(princ)
)