;;; Globale Variable für Stationierungslayer
(setq $MS:STATLAY "P_$-TRASSIERUNG")
;;; Funktion zum Stationslayer setzen
(defun MS:STAT-LAYER ()
  (if (not SETZLAYER)
    (if (/= (load "set_lay" "err") "err")
      (MS:STAT-LAYER)
    ) ;_ end of if
    (if $MS:STATLAY
      (SETZLAYER $MS:STATLAY)
    ) ;_ end of if
  ) ;_ end of if
) ;_ end of defun


(defun C:STATION (/         L         M         OERR      OSM
                  OCE       SELECT    STAT      TEXTHÖHE? TEXTPREFIX
                  TEXTSUFFIX
                 )
  (defun *STAT_ERR* (S)
    (command "_.UNDO" "_End")
    (setvar "OSMODE" OSM)
    (setvar "cmdecho" OCE)
    (setq *ERROR* OERR)
    (princ)
  ) ;_ end of defun
  ;; Neue Fehlerfunktion aktivieren:
  (setq OERR    *ERROR*
        *ERROR* *STAT_ERR*
        OSM     (getvar "OSMODE")
        OCE     (getvar "cmdecho")
  ) ;_ end of setq


  ;; VORGABEWERTE:
  (setq STAT 100.0 ;_ Vorgabewert für Stationierungsinkrement
        M 1 ;_ Vorgabewert für Textmaßstab
        TEXTHÖHE? 1.25
        TEXTPREFIX
         ""
        TEXTSUFFIX
         ""
  ) ;_ end of setq

  (setvar "OSMODE" 0)
  (setvar "cmdecho" 0)

  (MS:STAT-LAYER) ;_ Layer setzen

;;;  (if (/= (tblsearch "style" "SIMPLEX") NIL) ;_ Textstil setzen
;;;    (setvar "textstyle" "SIMPLEX")
;;;  ) ;_ end of if

  (if (not
        (setq
          L (getreal "\nWert für Anfangsstationierung eingeben <0>: ")
        ) ;_ end of setq
      ) ;_ end of not
    (setq L 0)
  ) ;_ end of if
  ;; Undo-Gruppe erstellen:
  (command "_.UNDO" "_End" "_.UNDO" "_Group")
  (command "_.ucs" "_w")
  (if (not (setq SELECT
                  (entsel
                    "\nZu Stationierendes Objekt (Linie, Polylinie oder Spline) wählen: "
                  ) ;_ end of entsel
           ) ;_ end of setq
      ) ;_ end of not
    (princ "\nKein Objekt gewählt! Funktionsende.")
    (if (not (member (cdr (assoc 0 (entget (car SELECT))))
                     '("LINE" "POLYLINE" "LWPOLYLINE" "SPLINE")
             ) ;_ end of member
        ) ;_ end of not
      (princ
        "\nObjekt war weder Linie, Polylinie noch Spline! Funktionsende."
      ) ;_ end of princ
      (MS:STATION
        (car SELECT) ;_ Objname
        (cadr SELECT) ;_ geklickter Punkt
        L ;_ Anfangs-Station
        STAT ;_ Stationierungsinkrement
        M ;_ Maßstab für Texteintragungen 
        TEXTHÖHE? ;_ Texthöhe
        TEXTPREFIX ;_ Präfix für Text
        TEXTSUFFIX ;_ Suffix für Text
        2 ;_ Textausrichtungs-Modus (hier: Immer in Stationierungsrichtung)
        2
      ) ;_ end of MS:STATION
    ) ;_ end of if
  ) ;_ end of if
  ;; Undo-Gruppe beenden:
  (command "_.UNDO" "_End")
  ;; Systemvariablen zuruecksetzen:
  (setvar "OSMODE" OSM)
  (setvar "cmdecho" OCE)
  (setq *ERROR* OERR)
  (princ)
) ;_ end of defun

