;-----------------------------------------------------------------------------
; LSP- zur Stuecklistenersstellung aus Bloecken  AW 12.8.92
; Eingabevariablen:
; 1. Name der Stuecklistendatei
; 2. Auswahlsatz - frei definierbar
;
; - es wird eine *.adf-Datei im Zeichnungsverzeichnis erstellt
; - die Symbole werden einzeln ausgeschrieben und spaeter mit Clipper addiert
; - ST/STL/ap60/AP110/APG110/DRT80/RT8080/HFSPROF/HFSFOR werden in Variablen abgelegt 
;   und am Ende der Datei angefuegt - als LAYR:43,etc.
;-----------------------------------------------------------------------------

(defun c:stueckl(/ datei datei1 asatz alen alauf name typ st 
                   stl ap60 ap110 apg110 drt80 rt8080 hfsprof hfsfor
                   startpunkt endpunkt laenge
                )

	;Laengen-Variablen initialisieren
	(setq st 0 stl 0 ap60 0 ap110 0 apg110 0 drt80 0 rt8080 0 hfsprof 0 hfsfor 0)
	;Ausgabedatei abfragen und eroeffnen
        (Setq 
        datei1 (Getfiled "Auswahl Stuecklistendatei" (strcat lw "/daten/cad/") "adf" 9 ))

	(setq datei (open datei1 "w")) 

	; Auswahlsatz bilden

	(setq asatz (ssget) 
		alen (sslength asatz)
		alauf 0
	)

	(while (< alauf alen)                                          
		; In TYP speichern was gefunden worden ist

		(setq typ (cdr (assoc 0 (entget (ssname asatz alauf)))))
		(princ typ)
		(terpri)

		; Analyse des gefundenen Teiles

		;--> ein Block gefunden
		(if (equal typ "INSERT")
			(progn
				(setq blockname (cdr (assoc 2 (entget (ssname asatz alauf)))))
				(princ "\n" datei)
				(princ (strcat (chr 34) blockname (chr 34) ",1") datei)
;				(print blockname datei)                ;Ausgabe der Assoziationsliste
			)
		)

		;--> b) Linie gefunden
		;** ST
		(if (and                                ;wenn
			(equal 
			(cdr (assoc 0 (entget (ssname asatz alauf))))      ;Objekt eine Linie und
			"LINE")
			(equal
			(cdr (assoc 8 (entget (ssname asatz alauf))))      ;auf dem Layer "L-2"
			"L-2")
			)
			(progn                                    ;dann
				(setq startpunkt
				(cdr (assoc 10 (entget (ssname asatz alauf)))))      ;Startpunkt berechnen
				(setq endpunkt
				(cdr (assoc 11 (entget (ssname asatz alauf)))))      ;Endpunkt berechnen
				(setq laenge
				(distance startpunkt endpunkt))   ;Laenge berechnen
			        (setq st
			          (+ st laenge))                   ;neue Gesamtlaenge ST berechnen
			)
		)
		;** STL
		(if (and                                ;wenn
			(equal 
			(cdr (assoc 0 (entget (ssname asatz alauf))))      ;Objekt eine Linie und
			"LINE")
			(equal
			(cdr (assoc 8 (entget (ssname asatz alauf))))      ;auf dem Layer "L-2"
			"L-7")
			)
			(progn                                    ;dann
				(setq startpunkt
				(cdr (assoc 10 (entget (ssname asatz alauf)))))      ;Startpunkt berechnen
				(setq endpunkt
				(cdr (assoc 11 (entget (ssname asatz alauf)))))      ;Endpunkt berechnen
				(setq laenge
				(distance startpunkt endpunkt))   ;Laenge berechnen
			        (setq stl
			          (+ stl laenge))                  ;neue Gesamtlaenge ST berechnen
			)
		)
		;** AP110
		(if (and                                ;wenn
			(equal 
			(cdr (assoc 0 (entget (ssname asatz alauf))))      ;Objekt eine Linie und
			"LINE")
			(equal
			(cdr (assoc 8 (entget (ssname asatz alauf))))      ;auf dem Layer "L-2"
			"A-7")
			)
			(progn                                    ;dann

				(setq startpunkt
				(cdr (assoc 10 (entget (ssname asatz alauf)))))      ;Startpunkt berechnen
				(setq endpunkt
				(cdr (assoc 11 (entget (ssname asatz alauf)))))      ;Endpunkt berechnen
				(setq laenge
				(distance startpunkt endpunkt))   ;Laenge berechnen
			        (setq ap110
			          (+ ap110 laenge))                   ;neue Gesamtlaenge ST berechnen
			)
		)		
		;** APG110
		(if (and                                ;wenn
			(equal 
			(cdr (assoc 0 (entget (ssname asatz alauf))))      ;Objekt eine Linie und
			"LINE")
			(equal
			(cdr (assoc 8 (entget (ssname asatz alauf))))      ;auf dem Layer "L-2"
			"A-2")
			)
			(progn                                    ;dann
				(setq startpunkt
				(cdr (assoc 10 (entget (ssname asatz alauf)))))      ;Startpunkt berechnen
				(setq endpunkt
				(cdr (assoc 11 (entget (ssname asatz alauf)))))      ;Endpunkt berechnen
				(setq laenge
				(distance startpunkt endpunkt))   ;Laenge berechnen
			        (setq apg110
			          (+ apg110 laenge))                   ;neue Gesamtl„nge ST berechnen
			)
		)
		;** AP60
		(if (and                                ;wenn
			(equal 
			(cdr (assoc 0 (entget (ssname asatz alauf))))      ;Objekt eine Linie und
			"LINE")
			(equal
			(cdr (assoc 8 (entget (ssname asatz alauf))))      ;auf dem Layer "L-2"
			"A-4")
			)
			(progn                                    ;dann
				(setq startpunkt
				(cdr (assoc 10 (entget (ssname asatz alauf)))))      ;Startpunkt berechnen
				(setq endpunkt
				(cdr (assoc 11 (entget (ssname asatz alauf)))))      ;Endpunkt berechnen
				(setq laenge
				(distance startpunkt endpunkt))   ;Laenge berechnen
			        (setq ap60
			          (+ ap60 laenge))                   ;neue Gesamtlaenge ST berechnen
			)
		)
		;** DRT80
		(if (and                                ;wenn
			(equal 
			(cdr (assoc 0 (entget (ssname asatz alauf))))      ;Objekt eine Linie und
			"LINE")
			(equal
			(cdr (assoc 8 (entget (ssname asatz alauf))))      ;auf dem Layer "L-2"
			"D-1")
			)
			(progn                                    ;dann
				(setq startpunkt
				(cdr (assoc 10 (entget (ssname asatz alauf)))))      ;Startpunkt berechnen
				(setq endpunkt
				(cdr (assoc 11 (entget (ssname asatz alauf)))))      ;Endpunkt berechnen
				(setq laenge
				(distance startpunkt endpunkt))   ;Laenge berechnen
			        (setq drt80
			          (+ drt80 laenge))                   ;neue Gesamtlaenge ST berechnen
			)
		)
		;** RT8080
		(if (and                                ;wenn
			(equal 
			(cdr (assoc 0 (entget (ssname asatz alauf))))      ;Objekt eine Linie und
			"LINE")
			(equal
			(cdr (assoc 8 (entget (ssname asatz alauf))))      ;auf dem Layer "L-2"
			"D-5")
			)
			(progn                                    ;dann
				(setq startpunkt
				(cdr (assoc 10 (entget (ssname asatz alauf)))))      ;Startpunkt berechnen
				(setq endpunkt
				(cdr (assoc 11 (entget (ssname asatz alauf)))))      ;Endpunkt berechnen
				(setq laenge
				(distance startpunkt endpunkt))   ;Laenge berechnen
			        (setq rt8080
			          (+ rt8080 laenge))                   ;neue Gesamtlaenge ST berechnen
			)
		)
		;** HFS - Lagerstrecke
		(if (and                                ;wenn
			(equal 
			(cdr (assoc 0 (entget (ssname asatz alauf))))      ;Objekt eine Linie und
			"LINE")
			(equal
			(cdr (assoc 8 (entget (ssname asatz alauf))))      ;auf dem Layer "L-2"
			"H-2")
			)
			(progn                                    ;dann
				(setq startpunkt
				(cdr (assoc 10 (entget (ssname asatz alauf)))))      ;Startpunkt berechnen
				(setq endpunkt
				(cdr (assoc 11 (entget (ssname asatz alauf)))))      ;Endpunkt berechnen
				(setq laenge
				(distance startpunkt endpunkt))   ;Laenge berechnen
			        (setq HFSPROF
                                (+ HFSPROF laenge))                   ;neue Gesamtlaenge ST berechnen
			)
		)
		;** HFS - F”rderstrecke
		(if (and                                ;wenn
			(equal 
			(cdr (assoc 0 (entget (ssname asatz alauf))))      ;Objekt eine Linie und
			"LINE")
			(equal
			(cdr (assoc 8 (entget (ssname asatz alauf))))      ;auf dem Layer "L-2"
			"H-1")
			)
			(progn                                    ;dann
				(setq startpunkt
				(cdr (assoc 10 (entget (ssname asatz alauf)))))      ;Startpunkt berechnen
				(setq endpunkt
				(cdr (assoc 11 (entget (ssname asatz alauf)))))      ;Endpunkt berechnen
				(setq laenge
				(distance startpunkt endpunkt))   ;Laenge berechnen
			        (setq HFSFOR
                                (+ HFSFOR laenge))                   ;neue Gesamtlaenge ST berechnen
			)
		)	
		(setq alauf (1+ alauf))
	)
	; Hier die Laengen eintragen ----------------------------------------------
	(if (> st 0)
          (progn
	    (princ "\n" datei)
	    (princ (strcat (chr 34) "LAYR:43" (chr 34) "," (rtos (/ st 1000))) datei)
          )
	)
	(if (> stl 0)
          (progn
	    (princ "\n" datei)
	    (princ (strcat (chr 34) "LAYR:44" (chr 34) "," (rtos (/ stl 1000))) datei)
          )
        )
	(if (> ap110 0)
          (progn
	    (princ "\n" datei)
	    (princ (strcat (chr 34) "LAYR:187" (chr 34) "," (rtos (/ ap110 1000))) datei)
          )
        )
	(if (> apg110 0)
          (progn
	    (princ "\n" datei)
	    (princ (strcat (chr 34) "LAYR:182" (chr 34) "," (rtos (/ apg110 1000))) datei)
          )
        )
	(if (> ap60 0)
          (progn
	    (princ "\n" datei)
	    (princ (strcat (chr 34) "LAYR:184" (chr 34) "," (rtos (/ ap60 1000))) datei)
          )
        )
	(if (> drt80 0)
          (progn
	    (princ "\n" datei)
	    (princ (strcat (chr 34) "LAYR:60" (chr 34) "," (rtos (/ drt80 1000))) datei)
          )
        )
	(if (> rt8080 0)
          (progn
	    (princ "\n" datei)
	    (princ (strcat (chr 34) "LAYR:62" (chr 34) "," (rtos (/ rt8080 1000))) datei)
          )
        )
	(if (> HFSPROF 0)
          (progn
	    (princ "\n" datei)
	    (princ (strcat (chr 34) "LAYR:HFS" (chr 34) "," (rtos (/ HFSPROF 1000))) datei)
          )
        )
	(if (> HFSFOR 0)
          (progn
	    (princ "\n" datei)
	    (princ (strcat (chr 34) "L:HFSFOR" (chr 34) "," (rtos (/ HFSFOR 1000))) datei)
          )
        )
        (princ)
	(close datei)                                    ;Datei schliessen
)