(Defun C:URSP-BEM ()
  (Setvar "Cmdecho" 0)
  (Setq DS (Getvar "Dimscale"))
  (Setq DL (Getvar "Dimlfac"))
  (Setq EX (Getvar "Dimexo"))
  (Setq TI (Getvar "Dimtih"))
  (Setq C '(= 0 (Cdr (Assoc 40 (Tblsearch "Style" (Getvar "Textstyle"))))))
  (If
    (= nil BASE)
      (Setq BASE (Getpoint "\nUrsprungspunkt fuer Bemassungen bestimmen: "))
  )
  (If
    (= 0 (Setq TX (Cdr (Assoc 40 (Tblsearch "Style" (Getvar "Textstyle"))))))
      (Progn
        (Setq TX (Getvar "Dimtxt"))
        (Setq B (* (/ TX 2.0) DS))
      )
      (Progn
        (Setq B (/ TX 2.0))
      )
  )
  (Command "OFANG" "End,Sch,Zen")
  (Setq P1 (Getpoint "\nErster Punkt: "))
  (Command "OFANG" "Kei")
  (Setq P2 (Getpoint P1"\nZweiter Punkt: "))
  (If
    (> (Abs (- (Car P1) (Car P2))) (Abs (- (Cadr P1) (Cadr P2))))
      (Progn
        (Setq P2 (List (Car P2) (Cadr P1)))
        (Basehorz)
      )
      (Progn
        (Setq P2 (List (Car P1) (Cadr P2)))
        (Basevert)
      )
  )
  (Command "LINIE" P1 P2 "")
  (Princ)
)

(Defun Basehorz ()
  (Princ "\nBemassungstext <")
  (Princ (Setq D (Rtos (* DL (Abs (- (Cadr P1) (Cadr BASE))))
    (Getvar "Lunits") (Getvar "Luprec"))))
  (Setq A (Getstring t ">: "))
  (If
    (= "" A)
      (Setq A D)
  )
  (If
    (<= (Car P2) (Car P1))
      (Progn
        (Setq P1 (List (- (Car P1) (* EX DS)) (Cadr P1)))
        (Setq P3 (List (- (Car P2) B) (- (Cadr P2) B)))
        (If
          (Eval C)
            (Command "Text" "R" P3 (* TX DS) "0" A)
            (Command "Text" "R" P3 "0" A)
        )
      )
      (Progn
        (Setq P1 (List (+ (Car P1) (* EX DS)) (Cadr P1)))
        (Setq P3 (List (+ (Car P2) B) (- (Cadr P2) B)))
        (If
          (Eval C)
            (Command "Text" P3 (* TX DS) "0" A)
            (Command "Text" P3 "0" A)
        )
      )
  )
)

(Defun Basevert ()
  (Princ "\nBemassungstext <")
  (Princ (Setq D (Rtos (* DL (Abs (- (Car P1) (Car BASE))))
    (Getvar "Lunits") (Getvar "Luprec"))))
  (Setq A (Getstring t ">: "))
  (If
    (= "" A)
      (Setq A D)
  )
  (If
    (<= (Cadr P2) (Cadr P1))
      (Progn
        (Setq P1 (List (Car P1) (- (Cadr P1) (* EX DS))))
        (If
          (= TI 1)
            (Progn
              (Setq P3 (List (Car P2) (- (Cadr P2) (* 3 B))))
              (If
                (Eval C)
                  (Command "Text" "Z" P3 (* TX DS) "0" A)
                  (Command "Text" "Z" P3 "0" A)
              )
            )
            (Progn
              (Setq P3 (List (+ (Car P2) B) (- (Cadr P2) B)))
              (If
                (Eval C)
                  (Command "Text" "R" P3 (* TX DS) "90" A)
                  (Command "Text" "R" P3 "90" A)
              )
            )
        )
      )
      (Progn
        (Setq P1 (List (Car P1) (+ (Cadr P1) (* EX DS))))
        (If
          (= TI 1)
            (Progn
              (Setq P3 (List (Car P2) (+ (Cadr P2) B)))
              (If
                (Eval C)
                  (Command "Text" "Z" P3 (* TX DS) "0" A)
                  (Command "Text" "Z" P3 "0" A)
              )
            )
            (Progn
              (Setq P3 (List (+ (Car P2) B) (+ (Cadr P2) B)))
              (If
                (Eval C)
                  (Command "Text" P3 (* TX DS) "90" A)
                  (Command "Text" P3 "90" A)
              )
            )
        )
      )
  )
)

(Defun C:BEM-URSP ()
  (Setq BASE (Getpoint "\nUrsprungspunkt fuer Bemassungen bestimmen: "))
)