(defun C:STATION2 (/         L         M         OERR      OSM
                   OCE       SELECT    STAT      TEXTHÖHE? TEXTPREFIX
                   TEXTSUFFIX
                  )
  (defun *STAT_ERR* (S)
    (command "_.UNDO" "_End")
    (setvar "OSMODE" OSM)
    (setvar "CMDECHO" OCE)
    (setq *ERROR* OERR)
    (princ)
  ) ;_ end of defun
  ;; Neue Fehlerfunktion aktivieren:
  (setq OERR    *ERROR*
        *ERROR* *STAT_ERR*
        OSM     (getvar "OSMODE")
        OCE     (getvar "CMDECHO")
  ) ;_ end of setq


  ;; VORGABEWERTE:
  (setq M 1 ;_ Vorgabewert für Textmaßstab
        TEXTPREFIX
         ""
        TEXTSUFFIX
         ""
  ) ;_ end of setq

  (setvar "OSMODE" 0)
  (setvar "CMDECHO" 0)

  (MS:STAT-LAYER) ;_ Layer setzen

;;;  (if (/= (tblsearch "style" "SIMPLEX") NIL) ;_ Textstil setzen
;;;    (setvar "textstyle" "SIMPLEX")
;;;  ) ;_ end of if

  (if (not
        (setq
          L (getdist
              "\nWert für Anfangsstationierung eingeben/picken <0>: "
            ) ;_ end of getdist
        ) ;_ end of setq
      ) ;_ end of not
    (setq L 0)
  ) ;_ end of if
  (if (not (setq STAT
                  (getdist
                    "\nWert für Stationierungs-Inkrement eingeben/picken <100.0>: "
                  ) ;_ end of getdist
           ) ;_ end of setq
      ) ;_ end of not
    (setq STAT 100.0)
  ) ;_ end of if
  (if (not (setq TEXTHÖHE?
                  (getdist "\nWert für Texthöhe eingeben/picken <1.25>: "
                  ) ;_ end of getdist
           ) ;_ end of setq
      ) ;_ end of not
    (setq TEXTHÖHE? 1.25)
  ) ;_ end of if

  ;; Undo-Gruppe erstellen:
  (command "_.UNDO" "_End" "_.UNDO" "_Group")
  (command "_.ucs" "_w")
  (if (not (setq SELECT
                  (entsel
                    "\nZu Stationierendes Objekt (Linie, Polylinie oder Spline) wählen: "
                  ) ;_ end of entsel
           ) ;_ end of setq
      ) ;_ end of not
    (princ "\nKein Objekt gewählt! Funktionsende.")
    (if (not (member (cdr (assoc 0 (entget (car SELECT))))
                     '("LINE" "POLYLINE" "LWPOLYLINE" "SPLINE")
             ) ;_ end of member
        ) ;_ end of not
      (princ
        "\nObjekt war weder Linie, Polylinie noch Spline! Funktionsende."
      ) ;_ end of princ
      (MS:STATION
        (car SELECT) ;_ Objname
        (cadr SELECT) ;_ geklickter Punkt
        L ;_ Anfangs-Station
        STAT ;_ Stationierungsinkrement
        M ;_ Maßstab für Texteintragungen 
        TEXTHÖHE? ;_ Texthöhe
        TEXTPREFIX ;_ Präfix für Text
        TEXTSUFFIX ;_ Suffix für Text
        2 ;_ Textausrichtungs-Modus (hier: Immer in Stationierungsrichtung)
        2
      ) ;_ end of MS:STATION
    ) ;_ end of if
  ) ;_ end of if
  ;; Undo-Gruppe beenden:
  (command "_.UNDO" "_End")
  ;; Systemvariablen zuruecksetzen:
  (setvar "OSMODE" OSM)
  (setvar "CMDECHO" OCE)
  (setq *ERROR* OERR)
  (princ)
) ;_ end of defun


