Someone asked for this and I believe I posted on an old thread:
THE FOLLOWING SHOULD CREATE A RECT CLOUD:
Code:
(defun c:txtcld (
/
pt1
pt2
pt_y
s_y
g_y
pt_x
s_x
g_x
h
w
llpt
lpt
urpt
ulpt
lrpt
d1
d2
ang1
ang2
ang3
ang4
ts
at1
at2
bl
llpt1
e1
ut1
ut2
rl
lr
);start of txtcld
(load "error")
(initerr)
(SETVAR "PLINETYPE" 0)
(setvar "cmdecho" 0)
(setq sc (getvar "DIMSCALE"));REV 9-21-98
(setvar "blipmode" 0)
(setq pt1 (getpoint "\nFirst Point: ")) ;1pt=first pt
(setq pt2 (getcorner pt1 "\nSecond Point: ")) ;2pt=second pt
(setq sc (getvar "DIMSCALE"));
(if (< (cadr pt1) (cadr pt2))
(progn
(setq pt_y (cadr pt1))
(setq s_y (cadr pt1))
(setq g_y (cadr pt2))
)
(progn
(setq pt_y (cadr pt2))
(setq s_y (cadr pt2))
(setq g_y (cadr pt1))
)
)
(if (< (car pt1) (car pt2))
(progn
(setq pt_x (car pt1))
(setq s_x (car pt1))
(setq g_x (car pt2))
)
(progn
(setq pt_x (car pt2))
(setq s_x (car pt2))
(setq g_x (car pt1))
)
)
(setq h (- g_y s_y))
(setq w (- g_x s_x))
(setq llpt (list pt_x pt_y 0.0))
(setq lpt llpt)
(setq lrpt (list (+ pt_x w) pt_y 0.0))
(setq ulpt (list pt_x (+ pt_y h) 0.0))
(setq urpt (list (+ pt_x w) (+ pt_y h) 0.0))
(setq d1 (distance llpt ulpt)) ;d1=dist llpt->ulpt
(setq d2 (distance ulpt urpt)) ;d2=dist ulpt->urpt
(setq ang1 (angle llpt ulpt)) ;ang1=ang llpt->ulpt
(setq ang2 (angle ulpt urpt)) ;ang2=ang ulpt->urpt
(setq ang3 (angle ulpt llpt)) ;ang3=ang ulpt->llpt
(setq ang4 (angle urpt ulpt)) ;ang4=ang urpt->ulpt
(setq ts (* (* sc 0.09375) 2)) ;ts=2x dwg txt size
(IF(= METRIC T)
(SETVAR "TEXTSIZE" (* 3.0 SC)))
(IF(= METRIC T)
(setq ts (GETVAR "TEXTSIZE"))) ;ts=2x dwg txt size
(setq at1 (/ d2 ts)) ;at1=d2/t2
(setq at2 (fix at1)) ;at2=real # at1
(setq at1 (/ d2 at1)) ;at1=d2/at1
(setq bl (ssadd)) ;bl=new selset
(repeat at2 ;repeat
(setq llpt1 (polar llpt ang2 at1)) ;llpt1=next pt
(command ".line" llpt llpt1 "") ;draw line
(setq e1 (entlast)) ;e1=line
(ssadd e1 bl) ;add e1->selset bl
(setq llpt llpt1) ;llpt=llpt1
) ;end repeat
(command ".line" llpt lrpt "") ;draw line
(setq e1 (entlast)) ;e1=line
(ssadd e1 bl) ;add e1->sleset bl
(setq ut1 (/ d1 ts)) ;ut1=d1/ts
(setq ut2 (fix ut1)) ;ut2=real # at1
(setq ut1 (/ d1 ut1)) ;ut1=d1/ut1
(setq rl (ssadd)) ;rl=new selset
(repeat ut2 ;repeat
(setq lrpt1 (polar lrpt ang1 ut1)) ;lrpt1=next pt
(command ".line" lrpt lrpt1 "") ;draw line
(setq e1 (entlast)) ;e1=line
(ssadd e1 rl) ;add e1->selset rl
(setq lrpt lrpt1) ;lrpt=lrpt1
) ;end repeat
(command ".line" lrpt urpt "") ;draw line
(setq e1 (entlast)) ;e1=line
(ssadd e1 rl) ;add e1->selset rl
(setq tl (ssadd)) ;tl=new selset
(repeat at2 ;repeat
(setq urpt1 (polar urpt ang4 at1)) ;urpt=next pt
(command ".line" urpt urpt1 "") ;draw line
(setq e1 (entlast)) ;e1=line
(ssadd e1 tl) ;add e1->selset tl
(setq urpt urpt1) ;urpt=urpt1
) ;end repeat
(command ".line" urpt ulpt "") ;draw line
(setq e1 (entlast)) ;e1=line
(ssadd e1 tl) ;add e1->selset tl
(setq ll (ssadd)) ;ll=new selset
(repeat ut2 ;repeat
(setq ulpt1 (polar ulpt ang3 ut1)) ;ulpt1=next pt
(command ".line" ulpt ulpt1 "") ;draw line
(setq e1 (entlast)) ;e1=line
(ssadd e1 ll) ;add e1->selset ll
(setq ulpt ulpt1) ;ulpt=ulpt1
) ;end repeat
(command ".line" ulpt lpt "") ;draw line
(setq e1 (entlast)) ;e1=line
(ssadd e1 ll) ;add e1->selset ll
(command ".pedit" bl "y" "j" bl rl tl ll "" "") ;turn selset bl rl tl ll->polyln
(setq box (entlast)) ;box=polyln
(setq en box) ;en=box
(setq hdata (entget en)) ;hdata=box entdata
(entmod (subst '(70 . 1) '(70 . 0) hdata)) ;mod entdata
(setq bulge (list (cons 42 0.5))) ;bulge=bulge dist
(setq en (dxf -1 hdata)) ;mod box
(while (and (setq en (entnext en)) ;while
(setq ed (entget en)) ;ed is /= end
(/= "SEQEND" (dxf 0 ed))
)
(setq ed (append ed bulge)) ;set ed w/bulge
(entmod ed) ;mod ed
(entupd en) ;mod en
) ;end while
(command "redraw") ;redraw
(reset nil)
) ;end of txtcld