home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Black Box 4
/
BlackBox.cdr
/
autocad
/
may91.arj
/
TIP656.LSP
< prev
next >
Wrap
Text File
|
1991-04-11
|
1KB
|
52 lines
;TIP656.LSP Labelling Maps (c)1991, Douglas McPherson
(defun XYLINETX (/ CE PT MID HT ANG
NEWANG NEWPT COORD)
(setq CE (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq
PT (osnap (getpoint
"\nPick Line or Pline:") "near,end")
MID (osnap PT "mid")
HT (getvar "textsize")
)
; if line slopes down
(if (> (car MID)(car PT))
(setq ANG (angle PT MID))
(setq ANG (angle MID PT))
)
(setq NEWANG (+ ANG (DTR 90))
NEWPT (polar MID NEWANG HT)
COORD (strcat
(rtos (car NEWPT)2 1) ","
(rtos(cadr NEWPT)2 1) ","
(rtos (caddr NEWPT) 2 1)
)
)
(command "text" "s" "standard" "m"
NEWPT HT (ANGTOS ANG) COORD)
(setvar "cmdecho" CE)
)
(defun X (/ OT RT A B C ER)
(setq OT (entget (car (entsel
"\nPick coordinate: ")))
A (cdr (assoc 1 OT))
)(princ A)
(setq RT (entget (car (entsel
"\nPick Replacement Text: ")))
B (cdr (assoc 1 RT))
ER (cdr (assoc -1 RT))
)(princ B)
(command "erase" ER "")
(setq C(subst(cons 1 B)(assoc 1 OT)OT))
(entmod C)
(princ)
)
(defun DTR (D) ;degrees to radians
(* pi (/ D 180.0))
)
(defun C:XTXT ()
(XYLINETX)
(X)
)