;-----------------------------------------------------------------------------
; 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.
; 20.12.2006 - AutoCAD 2007 - alles auf GROSSSCHREIBUNG angepasst
;-----------------------------------------------------------------------------

(defun LAENGEN_EINTRAGEN ()
		(if (> st 0)		; ST
			(progn
			(princ "\n" datei)
			(princ (strcat (chr 34) "LAYR:43" (chr 34) "," (rtos (/ st 1000))) datei)
			)
		)
		(if (> stl 0)	; STL
			(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
)


(defun LAENGE_BERECHNEN()
	(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
)

;---------------------------------------------------------------------------------------------------
(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/") "adf" 9 ))

	(setq datei (open datei1 "w")) 

	; Auswahlsatz bilden

	(setq asatz (ssget) 
		alen (sslength asatz)
		alauf 0
	)
;	(alert "richtige liste")
	(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 (strcase (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 (equal (cdr (assoc 0 (entget (ssname asatz alauf)))) "LINE")
				(or (equal (cdr (assoc 8 (entget (ssname asatz alauf)))) "L-2") 
						(equal (cdr (assoc 8 (entget (ssname asatz alauf)))) "l-2"))
				)
				(progn
					(LAENGE_BERECHNEN)
					(setq st	(+ st laenge))
				)
		)
		;** STL
		(if (and (equal (cdr (assoc 0 (entget (ssname asatz alauf)))) "LINE")
				(or (equal (cdr (assoc 8 (entget (ssname asatz alauf)))) "L-7") 
						(equal (cdr (assoc 8 (entget (ssname asatz alauf)))) "l-7"))
				)
				(progn
					(LAENGE_BERECHNEN)
					(setq stl	(+ stl laenge))
				)
		)
		;** AP110
		(if (and (equal (cdr (assoc 0 (entget (ssname asatz alauf)))) "LINE")
				(or (equal (cdr (assoc 8 (entget (ssname asatz alauf)))) "A-7") 
						(equal (cdr (assoc 8 (entget (ssname asatz alauf)))) "a-7"))
				)
				(progn
					(LAENGE_BERECHNEN)
					(setq ap110	(+ ap110 laenge))
				)
		)
		;** APG110
		(if (and (equal (cdr (assoc 0 (entget (ssname asatz alauf)))) "LINE")
				(or (equal (cdr (assoc 8 (entget (ssname asatz alauf)))) "A-2") 
						(equal (cdr (assoc 8 (entget (ssname asatz alauf)))) "a-2"))
				)
				(progn
					(LAENGE_BERECHNEN)
					(setq apg110	(+ apg110 laenge))
				)
		)
		;** AP60
		(if (and (equal (cdr (assoc 0 (entget (ssname asatz alauf)))) "LINE")
				(or (equal (cdr (assoc 8 (entget (ssname asatz alauf)))) "A-4") 
						(equal (cdr (assoc 8 (entget (ssname asatz alauf)))) "a-4"))
				)
				(progn
					(LAENGE_BERECHNEN)
					(setq ap60	(+ ap60 laenge))
				)
		)
		;** DRT80
		(if (and (equal (cdr (assoc 0 (entget (ssname asatz alauf)))) "LINE")
				(or (equal (cdr (assoc 8 (entget (ssname asatz alauf)))) "D-1") 
						(equal (cdr (assoc 8 (entget (ssname asatz alauf)))) "d-1"))
				)
				(progn
					(LAENGE_BERECHNEN)
					(setq drt80	(+ drt80 laenge))
				)
		)
		;** RT8080
		(if (and (equal (cdr (assoc 0 (entget (ssname asatz alauf)))) "LINE")
				(or (equal (cdr (assoc 8 (entget (ssname asatz alauf)))) "D-5") 
						(equal (cdr (assoc 8 (entget (ssname asatz alauf)))) "d-5"))
				)
				(progn
					(LAENGE_BERECHNEN)
					(setq rt8080	(+ rt8080 laenge))
				)
		)
		;** HFS - Lagerstrecke
		(if (and (equal (cdr (assoc 0 (entget (ssname asatz alauf)))) "LINE")
				(or (equal (cdr (assoc 8 (entget (ssname asatz alauf)))) "H-2") 
						(equal (cdr (assoc 8 (entget (ssname asatz alauf)))) "h-2"))
				)
				(progn
					(LAENGE_BERECHNEN)
					(setq hfsprof	(+ hfsprof laenge))
				)
		)
		;** HFS - Förderstrecke
		(if (and (equal (cdr (assoc 0 (entget (ssname asatz alauf)))) "LINE")
				(or (equal (cdr (assoc 8 (entget (ssname asatz alauf)))) "H-1") 
						(equal (cdr (assoc 8 (entget (ssname asatz alauf)))) "h-1"))
				)
				(progn
					(LAENGE_BERECHNEN)
					(setq hfsfor	(+ hfsfor laenge))
				)
		)
	
		(setq alauf (1+ alauf))
	)  ; end while
	(LAENGEN_EINTRAGEN)
)