;;;HEILEN
;;;
;;;Verbindet
;;;		Linie/Linie
;;;		Polylinie/Polylinie
;;;		Linie/Polylinie
;;;	miteinander, insofern diese in der Flucht liegen.
;;;
;;;AutoCAD-Release:	2000
;;;
;;;Version:		2/3 - 07.02.2001
;;;
;;;Startaufruf:		heilen
;;;
;;;benötigte Dateien:   heilen.lsp
;;;
;;;Einschränkungen:	nicht bekannt
;;;
;;;Programmiert:	Holger Brischke
;;;			Metro Real Estate Management GmbH
;;;			DV-CAD
;;;			66123 Saarbrücken
;;;			Bertha-v-Suttner-Str. 5
;;;			[0049]-(0)681/8104-2584
;;;			brischkh@mre.de
;;;
;;;
;;;
;;;--MAIN----MAIN----MAIN----MAIN----MAIN----MAIN----MAIN----MAIN----MAIN----MAIN----MAIN----MAIN----MAIN----MAIN--
;;;
(defun c:heilen ( / lin1 lin2 ellin1 ellin2 ellin1li ellin2li lin1typ lin2typ
		 apt1 ept1 segm1 apt2 ept2 segm2 erg ergliste)
  (setvar "CMDECHO" 0)
  (command "_.undo" "_group")
  ;Abfrage der zu verbindenden Linien
  ;Wird immer die gleiche Linie angewählt muß noch einmal gewählt werden
  (while (= T (or;Schleife zum Wiederholen der Linienauswahl solange Linie1=Linie2
		(eq (car lin1)(car lin2))
		(or
		  (= lin1 nil)
		  (= lin2 nil)
		)
	      )
	 )
    (setq lin1 nil)
    (setq lin2 nil)
    (while (= lin1 nil);Schleife zum WDh der Auswahl von Linie1 solange nichts oder keine Linie/PLinie gewählt wurde
      (setq lin1 (nentsel "\n Erste Linie"))
      (if (= nil (or
		   (= lin1 nil)
		   (= "LINE" (cdr (assoc 0 (entget(car lin1)))))
		   (= "LWPOLYLINE" (cdr (assoc 0 (entget(car lin1)))))
		 );or
	     );=
	(progn (setq lin1 nil)(princ "\nKeine Linie/Polyline gewählt!"))
      )
    )
    (redraw (car lin1) 3)
    (while (= lin2 nil);Schleife zum WDh der Auswahl von Linie2 solange nichts oder keine Linie/PLinie gewählt wurde
      (setq lin2 (nentsel "\nZweite Linie"))
      (if (= nil (or
		   (= lin2 nil)
		   (= "LINE" (cdr (assoc 0 (entget(car lin2)))))
		   (= "LWPOLYLINE" (cdr (assoc 0 (entget(car lin2)))))
		 );or
	     );=
	(progn (setq lin2 nil)(princ "\nKeine Linie/Polyline gewählt!"))
      )
    )
    (redraw (car lin2) 3)
  );while
  (redraw (car lin1) 4)
  (redraw (car lin2) 4)
  (setq ellin1 (car lin1))
  (setq ellin2 (car lin2))
  (setq ellin1li (entget ellin1))
  (setq ellin2li (entget ellin2))
  (setq lin1typ (cdr (assoc 0 ellin1li)))
  (setq lin2typ (cdr (assoc 0 ellin2li)))
  ;Unterscheidung ob Linien oder Polylinien gewählt wurden
  ;Zusammenfassen der Anfangs und Endpunkte der gewählten Linien
  (if (= lin1typ "LINE");bei Linien nur Anfangsund Endpunkt
    (setq ptliste1 (linept ellin1li));SUB die die Punkte rausfiltert
  )
  (if (= lin2typ "LINE")
    (setq ptliste2 (linept ellin2li))
  )
  (if (= lin1typ "LWPOLYLINE");bei Polylinien Anfangs und Endpunkt des Anfangs und Endsementes
    (progn
      (if (< 2 (cdr(assoc 90 ellin1li)));Falls Polylinie nur 2 Kontrollpunkte hat ->dann soll sie wie eine Linie behandelt werden
	(setq ptliste1 (plinept ellin1li));Suchen Koordinaten Start und Endsegment
	(progn
	  (setq lin1typ "LINE")
	  (if(= T (or;Stellt diese Polyline jedoch nur einen Bogen dar, dann soll nichts verbunden werden
		    (/= 0.0 (cdr(assoc 42 ellin1li)))
		    (/= 0.0 (cdr(assoc 42 (reverse ellin1li))))
		  )
	     )
	    (setq ptliste1 nil)
	    (setq ptliste1 (plinept ellin1li))
	  )
	)
      )
    )
  )
  (if (= lin2typ "LWPOLYLINE")
    (progn
      (if (< 2 (cdr(assoc 90 ellin2li)));Falls Polylinie nur 2 Kontrollpunkte hat ->dann soll sie wie eine Linie behandelt werden
	(setq ptliste2 (plinept ellin2li));Suchen Koordinaten Start und Endsegment
	(progn
	  (setq lin2typ "LINE")
	  (if(= T (or
		    (/= 0.0 (cdr(assoc 42 ellin2li)))
		    (/= 0.0 (cdr(assoc 42 (reverse ellin2li))))
		  )
	     )
	    (setq ptliste2 nil)
	    (setq ptliste2 (plinept ellin2li))
	  )
	)
      )
    )
  )
  (arxload "geomcal.arx" (princ "."))
  ;Überprüfung ob Liniensegmente der gew. Linien in der Flucht liegen
  (setq segz1 0)
  (foreach segm1 ptliste1
    (setq apt1 (nth 0 segm1))
    (setq ept1 (nth 1 segm1))
    (setq segz2 0)
    (foreach segm2 ptliste2
      (setq apt2 (nth 0 segm2))
      (setq ept2 (nth 1 segm2))
      (setq erg (segmentepr apt1 ept1 apt2 ept2));SUB-aufruf zum Überprüfen der Flucht - erg =T oder nil
      (if erg;wenn erg = T werden die relevanten Elemente, Typen und Punkte in einer Liste zusammengefaßt
	(if (= ergliste nil)
	  (setq ergliste (list (list ellin1 lin1typ (nth segz1 ptliste1))(list ellin2 lin2typ (nth segz2 ptliste2))))
	  (setq ergliste (append ergliste (list (list ellin1 lin1typ (nth segz1 ptliste1))(list ellin2 lin2typ (nth segz2 ptliste2)))))
	)
	(princ "...")
      )
      (setq segz2 (1+ segz2))
    )
    (setq segz1 (1+ segz1))
  )
  ;Auswertung
  ;Unterscheidung ob die gew. Element entweder
  			;Linie/Linie	-> SUB doneuLINE
  			;Polylinie/Polylinie	-> SUB doneuPLINE
  			;Polyline/Linie oder Linie/Polylinie	-> SUB doneuPLINEmix
  (if ergliste
    (progn
      (if (/= 2 (length ergliste));Wenn mehrere Segmente gefunden wurden, die verbunden werden könnten
	(setq ergliste (welcheoffnung lin1 lin2 ergliste));Dann überprüfe den Klickpunkt, welche Segmente gewählt wurden
      )
      (cond
	((= lin1typ lin2typ "LINE")
	 (doneuLINE ergliste)
	)
	((= lin1typ lin2typ "LWPOLYLINE")
	 (doneuPLINE ergliste)
	)
	(T;sonst
	 (doneuPLINEmix ergliste)
	)
      );cond
    );progn
    (princ "\nNichts verbunden\n")
  )
  (command "_.undo" "_end")
  (princ)
)
;;;
;;;
;;;
(defun welcheoffnung (line1 line2 eliste / )
  (setq klkpt1 (cadr line1))
  (setq klkpt2 (cadr line2))
  (setq rdz 0)
  (repeat 2
    (setq ap1 (car (nth 2 (nth rdz eliste))))
    (setq ep1 (cadr (nth 2 (nth rdz eliste))))
    (setq ap2 (car (nth 2 (nth (1+ rdz) eliste))))
    (setq ep2 (cadr (nth 2 (nth (1+ rdz) eliste))))
    (if (= rdz 0)
      (setq erg (klkptpr ap1 klkpt1 ep1))
      (setq erg (klkptpr ap2 klkpt2 ep2))
    )
    (if erg
      (setq ergz rdz)
    )
    (setq erg nil)
    (setq rdz (+ rdz 2))
  )
  (if (= ergz 0)
    (setq uliste (list (nth 0 eliste)(nth 1 eliste)))
    (setq uliste (list (nth 2 eliste)(nth 3 eliste)))
  )
  uliste
)
;;;
;;;
;;;
;;;
;;;-SUB--SUB--SUB--SUB--SUB--SUB--SUB--SUB-
;;;
(defun doneuLINE (liliste / ap1 ep1 ap2 ep2 prli maxdist maxlist ap ep zlay nline nlineli)
  (setq ap1 (car (nth 2 (nth 0 liliste))))
  (setq ep1 (cadr (nth 2 (nth 0 liliste))))
  (setq ap2 (car (nth 2 (nth 1 liliste))))
  (setq ep2 (cadr (nth 2 (nth 1 liliste))))
  ;Liste erstellen (Distanz(pt1 pt2) pt1 pt2)
  (setq prli (list (distance ap1 ap2) ap1 ap2 (distance ap1 ep2) ap1 ep2 (distance ep1 ap2) ep1 ap2 (distance ep1 ep2) ep1 ep2))
  ;maximalwert der Liste abfragen
  (setq maxdist (max (nth 0 prli)(nth 3 prli)(nth 6 prli)(nth 9 prli)))
  ;Listenelement mit der maxDistanz suchen, dann ist Folgeelement ap danach ep
  (setq maxlist (member maxdist prli))
  (setq ap (nth 1 maxlist))
  (setq ep (nth 2 maxlist))
  ;SUB wegen Layer des Ergebniselementes
  (setq zlay (prlinlay (car (nth 0 liliste)) (car (nth 1 liliste))))
  (entdel (car (nth 0 liliste)));Linie 1 löschen
  ;Linie 2 aktualisieren mit Ziellayer, ap und ep
  (setq nline (car (nth 1 liliste)))
  (setq nlineli (entget nline))
  (setq nlineli (subst (cons 8 zlay)(assoc 8 nlineli) nlineli))
  (setq nlineli (subst (cons 10 ap)(assoc 10 nlineli) nlineli))
  (if (assoc 11 nlineli);wenn GK11 nicht gefunden wird -> dann ist Linie2 eine Polylinie mit nur 2 Kontrollpunkten
    (progn;Linie 2 =LINE
      (setq nlineli (subst (cons 11 ep)(assoc 11 nlineli) nlineli))
      (entmod nlineli)
    )
    (progn;Linie2 = POLYLINE mit nur 2 KP
      (entmake (list
	       '(0 . "LINE")
	       '(100 . "AcDbEntity")
	       (assoc 67 (entget(car(nth 1 liliste))))
	       (assoc 410 (entget(car(nth 1 liliste))))
	       (cons 8  zlay)
	       '(100 . "AcDbLine")
	       (cons 10 ap)
	       (cons 11 ep)
	       (assoc 210 (entget(car(nth 1 liliste))))
	       )
      )
      (entdel (car (nth 1 liliste)));Linie 2 löschen
    )
  )
)
;;;
;;;
;;;
;;;-SUB--SUB--SUB--SUB--SUB--SUB--SUB--SUB-
;;;
(defun doneuPLINEmix (liliste / ap1 ep1 ap2 ep2 prli maxdist maxlist ap ep zlay nline nlineli
		      prli prdist plkpli plleer anzkpn kosys)
  (if (/= "LINE" (nth 1 (nth 0 liliste)));Sicherstellen, daß erstesElement=LINE ist
    (setq liliste (reverse liliste))
  )
  (setq ap1 (car (nth 2 (nth 0 liliste))))
  (setq ep1 (cadr (nth 2 (nth 0 liliste))))
  (setq ap2 (car (nth 2 (nth 1 liliste))))
  (setq ep2 (cadr (nth 2 (nth 1 liliste))))
  ;Liste erstellen (Distanz(pt1 pt2) pt1 pt2)
  (setq prli (list (distance ap1 ap2) ap1 ap2 (distance ep1 ap2) ep1 ap2))
  ;maximalwert der Liste abfragen
  (setq maxdist (max (nth 0 prli)(nth 3 prli)))
  ;Listenelement mit der maxDistanz suchen, dann ist Folgeelement ap danach ep
  (setq maxlist (member maxdist prli))
  (setq ap (nth 1 maxlist))
  (setq ep (nth 2 maxlist))
  (setq prdist (distance ap ep2));es kann sein, daß der Endpunkt der PL von der zu verbindenden Linie weggerichtet ist
  ;SUB wegen Layer des Ergebniselementes
  (setq zlay (prlinlay (car (nth 0 liliste)) (car (nth 1 liliste))))
  (entdel (car (nth 0 liliste)));Linie löschen
  ;Linie 2 aktualisieren mit Ziellayer, Verlängern der Polyline bis zum Endpunkt der Linie
  (setq nline (car (nth 1 liliste)))
  (setq nlineli (entget nline))
  (setq nlineli (subst (cons 8 zlay)(assoc 8 nlineli) nlineli))
  (if (< prdist maxdist)
    (setq nlineli (subst (cons 10 ap)(cons 10 ep2) nlineli));der Endpunkt der PL zeigt in Richtung der zu verbindenden Linie
    (progn;der Endpunkt der PL ist von der zu verbindenden Linie weggerichtet
      ;Polylinienelementliste muß dann neu zus-bastelt werden!
      (setq plkpli (bauplkpli (car (nth 1 liliste))))
      (setq prli (member (cons 10 ep2) plkpli));feststellen ob der fluchtende Endpunkt am Anfang oder Ende der PolylinienKPliste steht
      (if (= (length plkpli)(length prli))
	(setq plkpli (append (List (cons 10 ap) (cons 40 0.0)(cons 41 0.0)(cons 42 0.0)) plkpli));kp vorn dran
	(setq plkpli (append  plkpli (List (cons 10 ap) (cons 40 0.0)(cons 41 0.0)(cons 42 0.0))));KP hinten dran
      )
      (setq plleer (entget (car (nth 1 liliste))))
      (setq kosys (assoc 210 plleer))
      (setq anzkpn (cons 90 (/ (length plkpli) 4)))
      (setq plleer (reverse (member (assoc 39 (reverse plleer))(reverse plleer))))
      ;resultierende Polylinie erzeugen (modifizieren der 2.Linie)
      (setq nlineli (append plleer plkpli (list kosys)))
      (setq nlineli (subst (cons 8 zlay)(assoc 8 nlineli) nlineli))
      (setq nlineli (subst anzkpn (assoc 90 nlineli) nlineli))
    )
  )
  (entmod nlineli)
)
;;;
;;;
;;;
;;;-SUB--SUB--SUB--SUB--SUB--SUB--SUB--SUB-
;;;
(defun doneuPLINE (liliste / ap1 ep1 ap2 ep2 prli maxdist maxlist ap ep
		   zlay nline nlineli kpliste kplistf plleer plkpli1 plkpli2
		   plkpzli1 plkpzli2 kplistanfg kplistende kosys anzkpn kploesch
		   distapap distepep distep1ap2 distep1ep2 distep2ap1 distep2ep1
		   )
  (setq plkpli1 (bauplkpli (car (nth 0 liliste))))
  (setq plkpli2 (bauplkpli (car (nth 1 liliste))))
  (setq ap1 (car (nth 2 (nth 0 liliste))))
  (setq ep1 (cadr (nth 2 (nth 0 liliste))))
  (setq ap2 (car (nth 2 (nth 1 liliste))))
  (setq ep2 (cadr (nth 2 (nth 1 liliste))))
  ;;; falls Polylinienenden voneinander weg gerichtet sind und dennoch in der Flucht liegen
  ;;; dann dürfen die Endkontrollpunkte nicht gelöscht werden
  ;;; falls Polylinienenden voneinander in die gleiche Richtung gerichtet sind und in der Flucht liegen
  ;;; dann darf nur ein Endkontrollpunkt gelöscht werden
  ;Liste erstellen (Distanz(pt1 pt2) pt1 pt2)
  (setq distapap (distance ap1 ap2))
  (setq distepep (distance ep1 ep2))
  (setq distep1ap2 (distance ep1 ap2))
  (setq distep1ep2 (distance ep1 ep2))
  (setq distep2ap1 (distance ep2 ap1))
  (setq distep2ep1 (distance ep2 ep1))
  (cond
    ((> distepep distapap)
     (setq kploesch 0)
    )
    ((< distep1ap2 distep1ep2)
     (setq kploesch 3)
    )
    ((< distep2ap1 distep2ep1)
	(setq kploesch 4)
    )
    (T
     (setq kploesch 1)
    )
  )
  ;zum besseren Handhaben der zusammengehörigen Gruppencodes der Kontrollpunkte (GK 10,40,41,42)
  ;werden diese jeweils zu einem Listenelement zusammengefaßt
  (setq plkpzli1 (zusfaskp plkpli1))
  (setq plkpzli2 (zusfaskp plkpli2))
  ;die Polylinienrichtung muß, um diese zu einer Polylinie zusfassen zu können in gleiche Richtungen laufen
  ;d.h. die Reihenfolge der Kontrollpunkte sollten die gleiche sein betrachtet man die Polylinien als eine Polylinie
  ; ist diese Bedingung nicht erfüllt muß die Reihenfolge der Kontrollpunkte umgekehrt werden
  (if (= T (equal ep1 (cdr (nth 0 plkpli1)) 0.00000000001))
    (setq plkpzli1 (umkehrenPL plkpzli1));Umkehren der Polyline & zu Löschenden KP an letzte Stelle Verschieben
  )
  (if (/= T (equal ep2 (cdr (nth 0 plkpli2)) 0.00000000001))
    (setq plkpzli2 (umkehrenPL plkpzli2));Umkehren der Polyline & zu Löschenden KP  an erste Stelle Verschieben
  )
  ;Die aus dem HEILEN resultierende Polylinie hat je nach richtung der Polylinienenden bis zu 2KP weniger
  ;(die Endpunkte der beiden PLine) deshalb...
  (cond
   ((= 1 kploesch);beide Endpunkte werden gelöscht
    ;... letzten KP löschen Linie 1
    (setq kplistanfg (reverse (member (nth 1 (reverse plkpzli1))(reverse plkpzli1))))
    ;...ersten KP löschen Linie 2
    (setq kplistende (member (nth 1 plkpzli2) plkpzli2))
    ;KPListe der resultierenden Polyline bauen
    (setq kpliste (append kplistanfg kplistende))
   )
   ((= 0 kploesch);Keiner Endpunkt wird gelöscht
    (setq kpliste (append plkpzli1 plkpzli2))
   )
   ((= 3 kploesch)
    ;... letzten KP löschen Linie 1
    (setq kplistanfg (reverse (member (nth 1 (reverse plkpzli1))(reverse plkpzli1))))
    (setq kplistende plkpzli2)
    ;KPListe der resultierenden Polyline bauen
    (setq kpliste (append kplistanfg kplistende))
   )
   ((= 4 kploesch)
    (setq kplistanfg  plkpzli1)
    ;...ersten KP löschen Linie 2
    (setq kplistende (member (nth 1 plkpzli2) plkpzli2))
    ;KPListe der resultierenden Polyline bauen
    (setq kpliste (append kplistanfg kplistende))
   )
  )
  ;die zusammengefaßten Gruppencodes wieder in eine Liste hintereinander schreiben
  (foreach pkt kpliste
    (if (= kplistf nil)
      (setq kplistf (list(car pkt)(cadr pkt)(caddr pkt)(cadddr pkt)))
      (setq kplistf (append kplistf (list(car pkt)(cadr pkt)(caddr pkt)(cadddr pkt))))
    )
  )
  ;Vorbereitung zum Erzeugen der Modifizierten Polylinie
  (setq plleer (entget (car (nth 1 liliste))))
  (setq kosys (assoc 210 plleer))
  (setq anzkpn (cons 90 (/ (length kplistf) 4)))
  (setq plleer (reverse (member (assoc 39 (reverse plleer))(reverse plleer))))
  ;SUB wegen Layer des Ergebniselementes
  (setq zlay (prlinlay (car (nth 0 liliste)) (car (nth 1 liliste))))
  (entdel (car (nth 0 liliste)));Löschen der 1.Polylinie
  ;resultierende Polylinie erzeugen (modifizieren der 2.Linie)
  (setq nlineli (append plleer kplistf (list kosys)))
  (setq nlineli (subst (cons 8 zlay)(assoc 8 nlineli) nlineli))
  (setq nlineli (subst anzkpn (assoc 90 nlineli) nlineli))
  (entmod nlineli)
)
;;;
;;;
;;;-SUB--SUB--SUB--SUB--SUB--SUB--SUB--SUB-
;;;
;;;
(defun bauplkpli (elpli / tmplist);Bauen einer Liste, die nur die Kontrollpunkte enthält
  (setq tmplist (member (assoc 10 (entget elpli)) (entget elpli)));vorderen Teil abschneiden
  ;Hinteren Teil abschneiden - dazu umkehren und wieder den vorderen Teil abschneiden - dann wieder umkeheren
  (setq tmplist (reverse tmplist))
  (setq tmplist (member (assoc 42 tmplist) tmplist))
  (setq tmplist (reverse tmplist))
  tmplist
)
;;;
;;;
;;;
;;;-SUB--SUB--SUB--SUB--SUB--SUB--SUB--SUB-
;;;
(defun zusfaskp (plkpli / wdhz uglist)
  (setq lenli (length plkpli))
  (setq wdhz 0)
  (repeat (/ lenli 4)
    (setq zuslist (list
		    (nth (* 4 wdhz) plkpli)
		    (nth (+ 1 (* 4 wdhz)) plkpli)
		    (nth (+ 2 (* 4 wdhz)) plkpli)
		    (nth (+ 3 (* 4 wdhz)) plkpli)
		  )
    );setq
    (setq wdhz (1+ wdhz))
    (if (= uglist nil)
      (setq uglist (list zuslist))
      (setq uglist (append uglist (list zuslist)))
    )
  )
  uglist
)
;;;
;;;
;;;
;;;-SUB--SUB--SUB--SUB--SUB--SUB--SUB--SUB-
;;;
(defun umkehrenPL (pktliste / pktwertli ffwertli rdz ugalist ffwertlist tmpfflist
		   pktwert ffwert uwert neuwert wert tmpz)
  (foreach elem pktliste;Trennen der GK 10 elemente vom Rest
    (setq pktwert (assoc 10 elem));10er-Liste
    (setq ffwert (member (assoc 40 elem) elem));Restliste
    (if (= ffwertli nil)
      (setq ffwertli (list ffwert))
      (setq ffwertli (append ffwertli (list ffwert)))
    )
    (if (= pktwertli nil)
      (setq pktwertli (list pktwert))
      (setq pktwertli (append pktwertli (list pktwert)))
    )
  )
  (setq pktwertli(reverse pktwertli));GK 10 Elemente umkeheren
  ;Wenn Kreisbögen vorhanden sind, muß die Richtung der Ausbuchtung umgekehrt werden
  (foreach wert ffwertli
    (setq uwert (nth 2 wert))
    (setq neuwert (cons 42 (* -1 (cdr uwert))));umkehren = *(-1)
    (setq ffwert (subst neuwert (assoc 42 wert) wert))
    (if (= ffwertlist nil)
      (setq ffwertlist (list ffwert))
      (setq ffwertlist (append ffwertlist (list ffwert)))
    )
  )
  ;folgende Schleife: letztes Element der Restliste  löschen und Liste umkehren
  (setq tmpz 1)
  (repeat (- (length ffwertlist) 1)
    (if (= tmpfflist nil)
      (setq tmpfflist (list (nth tmpz (reverse ffwertlist))))
      (setq tmpfflist (append tmpfflist (list (nth tmpz (reverse ffwertlist)))))
    )
    (setq tmpz (1+ tmpz))
  )
  (setq ffwertlist tmpfflist)
  (setq ffwertlist (append  ffwertlist (list(list (cons 40 0.0)(cons 41 0.0)(cons 42 0.0)))));neues Letztes Element anhängen
  (setq ffwertli ffwertlist)
  (setq rdz 0);Liste wieder zusammenbauen (GK10) zu Restliste
  (foreach selpkt pktwertli
    (if (= ugalist nil)
      (setq ugalist (list(append (list selpkt) (nth rdz ffwertli))))
      (setq ugalist (append ugalist (list(append (list selpkt) (nth rdz ffwertli)))))
    )
    (setq rdz (1+ rdz))
  )
  ugalist
)
;;;
;;;
;;;
;;;-SUB--SUB--SUB--SUB--SUB--SUB--SUB--SUB-
;;;
(defun prlinlay (el1 el2 / lay1 lay2 ziellay laylin)
  (setq lay1 (cdr (assoc 8 (entget el1))))
  (setq lay2 (cdr (assoc 8 (entget el2))))
  (if (/= lay1 lay2)
    (progn
      (while (= laylin nil)
	(setq laylin (nentsel "\n Unterschiedliche Layer!Linie wählen mit Ziellayer:"))
      )
      (setq ziellay (cdr (assoc 8 (entget (car laylin)))))
    )
    (setq ziellay lay1);Auswahl einarbeiten!!!
  )
  ziellay
)
;;;
;;;
;;;
;;;-SUB--SUB--SUB--SUB--SUB--SUB--SUB--SUB-
;;;
(defun linept (elliste / apt ept ugliste)
  (setq apt (cdr (assoc 10 elliste)))
  (setq ept (cdr (assoc 11 elliste)))
  (setq ugliste (list (list apt ept)))
  ugliste
)
;;;
;;;
;;;
;;;-SUB--SUB--SUB--SUB--SUB--SUB--SUB--SUB-
;;;
(defun plinept (elliste / apt ept ugliste wdh wdhz);Suchen Koordinaten Start und Endsegment
  (setq anzkp (cdr (assoc 90 elliste)))
  (if (= anzkp 2)
    (setq wdh 1)
    (setq wdh 2)
  )
  (setq wdhz 1)
  (repeat wdh
    (setq apt (cdr (assoc 10 elliste)))
    (setq elliste (subst (cons '(K) '(P A)) (assoc 10 elliste) elliste))
    (if (= T (and (= anzkp 3)(= wdhz 2)))
      (setq ept (car (nth 0 ugliste)))
      (setq ept (cdr (assoc 10 elliste)))
    )
    (if (= ugliste nil)
      (setq ugliste (list (list ept apt)))
      (setq ugliste (append ugliste (list (list ept apt))))
    )
    (setq elliste (subst (cons '(K) '(P E)) (assoc 10 elliste) elliste))
    (setq elliste (reverse elliste))
    (setq wdhz (1+ wdhz))
  )
  ugliste
)
;;;
;;;
;;;
;;;-SUB--SUB--SUB--SUB--SUB--SUB--SUB--SUB-
;;;
(defun segmentepr (ap1 ep1 ap2 ep2 / rtg rv1 rv2 rv3)
  (setq rv1 (cal "vec1(ap1,ep1)"));Richtungsvector bestimmen
  (setq rv1n (cal "rv1*-1"));;Richtungsvector umkehren, bei 2 Kontrollpunkten und Linien notwendig
  (setq rv2 (cal "vec1(ep2,ap2)"))
  (setq rv2n (cal "rv2*-1"))
  (setq rv3 (cal "vec1(ep1,ep2)"))
  (setq rv3n (cal "rv3*-1"))
  (if (= T (or
	     (and
	       (or
		 (equal rv1 rv2 0.00000000001)
		 (equal rv1 rv2n 0.00000000001)
	       )
	       (or
		 (equal rv2 rv3 0.00000000001)
		 (equal rv2 rv3n 0.00000000001)
	       )
	       (or
		 (equal rv3 rv1 0.00000000001)
		 (equal rv3 rv1n 0.00000000001)
	       )
	     );and
	     (and
	       (or
		 (equal rv1 rv2 0.00000000001)
		 (equal rv1 rv2n 0.00000000001)
	       )
	       (equal rv3 '(0.0 0.0 0.0) 0.00000000001)
	     )
	   )
      )
    (setq rtg t)
    (setq rtg nil)
  )
  rtg
)
(defun klkptpr (ap klk ep / rtg rv1 rv2 rv3)
  (setq rv1 (cal "vec1(ap,klk)"));Richtungsvector bestimmen
  (setq rv2 (cal "vec1(klk,ep)"))
  (if (= T (or
	     (equal rv1 '(0.0 0.0 0.0) 0.5)
	     (equal rv2 '(0.0 0.0 0.0) 0.5)
	     (equal rv1 rv2 0.5)
	   )
	 )
    (setq rtg t)
    (setq rtg nil)
  )
  rtg
)
;;;
;;;--------------------------------------------------ENDE---------------------------------------------------
;;;
;;;
(princ "Heilen.lsp geladen. ==>Start mit: heilen")
(princ)