(defun C:STATION-FROM (/           BEGIN-AT    PRECISION   SCALING
                       TEXTMODE    TXTPREFIX   TXTSIZE     TXTSUFFIX
                      )
  (defun *STAT_ERR* (S)
    (setvar "OSMODE" OSM)
    (setq *ERROR* OERR)
    (princ)
  ) ;_ end of defun
  ;; Neue Fehlerfunktion aktivieren:
  (setq OERR    *ERROR*
        *ERROR* *STAT_ERR*
        OSM     (getvar "OSMODE")
  ) ;_ end of setq

  (setvar "OSMODE" 0)

  (MS:STAT-LAYER) ;_ Layer setzen

;;;  (if (/= (tblsearch "style" "SIMPLEX") NIL) ;_ Textstil setzen
;;;    (setvar "textstyle" "SIMPLEX")
;;;  ) ;_ end of if

  ;; VORGABEWERTE:
  (setq BEGIN-AT 0
        SCALING 1
        TXTSIZE 1.25
        TXTPREFIX ""
        TXTSUFFIX ""
        TEXTMODE 2
        PRECISION 2
  ) ;_ end of setq
  (MS:STATION-FROM
    BEGIN-AT SCALING TXTSIZE TXTPREFIX TXTSUFFIX TEXTMODE PRECISION) ;_ end of MS:STATION-FROM
;_ end of MS:STATION-FROM
  (setvar "OSMODE" OSM)
  (setq *ERROR* OERR)
  (princ)
) ;_ end of defun

(defun C:STATION-FROM2 (/           BEGIN-AT    PRECISION   SCALING
                        TEXTMODE    TXTPREFIX   TXTSIZE     TXTSUFFIX
                       )
  (defun *STAT_ERR* (S)
    (setvar "OSMODE" OSM)
    (setq *ERROR* OERR)
    (princ)
  ) ;_ end of defun
  ;; Neue Fehlerfunktion aktivieren:
  (setq OERR    *ERROR*
        *ERROR* *STAT_ERR*
        OSM     (getvar "OSMODE")
  ) ;_ end of setq

  (setvar "OSMODE" 0)

  (MS:STAT-LAYER) ;_ Layer setzen

;;;  (if (/= (tblsearch "style" "SIMPLEX") NIL) ;_ Textstil setzen
;;;    (setvar "textstyle" "SIMPLEX")
;;;  ) ;_ end of if

  (if (not
        (setq
          BEGIN-AT
           (getdist
             "\nWert für Anfangsstationierung eingeben/picken <0>: "
           ) ;_ end of getdist
        ) ;_ end of setq
      ) ;_ end of not
    (setq BEGIN-AT 0)
  ) ;_ end of if
  (if (not (setq TXTSIZE
                  (getdist "\nWert für Texthöhe eingeben/picken <1.25>: ")
           ) ;_ end of setq
      ) ;_ end of not
    (setq TXTSIZE 1.25)
  ) ;_ end of if
  (setq TXTPREFIX ""
        TXTSUFFIX ""
        SCALING 1.0
        TEXTMODE 2
        PRECISION 2
  ) ;_ end of setq
  (MS:STATION-FROM
    BEGIN-AT SCALING TXTSIZE TXTPREFIX TXTSUFFIX TEXTMODE PRECISION) ;_ end of MS:STATION-FROM
;_ end of MS:STATION-FROM
  (setvar "OSMODE" OSM)
  (setq *ERROR* OERR)
  (princ)
) ;_ end of defun


(defun C:TEST (/ INKREMENT? MODE? OBJ? PKT? PREFIX? SEL SKALIERUNG? STARTWERT? SUFFIX? TXTGRÖßE? PRÄZISION?)
  (setq SEL (entsel))
  (if SEL
    (progn
      (setq OBJ?        (car SEL)
            PKT?        (cadr SEL)
            STARTWERT?  (getdist "\nStartwert für Stationierung eingeben/picken: ")
            SKALIERUNG? (getreal "\nMaßstab für Stationierung eingeben: ")
            INKREMENT?  (getdist "\nInkrement für Stationierung eingeben/picken: ")
            TXTGRÖßE?   (getdist "\nTexthöhe für Stationierung eingeben/picken: ")
            PRÄZISION?  (getint "\nAnzahl Nachkommastellen? (0-8): ")
            PREFIX?     (getstring t "\nPrefix: ")
            SUFFIX?     (getstring t "\nSuffix: ")
      ) ;_ end of setq
      (initget "Ja Nein")
      (setq MODE? (getkword "\nTextausrichtung immer in Stationierungsrichtung? [Ja/Nein] <Ja>: "))
      (if (not mode?)
        (setq mode? "Ja")
        )
      (if (= mode? "Ja")
        (setq mode? 2)
        (setq mode? 1)
        )
      (MS:STATION OBJ? PKT? STARTWERT? INKREMENT? SKALIERUNG? TXTGRÖßE? PREFIX? SUFFIX? mode? PRÄZISION?)
    ) ;_ end of progn
  ) ;_ end of if
)

