As Mark was taking down his justlisp website I was allowed to place this free code here.
(Copy and Paste)
No support or updates for these AutoLISP tools are planned.
Text Precedence enables you to write text over entities.
;;;************************Begin*******************************
;;;written by Mark Beggs 4/2002 revised 9/07
(defun dtr(a)
(* pi(/ a 180.0)))
(defun c:tx (/ txloc txt aa a b c cc d e d1 c1 e1 cc1)
(setq oldpick(getvar "pickbox")
oldecho(getvar "cmdecho")
oldsnap(getvar "osmode")
oldorth(getvar "orthomode"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(setvar "orthomode" 0)
(setq txloc(getpoint"\n Middle of Text:")
txt(getstring 1"\n Enter Text:"))
(command "text" "mc" txloc (getvar "textsize") "" txt)
(setq aa(car(textbox(entget(entlast))));These 2 lines get text dimensions using "textbox"
a(cadr(textbox(entget(entlast))))
b(cdr(assoc 10(entget(entlast))));retrieving dimension data from actual text
c(mapcar'+ a b);adding "textbox" data to actual location of text
cc(mapcar'+ aa b)
d(list(car cc)(cadr c));creating points for the rectangle
e(list(car c)(cadr cc))
d(polar d(dtr 135)0.03);;;move textbox out a little
c(polar c(dtr 45)0.03)
e(polar e(dtr 315)0.03)
cc(polar cc(dtr 225)0.03)
d1(polar d(dtr 315)0.01);;;create trim line away from text
c1(polar c(dtr 225)0.01)
e1(polar e(dtr 135)0.01)
cc1(polar cc(dtr 45)0.01))
(setvar "pickbox" 0);pinpoint pickbox
(command "pline" d c e cc "cl"
"trim" e "" "f" cc1 e1 "" "f" e1 c1 "" "f" c1 d1 "" "f" d1 cc1 "" ""
"erase" d "")
(setdown)
(princ));defun tx
(defun *error*(errmsg)
(princ " "); chatter trap
(setdown))
(defun setdown()
(setvar "pickbox" oldpick)
(setvar "cmdecho" oldecho)
(setvar "osmode" oldsnap)
(setvar "orthomode" oldorth))
(princ"\n Type tx to start program")
;;;*****************************End**********************************
This program draws a continuous-link chain in sizes
1/8, 3/16, 5/16 and 7/16 from pickpoint to endpoint.
;;;************************Begin*******************************
(defun dtr(x);;;Written by Mark S. Beggs 7/01
(* pi(/ x 180.0)))
(defun c:ch(/ cenpt endpt sets ec ce a b c d e f aa bb cc tr1 tr2 tr4)
(initget 7 "O T F S")
(setq choice(getkword"\n Select ChainSize:O=1/8 T=3/16 F=5/16 S=7/16"))
(cond((= choice "O")
(setq thk 0.250 sdcntr 0.0625 sdrad 0.0625 sd-dwn 1.3125 trm4 1.3125
diam 0.1250 cendwn 0.9375 trmcen 0.0625 trmup 2.3750)))
(cond((= choice "T")
(setq thk 0.3750 sdcntr 0.0937 sdrad 0.0937 sd-dwn 1.1875 trm4 1.1876
diam 0.1875 cendwn 0.6250 trmcen 0.0937 trmup 1.9999)))
(cond((= choice "F")
(setq thk 0.5000 sdcntr 0.0312 sdrad 0.1562 sd-dwn 1.3126 trm4 1.3758
diam 0.1875 cendwn 0.6250 trmcen 0.0937 trmup 1.9999)))
(cond((= choice "S")
(setq thk 0.71875 sdcntr 0.0625 sdrad 0.2187 sd-dwn 1.5625 trm4 1.5626
diam 0.28125 cendwn 0.5625 trmcen 0.2187 trmup 2.2500)))
(setvar "cmdecho" 0)
(setq oldpick(getvar "pickbox"))
(setq cenpt(getpoint"\nTop Center Point of Chain:")
endpt(getpoint cenpt "\n End of chain:")
ec(angle endpt cenpt)
ce(angle cenpt endpt)
top cenpt
quant(fix(/(distance cenpt endpt)2)))
(repeat quant
(setq a(polar cenpt ec diam) ;a-f..points for face link
b(polar cenpt ec thk)
c(polar cenpt(+(dtr 90)ec)diam)
d(polar cenpt(+(dtr 90)ec)thk)
e(polar cenpt(+(dtr -90)ec)diam)
f(polar cenpt(+(dtr -90)ec)thk))
(command "arc" e a c
"arc" f b d)
(setq cenpt(polar cenpt ce cendwn) ;bring centerpoint down
a(polar cenpt ce diam) ;a-f..points for face link
b(polar cenpt ce thk)
c(polar cenpt(+(dtr 90)ce)diam)
d(polar cenpt(+(dtr 90)ce)thk)
e(polar cenpt(+(dtr -90)ce)diam)
f(polar cenpt(+(dtr -90)ce)thk))
(command "arc" e a c "arc" f b d)
(command "line" d(polar d ec cendwn)""
"line" c(polar c ec cendwn)""
"line" e(polar e ec cendwn)""
"line" f(polar f ec cendwn)"")
(setq cenpt(polar cenpt ce sdcntr) ;move cenpt
aa(polar cenpt ec sdrad) ;Side link
bb(polar cenpt(+(dtr -90)ec)sdrad)
cc(polar cenpt(+(dtr 90)ec)sdrad))
(command "arc" bb aa cc)
(setq cenpt(polar cenpt ce sd-dwn)
aa(polar cenpt ce sdrad)
bb(polar cenpt(+(dtr -90)ce)sdrad)
cc(polar cenpt(+(dtr 90)ce)sdrad))
(command "arc" bb aa cc)
(command "line" cc(polar cc ec sd-dwn)""
"line" bb(polar bb ec sd-dwn)"")
(if(= choice "O")(setq cenpt(polar cenpt ce 0.0625)));these 4 lines for setting
(if(= choice "T")(setq cenpt aa)) ;cenpt for next repeat
(if(= choice "F")(setq cenpt(polar aa ec 0.125)))
(if(= choice "S")(setq cenpt(polar cenpt ce 0.0625)))) ;End Repeat
(setq a(polar cenpt ec diam) ;Single face link
b(polar cenpt ec thk)
c(polar cenpt(+(dtr 90)ec)diam)
d(polar cenpt(+(dtr 90)ec)thk)
e(polar cenpt(+(dtr -90)ec)diam)
f(polar cenpt(+(dtr -90)ec)thk))
(command "arc" e a c "arc" f b d)
(setq cenpt(polar cenpt ce cendwn) ;bring centerpoint down
a(polar cenpt ce diam) ;a-f..points for face link
b(polar cenpt ce thk)
c(polar cenpt(+(dtr 90)ce)diam)
d(polar cenpt(+(dtr 90)ce)thk)
e(polar cenpt(+(dtr -90)ce)diam)
f(polar cenpt(+(dtr -90)ce)thk)
bot cenpt)
(command "arc" e a c "arc" f b d)
(command "line" d(polar d ec cendwn)""
"line" c(polar c ec cendwn)""
"line" e(polar e ec cendwn)""
"line" f(polar f ec cendwn)"")
(setq cenpt(polar aa ec trmcen) ;setting cenpt for trim mode
hold cenpt)
(setvar "pickbox" 0)
(repeat quant ;Trim module
(setq bb(polar cenpt(+(dtr 90)ec)sdrad)
cc(polar cenpt(+(dtr -90)ec)sdrad)
tr1(polar bb ec 0.5937)
tr2(polar cc ec 0.5937)
tr4(polar cenpt ec trm4))
(command "trim" tr1 tr2 "" "f" cenpt tr4 "" "")
(setq cenpt(polar cenpt ec trmup)));move cenpt up 1 side link--End Repeat
(setvar "cmdecho" 1)
(setvar "pickbox" oldpick)
(princ) )
(princ"\n Chain Program Loaded...type ch to run")
;;;*****************************End**********************************
This program draws a tape-measure from pick-point to end-point.
;;;************************Begin*******************************
;;;Written by Mark S.Beggs 5/02
(defun dtr(a)
(* pi(/ a 180.0)))
(defun c:tp(/ oldecho oldblip oldtx beg end ang dis dwn dn strt len inc numbse nmbr)
(setq oldecho(getvar "cmdecho")
oldblip(getvar "blipmode"))
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(initget 1)
(setq beg(getpoint"\n Select Start Point of Tape Measure:")
end(getpoint beg"\n Select Endpoint of Tape Measure:")
ang(angle beg end)
dis(distance beg end))
(if(and(>= ang(dtr 90))(<= ang(dtr 270)))
(setq dwn(dtr 90))(setq dwn(dtr 270)))
(setq dn (+ dwn ang) ;Whole angle package
strt beg)
(setq len 0.5 inc 1) ;Setup for 1" lines
(work)
(setq strt(polar beg ang 0.5)len 0.375) ;1/2" lines
(work)
(setq strt(polar beg ang 0.25)len 0.25 inc 0.5) ;1/4" lines
(work)
(setq strt(polar beg ang 0.125)len 0.1875 inc 0.25) ;1/8" lines
(work)
(setq strt(polar beg ang 0.0625)len 0.125 inc 0.125) ;1/16"lines
(work)
(setq numbse(polar beg ang 0.875) ;number placement
nmbr(polar numbse dn 0.3555)
oldtx(getvar "textsize")
txt 1)
(setvar "textsize" 0.1)
(repeat(fix dis)
(command "text" "mc" nmbr "" "" txt)
(setq nmbr(polar nmbr ang 1)
txt(1+ txt))) (setvar "textsize" oldtx)
(setvar "cmdecho" oldecho)
(setvar "blipmode" oldblip)(princ))
(defun work( )
(repeat(fix(+(/ dis inc)1))
(command "line" strt (polar strt dn len)"")
(setq strt(polar strt ang inc))))
(princ"\n Program Loaded......... Type tp to run")
;;;*****************************End**********************************
Following code draws an X/Y grid with coordinate values.
;;;************************Begin*******************************
;;;written by Mark S. Beggs 9/2006
(defun rtd(ar)
(/(* ar 180.0)pi))
(defun dtr(a)
(* pi(/ a 180.0)))
(defun c:grd(/ origin wdth hgt row_qty col_qty ang1 ang2 cen mid_left top_left
row_point row_spce col_spce first_txt txt x y oldtxt oldecho)
(setq oldtxt(getvar "textsize")
oldecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(initget 6 "U L")
(setq origin(getkword"\n Start Origin:[Upperleft/Lowerleft]"))
(initget 7)
(setq wdth(getreal"\n Frame Width:"))
(initget 7)
(setq hgt(getreal"\n Frame Height:"))
(initget 7)
(setq row_qty(getreal"\n Number of Rows:"))
(initget 7)
(setq col_qty(getreal"\n Number of Columns:"))
(if(= origin "U")
(setq ang1(dtr 90)
ang2(dtr 270)));if
(if(= origin "L")
(setq ang1(dtr 270)
ang2(dtr 90)));if
(setq cen(list(/(car(getvar "limmax"))2)(/(cadr(getvar "limmax"))2))
mid_left(polar cen(dtr 180)(/ wdth 2))
top_left(polar mid_left ang1(/ hgt 2))
row_point top_left;save first row point
row_spce(/ hgt row_qty)
col_spce(/ wdth col_qty)
first_txt(polar top_left(dtr 340)(/ row_spce 3));upper left corners
txt first_txt;save first text point
x 0 y 0)
(setvar "textsize"(/ row_spce 8))
(command "erase" "all" "")
(repeat(+(fix row_qty)1)
(command "line" row_point(polar row_point 0 wdth)"");draw row line
(repeat(+(fix col_qty)1)
(command "text" "m" txt "" "" (strcat(itoa x)","(itoa y)));coordinance label
(setq x(1+ x)
txt(polar txt 0 col_spce)));repeat
(setq row_point(polar row_point ang2 row_spce)
txt(polar row_point(dtr 340)(/ row_spce 3))
y(1+ y)x 0));1st repeat
(repeat(+(fix col_qty)1)
(command "line" top_left(polar top_left ang2 hgt)"")
(setq top_left(polar top_left 0 col_spce)));repeat
(command "zoom" "all")
(setvar "textsize" oldtxt)
(setvar "cmdecho" oldecho)
(princ));defun
(princ)
(defun *error* (errmsg)
(princ " ")
(setvar "textsize" oldtxt)
(setvar "cmdecho" oldecho)
(princ))
(princ"\n Grid_Maker Loaded...type \"grd\" to run grid program")
;;;*****************************End**********************************
This program writes text in a circle or spline.
;;;************************Begin*******************************
;;;written by Mark S. Beggs 4/03 revised 9/07
(defun dtr(a)
(* pi(/ a 180.0)))
(defun c:txp(/ choice oldecho oldblip oldos oldorth)
(setq oldecho(getvar "cmdecho")
oldblip(getvar "blipmode")
oldos(getvar "osmode")
oldorth(getvar "orthomode"))
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(setvar "osmode" 0)
(setvar "orthomode" 0)
(if(not(tblsearch "style" "Profile Text"))
(command "style" "Profile Text" "Romans.shx"
"" "" "" "" "" ""));if
(initget 7 "R C")
(setq choice(getkword"\n Select Program <RollingText/CircleText> R/C:"))
(cond((= choice "R")(Rolling_Text))
((= choice "C")(Circle_Text)));cond
(setvar "cmdecho" oldecho)
(setvar "osmode" oldos)
(setvar "blipmode" oldblip)
(setvar "orthomode" oldorth)(princ));defun
(defun rolling_text(/ svtxt cen rad num rmndr num1 inc
ang atxt svtxt lnum)
(if txt(progn
(initget 7"Y N")
(setq svtxt(getkword(strcat"\n ReuseText?<"txt">Y/N:")))
(if(= svtxt "Y")
(setq txt txt));if
(if(= svtxt "N")
(setq txt(getstring 1"\n Enter New Text:")));if
);progn
(setq txt(getstring 1"\n Enter Text:")));if txt
(setq cen(getpoint"\n CenterPoint of first roll:")
rad(getdist cen"\n Radius of rolling text:")
num(strlen txt) ;actual number of characters
rmndr(rem num 2) ;possible remainder from dividing by 2
num1(/(- num rmndr)2) ;get rid of possible remainder and / by 2
inc(/(dtr 180)num1)
ang(dtr 180)lnum 1)
(repeat num1
(setq pt(polar cen ang rad)
atxt(substr txt lnum 1))
(command "text" "mc" pt ""(-(* ang 57.296)90) atxt)
(setq lnum(1+ lnum)
ang(- ang inc)));repeat
(setq num2(+ num1 rmndr) ;add possible remainder to last 1/2 of letters
inc(/(dtr -180)num2) ;make roll opposite direction
ang(+ ang inc) ;subtract last letter space
cen(polar cen 0(* rad 2))
ang(dtr 180));setq
(repeat num2
(setq pt(polar cen ang rad)
atxt(substr txt lnum 1))
(command "text" "mc" pt ""(+(* ang 57.296)90) atxt)
(setq lnum(1+ lnum)
ang(- ang inc)));repeat
(princ) );defun rolling_text
(defun circle_text(/ cen rad pt1 pt2 txang
svtxt num lnum loc ltr inc a b)
(if txt(progn
(initget 7 "Y N")
(setq svtxt(getkword(strcat"\n ReuseText?<"txt">Y/N:")))
(if(= svtxt "Y")(setq txt txt));if
(if(= svtxt "N")(setq txt(getstring 1"\n Enter New Text:"))));progn
(setq txt(getstring 1"\n Enter Text:")));if txt
(setq num(strlen txt)
cen(getpoint"\n Center of Circle:")
rad(getdist cen "\n Radius of Circle:"))
(command "circle" cen rad)
(setq a(entlast))
(redraw a 3)
(setvar "osmode" 512)
(setq pt1(getpoint cen"\nStart of Text:"))
(setq pt2(getpoint cen"\nEnd of Text:"))
(entdel a)
(setq pt1(angle cen pt1)
pt2(angle cen pt2)
ang pt1
lnum 1)
(if(< pt1 pt2)
(setq inc(/(- pt2 pt1)num))
(setq inc(/(- pt1 pt2)num)));if
(if(< pt1 pt2)
(setq ang(+ ang inc)txang 90)
(setq ang(- ang inc)txang -90));if
(setvar "osmode" 0)
(repeat num
(setq loc(polar cen ang rad)
ltr(substr txt lnum 1))
(command "text" "mc" loc ""(+(* ang 57.296)txang)ltr)
(if(< pt1 pt2)
(setq ang(+ ang inc))
(setq ang(- ang inc)));if
(setq lnum(1+ lnum))));repeat
(defun *error* (errmsg)
(princ " "))
(princ"\n Program Loaded.......Type txp to run")
;;;*****************************End**********************************