home *** CD-ROM | disk | FTP | other *** search
/ Black Box 4 / BlackBox.cdr / autocad / may91.arj / TIP656.LSP < prev    next >
Text File  |  1991-04-11  |  1KB  |  52 lines
  1. ;TIP656.LSP   Labelling Maps   (c)1991, Douglas McPherson
  2.  
  3. (defun XYLINETX (/ CE PT MID HT ANG
  4.     NEWANG NEWPT COORD)
  5.   (setq CE (getvar "cmdecho"))
  6.   (setvar "cmdecho" 0)
  7.   (setq
  8.     PT (osnap (getpoint
  9.      "\nPick Line or Pline:") "near,end")
  10.     MID (osnap PT "mid")
  11.     HT (getvar "textsize")
  12.   )
  13. ; if line slopes down
  14.   (if (> (car MID)(car PT))
  15.     (setq ANG (angle PT MID))
  16.     (setq ANG (angle MID PT))
  17.   )
  18.   (setq NEWANG (+ ANG (DTR 90))
  19.         NEWPT (polar MID NEWANG HT)
  20.         COORD (strcat
  21.                 (rtos (car NEWPT)2 1) ","
  22.                 (rtos(cadr NEWPT)2 1) ","
  23.                 (rtos (caddr NEWPT) 2 1)
  24.               )
  25.   )
  26.   (command "text" "s" "standard" "m"
  27.     NEWPT HT (ANGTOS ANG) COORD)
  28.   (setvar "cmdecho" CE)
  29. )
  30. (defun X (/ OT RT A B C ER)
  31.   (setq OT (entget (car (entsel
  32.             "\nPick coordinate: ")))
  33.          A (cdr (assoc 1 OT))
  34.   )(princ A)
  35.   (setq RT (entget (car (entsel
  36.      "\nPick Replacement Text: ")))
  37.          B (cdr (assoc 1 RT))
  38.          ER (cdr (assoc -1 RT))
  39.   )(princ B)
  40.   (command "erase" ER "")
  41.   (setq C(subst(cons 1 B)(assoc 1 OT)OT))
  42.   (entmod C)
  43.   (princ)
  44. )
  45. (defun DTR (D) ;degrees to radians
  46.   (* pi (/ D 180.0))
  47. )
  48. (defun C:XTXT ()
  49.   (XYLINETX)
  50.   (X)
  51. )
  52.