(defun C:TEST2 (/            MODE?        PREFIX?      PRÄZISION?
                SKALIERUNG?  STARTWERT?   SUFFIX?      TXTGRÖßE?
               )
  (setq STARTWERT?  (getdist "\nStartwert für Stationierung eingeben/picken: "
                    ) ;_ end of getdist
        SKALIERUNG? (getreal "\nMaßstab für Stationierung eingeben: ")
        TXTGRÖßE?   (getdist "\nTexthöhe für Stationierung eingeben/picken: ")
        PRÄZISION?  (getint "\nAnzahl Nachkommastellen? (0-8): ")
        PREFIX?     (getstring t "\nPrefix: ")
        SUFFIX?     (getstring t "\nSuffix: ")
  ) ;_ end of setq
  (initget "Ja Nein")
  (setq MODE?
         (getkword
           "\nTextausrichtung immer in Stationierungsrichtung? [Ja/Nein] <Ja>: "
         ) ;_ end of getkword
  ) ;_ end of setq
  (if (not MODE?)
    (setq MODE? "Ja")
  ) ;_ end of if
  (if (= MODE? "Ja")
    (setq MODE? 2)
    (setq MODE? 1)
  ) ;_ end of if
  (MS:STATION-FROM
    STARTWERT? SKALIERUNG? TXTGRÖßE? PREFIX? SUFFIX? MODE? PRÄZISION?) ;_ end of MS:STATION-FROM
;_ end of MS:STATION-FROM
;_ end of MS:STATION-FROM
  (princ)
)

;;; ************ Sub-Routines **********************

(vl-load-com)
;;; Startparameter für MS:STATION
;;; objname    = Lisp-Objektname der Polylinie
;;; begin-at   = Startwert für Stationierung
;;; increment  = Stationierungsinkrement
;;; scaling    = Maßstabs-Faktor für Inkrement-Werte
;;; txtsize    = Textgröße
;;; txtprefix  = Präfix für numerischen Wert
;;; txtsuffix  = Suffix für numerischen Wert
;;; TEXTMODE   = Steuert die Ausrichtung der Textobjekte 1 = Immer lesbar 2= In Stationierungsrichtung
;;; PRECISION  = Steuert die Anzahl der Nachkomma-Stellen 0-8 ist möglich (wie luprec).
;;;              Werte über acht werden auf 8 gesetzt
(defun MS:STATION (OBJNAME      PICKPT       BEGIN-AT     INCREMENT
                   SCALING      TXTSIZE      TXTPREFIX    TXTSUFFIX TEXTMODE PRECISION
                   /            END-PKT      INDEX        OBJLENGTH
                   PARTS        REVERSED     START-PKT    STATION-LST
                   VLA-OBJNAME
                  )
  (setq OBJLENGTH   (LIN-LENGTH? OBJNAME)
        INCREMENT   (float INCREMENT)
        PARTS       (fix (/ OBJLENGTH INCREMENT)) ;_ Anzahl der Teile in integer
        VLA-OBJNAME (vlax-ename->vla-object OBJNAME)
        INDEX       1
  ) ;_ end of setq
  (if (IS-AT-START? OBJNAME PICKPT) ;_ gegen Erstellungsrichtung arbeiten oder in Erstellungsrichtung
    (setq START-PKT (vlax-curve-getstartpoint VLA-OBJNAME)
          END-PKT   (vlax-curve-getendpoint VLA-OBJNAME)
          REVERSED  NIL
    ) ;_ end of setq
    (setq END-PKT   (vlax-curve-getstartpoint VLA-OBJNAME)
          START-PKT (vlax-curve-getendpoint VLA-OBJNAME)
          REVERSED  t
    ) ;_ end of setq
  ) ;_ end of if
  (if (> TEXTMODE 1)
    (if REVERSED
      (setq TEXTMODE 3)
    ) ;_ end of if
  ) ;_ end of if
  (MS:STATIONPLACING
    VLA-OBJNAME
    START-PKT
    (strcat TXTPREFIX
            (MS:REFORMAT-TXT
              (rtos (* (+ 0.0 BEGIN-AT) SCALING) 2 PRECISION)
              "."
              PRECISION
            ) ;_ end of MS:REFORMAT-TXT
            TXTSUFFIX
    ) ;_ end of strcat
    TXTSIZE
    TEXTMODE
  ) ;_ end of MS:STATIONPLACING
  (MS:STATIONPLACING
    VLA-OBJNAME
    END-PKT
    (strcat TXTPREFIX
            (MS:REFORMAT-TXT
              (rtos (* (+ OBJLENGTH BEGIN-AT) SCALING)
                    2
                    PRECISION
              ) ;_ end of rtos
              "."
              PRECISION
            ) ;_ end of MS:REFORMAT-TXT
            TXTSUFFIX
    ) ;_ end of strcat
    TXTSIZE
    TEXTMODE
  ) ;_ end of MS:STATIONPLACING
  (if (not (zerop PARTS))
    (progn
      (repeat PARTS
        (setq STATION-LST (cons (* INCREMENT INDEX)
                                STATION-LST
                          ) ;_ end of cons
              INDEX       (1+ INDEX)
        ) ;_ end of setq
      ) ;_ end of repeat
      (setq STATION-LST (reverse STATION-LST))
      (foreach ELEM STATION-LST
        (MS:STATIONPLACING
          VLA-OBJNAME
          (CALCULATE-INSERTATION OBJNAME PICKPT ELEM)
          (strcat TXTPREFIX
                  (MS:REFORMAT-TXT
                    (rtos (* (+ ELEM BEGIN-AT) SCALING)
                          2
                          PRECISION
                    ) ;_ end of rtos
                    "."
                    PRECISION
                  ) ;_ end of MS:REFORMAT-TXT
                  TXTSUFFIX
          ) ;_ end of strcat
          TXTSIZE
          TEXTMODE
        ) ;_ end of MS:STATIONPLACING
      ) ;_ end of foreach
      (princ (strcat "\nOK, >"
                     (itoa (+ PARTS 2))
                     "< Stationierungen eingefügt!"
             ) ;_ end of strcat
      ) ;_ end of princ
    ) ;_ end of progn
    (princ "\nOK, >2< Stationierungen eingefügt!")
  ) ;_ end of if
) ;_ end of defun


