; Umgrenzungsfinder (Machbarkeitsstudie). Funktioniert nur mit Linien - keine Kreise, keine Polylinien! 
; by Paul Lenz    18.9.2014     paul@lenz-online.de                                                     

(defun c:mumgr ( / )
  (command "_lweight" "0.3"
	   "_osnap" "off"
	   "_ortho" "off"
  )
  (setq ti 0.01		; Abstand der Versuchslinien zur Umgrenzung 
	vb 0		; Verbose Level:       1 bis 3 zum Debuggen 
	zf 0		; Zwischenfragen:      1 zum Debuggen       
        as (ssget "X" '((0 . "LINE")))
	ls (sslength as)
	ll nil
	el nil
        pt (getpoint "Punkt?")
	di 999999.9
  )
  (while (> ls 0)
    (setq ls (1- ls)
  	  ob (ssname as ls)
          li (entget ob)
	  p1 (cdr (assoc 10 li))
	  p2 (cdr (assoc 11 li))
	  ly (cdr (assoc  8 li))
	  ly (tblsearch "layer" ly)
    )
    (if (and (= (cdr (assoc 70 ly)) 0) (> (cdr (assoc 62 ly)) 0))  ; nur auf sichtbaren Layern 
      (setq ll (cons (list p1 p2) ll))
      (setq as (ssdel ob as))
    )
  )
  (foreach li ll
    (setq fp (fusspt (car li) (cadr li) pt))
    (if (/= fp nil)
      (if (< (distance fp pt) di) (setq gl li  di (distance fp pt)))
    )
  )

  (setq	fl 0
        t1 (car gl)
	t2 (cadr gl)
	u1 t1  u2 t2
	fp (fusspt t1 t2 pt)
	t1 fp
        t2 (rechtsab ll fp pt)
	uu fp
	s1 (polar fp (angle fp pt) ti)
  )
  (setq s2 (polar s1 (angle t1 t2) ti))
  (if (> vb 0) (command "_color" 1  "_line" pt fp ""))

  (while (= fl 0)
    (setq qq nil)
    (command "_color" 190  "_line" s1 s2 "")
    (if (> zf 0) (getstring "  weiter?"))

    (command "_extend" as "" s2 "")
    (setq s3 (cdr (assoc 11 (entget (entlast))))	; bis zur Querlinie 
	  s4 (polar s3 (angle s1 s2) ti)		; und etwas weiter  
	  s2 (polar s3 (angle s2 s1) ti)		; und etwas zurück  
    )
    (if (fastgleich (distance s1 s3) ti)
      (progn
	(princ "   Keine Umgrenzung gefunden!")
	(exit)
      )
    )
    (if (< vb 1) (command "_erase" (entlast) ""))
    (if (> vb 0) (command "_color" 1  "_line" s1 s2 ""))
    (if (> zf 0) (getstring "\nauswerten?"))
    (setq fl (fusspt t1 t2 s2))
    (if (= fl nil)
      (setq fl 2) 				; Suchpunkt nicht mehr neben der Linie 
      (setq fl (if (> vb 0) (command "_color" 8  "_line" fl t1 ""))
	    fl 1
      )
    )
    
    (if (= fl 1)	; an Querlinie nach rechts abbiegen 
      (progn
	(if (> vb 0) (command "_color" 3   "_line" s1 s2 ""))
        (setq t1 s3
	      t2 (rechtsab ll s3 s1)
	      s1 s2
              s2 (polar s1 (angle t1 t2) ti)
	      uu (inters u1 u2 t1 t2 nil)
              el (append el (list uu))
	      u1 t1  u2 t2
	)
	(if (> vb 0) (command "_color" 5  "_donut" 0.0 0.05 uu ""))
      )
    )

    (if (= fl 2)	; keine Querlinie: um den letzten Punkt links herum tasten 
      (progn
        (if (> vb 1) (princ "\nnicht mehr neben der alten Linie!"))
        (if (< (distance t1 s2) (distance t2 s2)) (setq t2 t1))   ; relevanter Endpunkt 
	(setq k1 (polar t2 (+ (angle s2 s1) 0.001) ti)
	      k2 (polar t2 (+ (angle s2 s1) 0.002) ti)
	      k3 (polar t2 (+ (angle s2 s1) 0.003) ti)
	)
	(command "_color" 8  "_arc" k1 k2 k3)
        (command "_extend" as "" k3 "")
        (setq wa (cdr (assoc 50 (entget (entlast))))	  	  ; neuer Anfangswinkel 
	      we (cdr (assoc 51 (entget (entlast))))	  	  ; neuer Endwinkel     
              wi (- we wa)
	)
	(if (< vb 1) (command "_erase" (entlast) ""))
	(if (< wi 0) (setq wi (+ wi pi pi)))
	(if (> vb 2)
	  (progn
	    (princ "\nAnfangswinkel ")
	    (princ wa)
	    (princ "    Endwinkel ")
	    (princ we)
	    (princ "    Gesamtwinkel ")
	    (princ wi)
          )
	)
	(if (> wi (+ pi pi -0.002)) 				  
          (progn						  ; Vollkreis -> irrelevante Linie -> zurück! 
 	    (if (> vb 0) (command "_color" 3   "_line" s1 s2 ""))
	    (setq wi (angle s2 s1)
		  s2 (fusspt s1 s2 t2)
		  s1 (polar s2 (- wi (* 0.5 pi)) (* 2 ti))
		  s2 (polar s1 wi ti)
                  t1 u1   t2 u2
	    )
          )
	  (progn
  	    (setq k1 (polar t2 (- we 0.001) ti)			  ; zurück        
                  k2 (polar t2    we        ti)			  ; Endpunkt      
                  k3 (polar t2 (+ we 0.001) ti)			  ; drüber hinaus 
                  t1 k2
		  t2 (rechtsab ll k2 k1)
                  tu (inters u1 u2 t1 t2 nil)
	    )

	    (if (= tu nil)		; kein Schnittpunkt gefunden                 
	      (progn
		(if (> vb 1) (princ "\nalte Richtung geht weiter.  "))
	      )
              (progn
		(setq uu tu
                      el (append el (list uu))
  	              wi (angle uu k2)
	              k1 (polar k2 (angle k3 k1) ti)
	              k2 (polar k1 wi ti)
	              s2 (inters s1 s2 k1 k2 nil)
	        )
 	        (if (> vb 0) (command "_color" 3   "_line" s1 s2 ""))
                (setq s1 s2
	              s2 (polar s1 wi ti)
                      u1 t1  u2 t2
                )
                (if (> vb 0) (command "_color" 5  "_donut" 0.0 0.05 uu ""))
	      )
	    )
	  )
	)
      )
    )
    (setq fl 0)
    (if (> (length el) 2)
      (if (< (distance (car el) uu) ti) (setq fl 1)) ; am Anfangspunkt angekommen? 
    )
  )
  (if (> vb 0) (command "_erase" (entlast)))	; letzter Donut ist doppelt 
  (command "_color" 5  "_pline")
  (foreach pt (cdr el) (command pt))
  (command "_c")
  
  (princ "OK.")
  (princ)
)





; alles auf Z=0 
(defun platt (as / al ob li p1 p2)
  (setq al (sslength as))
  (while (> al 0)
    (setq al (1- al)
  	  ob (ssname as al)
	  li (entget ob)
	  p1 (assoc 10 li)
	  p2 (assoc 11 li)
    )
    (if (/= p1 nil)
      (setq p1 (cdr p1)
	    p1 (list (car p1) (cadr p1) 0.0)
	    li (subst (cons 10 p1) (assoc 10 li) li)
      )
    )
    (if (/= p2 nil)
      (setq p2 (cdr p2)
	    p2 (list (car p2) (cadr p2) 0.0)
	    li (subst (cons 11 p2) (assoc 11 li) li)
      )
    )
    (entmod li)
    (entupd ob)
  )
)




; sind die Zahlen so gut wie gleich? 
(defun fastgleich (a1 a2 / )
  (< (abs (- a1 a2)) 0.00001)
)




; rechter Endpunkt der Linie, auf die im Punkt kp (ausgehend von ap) gestoßen wurde 
(defun rechtsab (ll kp ap / gr dw p1 p2 gl)
  (setq gl nil)
  (foreach gr ll
    (setq dw (abs (- (angle (car gr) kp) (angle kp (cadr gr)))))
    (if (fastgleich dw 0) (setq gl gr))
    (if (fastgleich dw (* 2.0 pi)) (setq gl gr))
  )
  (if (= gl nil) (princ "\nGrenzlinie nicht gefunden!"))
  (setq p1 (car gl)
	p2 (cadr gl)
        dw (- (angle p1 p2) (angle kp ap))
  )
  (if (> dw    pi)     (setq dw (- dw pi pi)))
  (if (< dw (* pi -1)) (setq dw (+ dw pi pi)))
  (if (< dw 0.0) (setq p1 p1) (setq p2 p2))
)




; Fußpunkt von qp lotrecht auf Linie p1-p2 
(defun fusspt(p1 p2 pq / wi pt dd)
  (setq wi (+ (angle p1 p2) (/ pi 2))
	pt (polar pq wi 99999)
	pt (inters p1 p2 pq pt nil)			; findet immer (außer wenn p1 = p2) 
  )
  (if (= pt nil)
    (setq dd 1.0)
    (setq dd (+ (distance p1 pt) (distance p2 pt))
	  dd (- dd (distance p1 p2))
    )
  )
  (if (fastgleich dd 0) (setq pt pt)  (setq pt nil))
)


(princ "   UMGRENZ geladen --> mumgr   ")

(princ)