(defun c:abrichten ()
  (command "_.UNDO" "_END")
  (command "_.UNDO" "_GROUP")
  (osm0)
  (setq orthm (getvar "orthomode"))
  (command "ORTHOMODE" 0)
  (princ "\nLinien werden bis zur Schnittkante gedehnt oder gestutzt")
  (princ "\nEs wird immer der kürzere Linienabschnitt verändert")
  (setq skant2 nil) 	
  (setq skant1 (entsel "\n(Erste) Schnittkante wählen: "))
  (redraw (car skant1) 3)
  (if skant1
    (progn
      (pkterück skant1)
      (setq pkta1 p1)
      (setq pkta2 p2)
    )
  )
  (if (setq skant2 (entsel "\nZweite Schnittkante wählen? : <Keine> "))
    (progn
      (redraw (car skant2) 3)
      (pkterück skant2)
      (setq pktb1 p1)
      (setq pktb2 p2)
    )
  )
  (setq lin (entsel "\nLinie, die abgerichtet werden soll: "))
  (while lin
    (if (= "LINE" (cdr (assoc 0 (entget (car lin)))))
      (progn
        (pkterück lin)
        (setq pktc1 p1)
        (setq pktc2 p2)
        (setq schpkt1 (inters pkta1 pkta2 pktc1 pktc2 nil))
        (command "_.CHANGE" lin "" schpkt1)
      )
      (alert "Polylinien können nicht abgerichtet werden")
    )  
    (if skant2
      (progn
        (setq schpkt2 (inters pktb1 pktb2 pktc1 pktc2 nil))
        (command "_.CHANGE" lin "" schpkt2)
      )
    )
    (setq lin (entsel "\nLinie, die abgerichtet werden soll: "))
  )
  (if skant1 (redraw (car skant1) 4))
  (if skant2 (redraw (car skant2) 4))
  (osmz)
  (command "ORTHOMODE" orthm)
  (command "_.UNDO" "END")
)
;----------------------------------------------
(defun pkterück (obj)
  (setq art (cdr (assoc 0 (entget (car obj)))))
  (cond
    ((= art "LINE")
     (setq p1 (cdr (assoc 10 (entget (car obj)))))
     (setq p2 (cdr (assoc 11 (entget (car obj)))))
    )
    ((= art "LWPOLYLINE")	;P1 und P2 werden durch die Funktion (polyanalyse) erzeugt
;;;(print "ist LWpoly")    
     (setq ptlist (plist (car obj)))
;;;(ppp 'ptlist)
     (polyanalyse (cadr obj) ptlist)
     (alert "Achtung LW-Polylinie!")
    )
    ((= art "POLYLINE")
     (alert "Achtung Polylinie!")
     (setq obj (nentselp (cadr obj)))
     (setq p1 (cdr (assoc 10 (entget (car obj)))))
     (setq p2 (cdr (assoc 11 (entget (car obj)))))
    )
  )
)