;;; Stationierung nach geklicktem Punkt
(defun MS:STATION-FROM (BEGIN-AT    SCALING     TXTSIZE     TXTPREFIX
                        TXTSUFFIX   TEXTMODE    PRECISION   /
                       )
  (defun DOLOOP (SELECTED /)
    (setq OBJNAME (car SELECTED)
          PICKPT  (cadr SELECTED)
          PL      (vlax-ename->vla-object OBJNAME)
    ) ;_ end of setq
    (if (IS-AT-START? OBJNAME PICKPT) ;_ gegen Erstellungsrichtung arbeiten oder in Erstellungsrichtung
      (setq REVERSED NIL) ;_ end of setq
      (setq REVERSED t) ;_ end of setq
    ) ;_ end of if
    (if (> TEXTMODE 1)
      (if REVERSED
        (setq TEXTMODE 3)
      ) ;_ end of if
    ) ;_ end of if
    (while (setq PT (getpoint "\nPunkt für Station wählen: "))
      (setq CPT (vlax-curve-getclosestpointto PL PT))
      (if (not REVERSED)
        (setq LEN (vlax-curve-getdistatpoint PL CPT))
        (setq
          LEN (- (LIN-LENGTH? OBJNAME)
                 (vlax-curve-getdistatpoint PL CPT)
              ) ;_ end of -
        ) ;_ end of setq
      ) ;_ end of if
      (setq IPT (CALCULATE-INSERTATION OBJNAME PICKPT LEN))

      (if (or (equal CPT (vlax-curve-getendpoint PL)) ;_ wenn der berechnete Einfügepunkt auf End-oder Startpunkt liegt,
              (equal CPT (vlax-curve-getstartpoint PL))
          ) ;_ end of or
        (if (not (equal CPT PT)) ;_ ...und dann der gepickte Punkt nicht auch dort war (OFang!),
          (princ
            "\nGeklickter Punkt war VOR Startpunkt oder HINTER Endpunkt des linearen Objekts..."
          ) ;_ end of princ
          (progn
            (if (equal CPT (vlax-curve-getendpoint PL))
              (setq INS-PKT (vlax-curve-getendpoint PL))
              (setq INS-PKT (vlax-curve-getstartpoint PL))
            ) ;_ end of if
            (MS:STATIONPLACING
              PL
              INS-PKT
              (strcat TXTPREFIX
                      (MS:REFORMAT-TXT
                        (rtos (* (+ LEN BEGIN-AT) SCALING)
                              2
                              PRECISION
                        ) ;_ end of rtos
                        "."
                        PRECISION
                      ) ;_ end of MS:REFORMAT-TXT
                      TXTSUFFIX
              ) ;_ end of strcat
              TXTSIZE
              TEXTMODE
            ) ;_ end of MS:STATIONPLACING
          ) ;_ end of progn
        ) ;_ end of if
        (MS:STATIONPLACING
          PL
          IPT
          (strcat TXTPREFIX
                  (MS:REFORMAT-TXT
                    (rtos (* (+ LEN BEGIN-AT) SCALING)
                          2
                          PRECISION
                    ) ;_ end of rtos
                    "."
                    PRECISION
                  ) ;_ end of MS:REFORMAT-TXT
                  TXTSUFFIX
          ) ;_ end of strcat
          TXTSIZE
          TEXTMODE
        ) ;_ end of MS:STATIONPLACING
      ) ;_ end of if
    ) ;_ end while
  ) ;_ end defun
  (princ "\nZu Stationierendes Objekt (Linie, Polylinie oder Spline) wählen: ")
  (if (setq EP (entsel))
    (DOLOOP EP)
  ) ;_ end if
  (princ)
) ;_ end of defun

