;;; STA geändert von CADchup
(defun C:STA (/ TXL AO MS EP was?)
  (setq savezin (getvar "DIMZIN"))
  (setvar "DIMZIN" 0)
  (setq	SC  1000.0			; ZE Meter, Maßstab 1:1000
	TXL (* (getvar "TEXTSIZE")
	       12.0
	    ) ;_ end *
  ) ;_ end setq
  (initget "Kilometer Station Meter")
  (setq was? (getkword "Kilometer, Station oder Meter?"))
					;Abfrage, wie bemasst werden soll
  (defun DOLOOP	(PL / PT CPT LEN LENSTR PAR FD ANG PT2 TX WID)
    (while (setq PT (getpoint "\nPunkt wählen: "))
      (setq CPT	(vlax-curve-getclosestpointto PL PT)
	    LEN	(vlax-curve-getdistatpoint PL CPT)
	    PAR	(vlax-curve-getparamatpoint PL CPT)
	    FD	(vlax-curve-getfirstderiv PL PAR)
	    ANG	(angle '(0 0 0) FD)
	    ANG	(if (> ANG pi)
		  (+ ANG (/ pi 2))
		  (- ANG (/ pi 2))
		) ;_ end if
	    PT2	(polar CPT ANG TXL)
      ) ;_ end setq
      (vla-addline MS (vlax-3d-point CPT) (vlax-3d-point PT2))
      (setq
	TX
	 (strcat			; Texterzeugung komplett geändert
	   (cond
	     ((= "Kilometer" was?)
	      (strcat (cond ((minusp LEN) "km ")
			    ((zerop LEN) "km %%p")
			    (t "km +")
		      )
		      (rtos (/ (fix LEN) SC) 2 3)
		      ","
		      (substr (rtos (/ LEN SC) 2 5)
			      (- (strlen (rtos (/ LEN SC) 2 5)) 1)
			      2
		      )
	      )
	     )				; Text für Kilometer
	     ((= "Station" was?)
	      (cond ((> 10 (fix LEN))
		     (strcat "Stat. 0+00" (rtos LEN 2 2))
		    )
		    ((> 100 (fix LEN))
		     (strcat "Stat. 0+0" (rtos LEN 2 2))
		    )
		    ((< 999 (fix LEN))
		     (strcat
		       "Stat. "
		       (substr
			 (setq LENSTR (rtos LEN 2 2))
			 1
			 (- (vl-string-position (ascii ".") LENSTR) 3)
		       )
		       "+"
		       (substr LENSTR (- (strlen LENSTR) 5))
		     )
		    )
		    (t (strcat "Stat. 0+" (rtos LEN 2 2)))
	      )
	     )
					; Text für Station
	     ((= "Meter" was?) (rtos LEN 2 2))
					; Text für Meter
	   ) ;_ end cond
	 ) ;_ end strcat

;;; AUSKOMMENTIERT, weil es unter A2k nicht lief
;;;	TO (vla-addtext
;;;		 MS
;;;		 TX
;;;		 (vlax-3d-point '(0 0 0))
;;;		 (getvar "TEXTSIZE")
;;;	       ) ;_ end vla-addtext
;;;      ) ;_ end setq
;;;      (vla-put-alignment TO acalignmentbottomright)
;;;      (vla-put-rotation TO ANG)
;;;      (vla-put-textalignmentpoint TO (vlax-3d-point PT2))

      ) ;_ end setq
      (setq
	WID (cdr (assoc 41 (tblsearch "style" (getvar "textstyle"))))
      )
      (entmake (list (cons 0 "TEXT")
		     (cons 1 TX)
		     (cons 7 (getvar "TEXTSTYLE"))
		     (cons 10 CPT)
		     (cons 11 PT2)
		     (cons 40 (getvar "TEXTSIZE"))
		     (cons 41 WID)
		     (cons 50 ANG)
		     (cons 72 2)
		     (cons 73 1)
	       )
      )
    ) ;_ end while
  ) ;_ end defun
  (vl-load-com)
  (setq	AO (vlax-get-acad-object)
	MS (vla-get-modelspace (vla-get-activedocument AO))
  ) ;_ end setq
  (if (setq EP (entsel))
    (DOLOOP (vlax-ename->vla-object (car EP)))
  ) ;_ end if
  (setvar "DIMZIN" savezin)
  (princ)
) ;_ end defun