;;; Erzeugt Mittellinie (3D-Poly) zu Volumenkörperrohr, bestehend aus einer Aneinanderreihung
;;; linearer Rohrsegmente.
;;; Mittellinie verläuft durch die Zentrumspunkte der Gehrungsquerschnitte
;;; Version 0.2 (Entwurf)
;;; Datum 21.12.2016
;;; Starte mit RM

(defun find_c-objects (/ ss)
  (setq	ss (ssget "X"
		  '((-4 . "<OR")
		    (0 . "CIRCLE")
		    (0 . "ARC")
		    (0 . "Ellipse")
		    (-4 . "OR>")
		   )
	   )
  )
  (if (not ss)
    (ssadd)
    ss
  )
)

(defun find_f-objects (/ ss)
  (setq	ss (ssget "X"
		  '((-4 . "<OR")
		    (0 . "REGION")
		    (0 . "SURFACE")
		    (-4 . "OR>")
		   )
	   )
  )
  (if (not ss)
    (ssadd)
    ss
  )
)

(defun ss2-ss1 (ss2 ss1 / ss-added i)
  (setq ss-added (ssadd))
  (setq i 0)
  (repeat (sslength ss2)
    (if	(not (ssmemb (ssname ss2 i) ss1))
      (ssadd (ssname ss2 i) ss-added)
    )
    (setq i (1+ i))
  )
  ss-added
)

(defun ss-foreach (ss expr / i)
  (if ss
    (repeat (setq i (sslength ss))
      ((eval expr) (ssname ss (setq i (1- i))))
    )
  )
)

(defun remove-dups (Liste / retliste)
  (foreach item	liste
    (if	(not (member item retliste))
      (setq retliste (cons item retliste))
    )
  )
  (reverse retliste)
)

;;; ------------------------------------------------------------------

(defun c:RM (/		 el_liste    i		 elem
	     datlist	 ss	     koord-liste ss-vorh
	     rohr	 ss-neu	     ss-faces	 copymode_old
	     cmdecho_old
	    )
  (setq cmdecho_old (getvar "cmdecho"))
  (setvar "cmdecho" 0)			; in ERROR-Handling zurücksetzen
  (setq ss-vorh (find_f-objects))
  (setq rohr (car (entsel "\nRohr wählen: ")))
  (command "_copy" rohr "" "@" "@")	; nur wenn Rohr erhalten bleiben soll, andernfalls Zeile löschen od. auskommentieren
  (command "_explode" rohr)

  (setq ss-neu (find_f-objects))
  (setq ss-faces (ss2-ss1 ss-neu ss-vorh))

  (setq ss-vorh (find_c-objects))
  (ss-foreach
    ss-faces
    '(lambda (ent /)
       (command "_explode" ent)
     )
  )
  (setq ss-neu (find_c-objects))
  (setq ss (ss2-ss1 ss-neu ss-vorh))

  (setq i 0)
  (while (setq elem (ssname ss i))
    (setq datlist (entget elem))
    (setq el_liste (append el_liste
			   (list (trans	(cdr (assoc 10 datlist))
					(cdr (assoc -1 datlist))
					1
				 )
			   )
		   )
    )
    (setq i (1+ i))
  )
  (setq el_liste (remove-dups el_liste))
  (setq	koord-liste
	 (vl-sort el_liste
		  (function (lambda (x1 x2)
			      (< (car x1) (car x2))
			    )
		  )
	 )
  )
  (command "_3dpoly")
  (apply 'command koord-liste)
  (command "")
  (command "_erase" ss "")
  (setvar "cmdecho" cmdecho_old)
  (princ)
)