(defun MS:REFORMAT-TXT (LTXT       DELIMITER  PRECISION  /
                        DECIMAL    FRST       POST-DEC   REAL
                        REST       RETVAL     SUBSTRACTION
                        TEILER OLD-DIMZIN OLD-LUPREC
                       )
  (setq OLD-DIMZIN (getvar "dimzin")
        OLD-LUPREC (getvar "luprec")
  ) ;_ end of setq
  (setvar "dimzin" 1)
  (if (> PRECISION 8)
    (setq PRECISION 8)
  ) ;_ end of if
  (setvar "luprec" PRECISION)
  (setq LTXT (rtos (atof LTXT) 2 PRECISION))
  (if (setq DECIMAL (vl-string-position (ascii ".") LTXT))
    (setq
      POST-DEC (substr
                 (rtos (- (atof LTXT) (atoi (substr LTXT 1 DECIMAL)))
                       2
                       PRECISION
                 ) ;_ end of rtos
                 3
               ) ;_ end of substr
    ) ;_ end of setq
    (setq POST-DEC "")
  ) ;_ end of if
  (setq TEILER       1000.0
        REAL         (atof LTXT)
        FRST         (fix (/ REAL TEILER))
        SUBSTRACTION (* FRST TEILER)
        REST         (itoa (fix (- REAL SUBSTRACTION)))
  ) ;_ end of setq
  (if (not (zerop PRECISION))
    (setq RETVAL (strcat (itoa FRST)
                         " +"
                         (MS:MK000 REST 3)
                         DELIMITER
                         (MS:MK000 POST-DEC PRECISION)
                 ) ;_ end of strcat
    ) ;_ end of setq
    (setq RETVAL (strcat (itoa FRST)
                         " +"
                         (MS:MK000 REST 3)
                 ) ;_ end of strcat
    ) ;_ end of setq
  ) ;_ end of if
  (setvar "dimzin" OLD-DIMZIN)
  (setvar "luprec" OLD-LUPREC)
  RETVAL
) ;_ end of defun

(defun MS:MK000 (WRT ANZAHL /)
  (if (not (zerop ANZAHL))
    (if (/ (strlen WRT) ANZAHL)
      (repeat (- ANZAHL (strlen WRT))
        (setq WRT (strcat "0" WRT))
      ) ;_ end of repeat
    ) ;_ end of if
    (setq wrt "")
  ) ;_ end of if
  WRT
) ;_ end of defun


