(defun foo (fpt / del_ss add_solid add_text dis_ss pt olderr loop)
  ;;info YAD's 'INFO.LSP'
  ;;by GSLS(SS) 2011-3-20
  (defun myerr (msg)
    (del_ss ss)
    (setq *error* olderr)
    (if	msg
      (princ msg)
    )
    (*error* nil)
    (redraw)
  )
  (defun del_ss	(ss / n)
    (setq n -1)
    (repeat (sslength ss)
      (entdel (ssname ss (setq n (1+ n))))
    )
  )
  (defun add_solid (p1 p2 p3 p4)
    (entmakex (list (cons 0 "SOLID")
		    (cons 100 "AcDbEntity")
		    (cons 62 1)
		    (cons 100 "AcDbTrace")
		    (cons 10 p1)
		    (cons 11 p2)
		    (cons 12 p3)
		    (cons 13 p4)
		    (cons 210 (trans (getvar "viewdir") 1 0))
	      )
    )
  )
  (defun add_text (pt h txt)
    (entmakex (list (cons 0 "TEXT")
		    (cons 100 "AcDbEntity")
		    (cons 62 2)
		    (cons 100 "AcDbText")
		    (cons 10 pt)
		    (cons 40 h)
		    (cons 1 txt)
		    (cons 50 0.0)
		    (cons 72 0)
		    (cons 73 0)
		    (cons 210 (trans (getvar "viewdir") 1 0))
	      )
    )
  )
  (defun dis_ss	(fpt pt / dis str h high width ang)
    (setq dis	(distance fpt pt)
	  str	(rtos dis 2 3)
	  ss	(ssadd)
	  h	(/ (getvar "viewsize") 60)
	  high	(* 1.7 h)
	  width	(* 1. h (strlen str))
	  ang	(angle (trans (getvar "viewctr") 1 2) (trans pt 1 2))
	  pt	(trans (mapcar '+ pt (getvar "target")) 1 2)
	  ang	(cond
		  ((>= (/ pi 2) ang 0)
		   (list
		     (list (- (car pt) width) (- (cadr pt) high) (caddr pt))
		     (list (- (car pt) width) (cadr pt) (caddr pt))
		   )
		  )
		  ((>= pi ang (/ pi 2))
		   (list
		     (list (+ (car pt) width) (- (cadr pt) high) (caddr pt))
		     pt
		   )
		  )
		  ((>= (+ pi (/ pi 2)) ang pi)
		   (list
		     (list (+ (car pt) width) (+ (cadr pt) high) (caddr pt))
		     (list (car pt) (+ (cadr pt) high) (caddr pt))
		   )
		  )
		  ((>= (* 2 pi) ang (+ pi (/ pi 2)))
		   (list
		     (list (- (car pt) width) (+ (cadr pt) high) (caddr pt))
		     (list (- (car pt) width) (+ (cadr pt) high) (caddr pt))
		   )
		  )
		)
    )
    (ssadd (add_solid pt
		      (list (caar ang) (cadr pt) (caddr pt))
		      (list (car pt) (cadar ang) (caddr pt))
		      (car ang)
	   )
	   ss
    )
    (setq pt (cadr ang)
	  pt (list (+ (car pt) (* 0.5 h)) (cadr pt) (caddr pt))
    )
    (ssadd (add_text
	     (setq pt (list (car pt) (- (cadr pt) (* 1.6 h)) (caddr pt)))
	     h
	     str
	   )
	   ss
    )
  )
  (setq	olderr	*error*
	*error*	myerr
	ss	(ssadd)
	loop	T
	pt	fpt
  )
  (setvar "cmdecho" 0)
  (setvar "osmode" 0)
  (setvar "fillmode" 1)
  (while loop
    (setq gr (grread T 8))
    (cond
      ((or (= (car gr) 12) (= (car gr) 5))
       (if (equal (cadr gr) pt)
	nil
	(progn
	   (del_ss ss)
	   (setq pt (cadr gr))
	   (redraw)
	   (grdraw fpt pt 7 1)
	   (dis_ss fpt pt)
	)
       )
      )
      ((= (car gr) 3)
       (del_ss ss)
       (setq pt (cadr gr))
       (dis_ss fpt pt)
       (setq loop nil)
      )
      ((= (car gr) 25)
       (setq loop nil
               pt nil
               )
       )
      (T (setq loop nil
               ))
    )
  )  
  (myerr nil)
  pt
)
;;;test
(defun c:nLine (/ p1 p2)
  (setq	p1 (getpoint "\nLinie ersten Punkt angeben :"))
  (while p1
  (setq p2 (foo p1))
  (if p2
    (entmake (list (cons 0 "LINE")
		   (cons 10 p1)
		   (cons 11 p2)
		   (cons 62 3)
	     )
    )
    (setq p2 nil)
  )
    (setq p1 p2
          p2 nil)
    (prompt"\nNächsten Punkt angeben: ")
    )
  (princ)
)