;;; Mode steuert wie die Texte plaziert werden
;;; Mode = 1 Texte sind immer von vorne und rechts lesbar
;;; Mode = 2 Texte sind immer in Stationierungsrichtung, Polylinie wird in Erstellungsrichtung stationiert
;;; Mode = 3 Texte sind immer in Stationierungsrichtung, Polylinie wird GEGEN Erstellungsrichtung stationiert
(defun MS:STATIONPLACING
       (PL PT TXT TXTSIZE MODE / ANG FD MS PAR PT2 TO TXL)
  (if (not PT)
    (princ "\nUngültig!")
    (progn
      (setq MS  (vla-get-modelspace
                  (vla-get-activedocument (vlax-get-acad-object))
                ) ;_ end of vla-get-modelspace
            TXL (* TXTSIZE (+ (strlen TXT) 2))
            PT  (vlax-curve-getclosestpointto PL PT)
            PAR (vlax-curve-getparamatpoint PL PT)
            FD  (vlax-curve-getfirstderiv PL PAR)
            ANG (angle '(0 0 0) FD)
      ) ;_ end of setq
      (cond
        ((= MODE 1)
         (setq ANG (if (> ANG pi)
                     (+ ANG (/ pi 2))
                     (- ANG (/ pi 2))
                   ) ;_ end of if
         ) ;_ end of setq
        )
        ((= MODE 2)
         (setq ANG (- ANG (/ pi 2))
         ) ;_ end of setq
        )
        ((= MODE 3)
         (setq ANG (+ ANG (/ pi 2))
         ) ;_ end of setq
        )
      ) ;_ end of cond
      (setq PT2 (polar PT ANG TXL))
      (vla-addline MS (vlax-3d-point PT) (vlax-3d-point PT2))
      (setq TO (vla-addtext
                 MS
                 TXT
                 (vlax-3d-point '(0 0 0))
                 TXTSIZE
               ) ;_ end vla-addtext
      ) ;_ end setq
      (vla-put-alignment TO acalignmentbottomright)
      (vla-put-rotation TO ANG)
      (vla-put-textalignmentpoint TO (vlax-3d-point PT2))
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun

;;; Länge eines linearen Objektes berechnen:
;;; -> Elementname
;;; <- Länge des linearen Elements
(defun LIN-LENGTH? (ENAME /)
  (setq ENAME (->VLA-OBJECT ENAME))
  (vlax-curve-getdistatparam
    ENAME
    (vlax-curve-getendparam ENAME)
  ) ;_ end of vlax-curve-getdistatparam
) ;_ end of defun

;;; Funktion gibt Ename zurück, wenn Lisp-Objekt oder vla-Objekt
;;; übergeben worden sind. Ansonsten nil
(defun ->ENAME (ENAME /)
  (cond
    ((= (type ENAME) 'VLA-OBJECT) (vlax-vla-object->ename ENAME))
    ((= (type ENAME) 'ENAME) ENAME)
    (t NIL)
  ) ;_ end of cond
) ;_ end of defun

;;; Funktion gibt vla-Objekt zurück, wenn Lisp-Objekt oder vla-Objekt
;;; übergeben worden sind. Ansonsten nil
(defun ->VLA-OBJECT (ENAME /)
  (cond
    ((= (type ENAME) 'ENAME) (vlax-ename->vla-object ENAME))
    ((= (type ENAME) 'VLA-OBJECT) ENAME)
    (t NIL)
  ) ;_ end of cond
) ;_ end of defun

;;; ermittelt, ob der Pickpunkt näher am Start-oder End-Punkt des linearen Objekts war
;;; das ist wichtig für die Abstandsberechnung (gegen oder in Objektrichtung rechnen?)
;;; -> Obj = Elementname
;;; -> Pkt = Pickpunkt auf Element
(defun IS-AT-START? (OBJ PKT /)
  (< (2P-DIST OBJ PKT (START-PKT? OBJ)) ;_ Ist der Pickpunkt näher am Startpunkt?
     (2P-DIST OBJ PKT (END-PKT? OBJ))
  ) ;_ end of <
) ;_ end of defun

;;; Endpunkt in WKS für lineares Objekt ermitteln
(defun END-PKT? (ENAME /)
  (vlax-curve-getendpoint (->VLA-OBJECT ENAME))
) ;_ end of defun

;;; Startpunkt in WKS für lineares Objekt ermitteln
(defun START-PKT? (ENAME /)
  (vlax-curve-getstartpoint (->VLA-OBJECT ENAME))
) ;_ end of defun

;;; Berechnung der Länge zwischen zwei Punkten
;;; die auf einer Polylinie liegen
;;; -> Punkt1, Punkt2 und Elementname
;;; <- Länge zwischen diesen Punkten
(defun 2P-DIST (ENAME PT1 PT2 /)
  (setq ENAME (->VLA-OBJECT ENAME))
  (abs (- (vlax-curve-getdistatpoint
            ENAME
            (vlax-curve-getclosestpointto
              ENAME
              PT1
            ) ;_ end of vlax-curve-getclosestpointto
          ) ;_ end of vlax-curve-getDistAtPoint
          (vlax-curve-getdistatpoint
            ENAME
            (vlax-curve-getclosestpointto
              ENAME
              PT2
            ) ;_ end of vlax-curve-getClosestPointTo
          ) ;_ end of vlax-curve-getdistatpoint
       ) ;_ end of -
  ) ;_ end of abs
) ;_ end of defun

;;; Berechnet den Punkt auf einem linearen Objekt
;;; -> Obj = Elementname
;;; -> Pkt = Pickpunkt auf Element
;;; -> Abstand, der abzutragen ist
(defun CALCULATE-INSERTATION (OBJ PKT ABSTAND /)
  (if (IS-AT-START? OBJ PKT)
    (FIND-PT OBJ ABSTAND)
    (FIND-PT-REVERSE OBJ ABSTAND)
  ) ;_ end of if
) ;_ end of defun

;;; Punkt finden, der in einem bestimmten Abstand zum Startpunkt liegt.
;;; IN RICHTUNG des linearen Objektes.
;;; -> Abstand, Element
;;; <- Welt-Koordinate oder nil (wenn nicht auf Element!)
(defun FIND-PT (ENAME ABSTAND /)
  (vlax-curve-getpointatdist
    (->VLA-OBJECT ENAME)
    ABSTAND
  ) ;_ end of vlax-curve-getpointatdist
) ;_ end of defun

;;; Punkt finden, der in einem bestimmten Abstand zum ENDpunkt liegt.
;;; IN RICHTUNG des linearen Objektes.
;;; -> Abstand, Element
;;; <- Welt-Koordinate oder nil (wenn nicht auf Element!)
(defun FIND-PT-REVERSE (ENAME ABSTAND /)
  (setq ENAME (->VLA-OBJECT ENAME))
  (vlax-curve-getpointatdist
    ENAME
    ;; Differenz zwischen Geamtlänge des Elements
    ;; und Distanz ergiebt Länge vom Startpunkt
    (- (vlax-curve-getdistatparam
         ENAME
         (vlax-curve-getendparam ENAME)
       ) ;_ end of vlax-curve-getdistatparam
       ABSTAND
    ) ;_ end of -
  ) ;_ end of vlax-curve-getpointatdist
) ;_ end of defun


;;; Punkt finden, der in einem Abstand RELATIV zu einem Punkt
;;; auf dem linearen Objekt liegt.
;;; Abstand NEGATIV angeben für relativ ENTGEGEGEN der Richtung!
;;; -> Abstand, Element, Startpunkt
;;; <- Welt-Koordinate oder nil (wenn nicht auf Element!)
(defun FIND-PT-RELATIVE (ENAME PKT ABSTAND /)
  (setq ENAME (->VLA-OBJECT ENAME))
  (vlax-curve-getpointatdist
    ENAME
    (+ (vlax-curve-getdistatpoint
         ENAME
         (vlax-curve-getclosestpointto
           ENAME
           PKT
         ) ;_ end of vlax-curve-getclosestpointto
       ) ;_ end of vlax-curve-getdistatpoint
       ABSTAND
    ) ;_ end of +
  ) ;_ end of vlax-curve-getpointatdist
) ;_ end of defun


(princ "\nStationierungsroutinen")
(princ "\nAufruf: STATION[2], STATION-FROM[2] oder TEST[2]")
(princ)