;-----------------------------------------------------------------------
; LSP- zur Stcklistenersstellung aus Bl”cken  AW 12.8.92
; - es wird eine *.adf-Datei im Zeichnungsverzeichnis erstellt
; - die Symbole werden einzeln ausgeschrieben
; - ST/STL/ap60/AP110/APG110/DRT80/RT8080 werden in Variablen abgelegt und am
;   Ende der Datei angefgt - als LAYR:43,etc.
;-----------------------------------------------------------------------

(defun c:stueckl(/ datei e name typ st stl ap60 ap110 apg110 drt80 rt8080 startpunkt endpunkt l„nge)
	;--------------------------
	; Variablen initialisieren
	;--------------------------
	(setq st 0 stl 0 ap60 0 ap110 0 apg110 0 drt80 0 rt8080 0)
	;----------------------
	; Ausgabedatei er”ffnen
	;----------------------
	(setq datei (open 
	(strcat (getvar "DWGNAME") ".ADF") "w")) 
	;------------------------
	; Schleife initialisieren
	;------------------------
	(setq e (entnext))                                
	(while e                                          
		;------------------------------------------
		; In TYP speichern was gefunden worden ist
		;------------------------------------------
		(setq typ (cdr (assoc 0 (entget e))))
		;-------------------------------
		; Analyse des gefundenen Teiles
		;-------------------------------

		;--> ein Block gefunden
		(if (equal typ "INSERT")
			(progn
				(setq blockname (cdr (assoc 2 (entget e))))
				(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 e)))      ;Objekt eine Linie und
			"LINE")
			(equal
			(cdr (assoc 8 (entget e)))      ;auf dem Layer "L-2"
			"L-2")
			)
			(progn                                    ;dann
				(setq startpunkt
				(cdr (assoc 10 (entget e))))      ;Startpunkt berechnen
				(setq endpunkt
				(cdr (assoc 11 (entget e))))      ;Endpunkt berechnen
				(setq l„nge
				(distance startpunkt endpunkt))   ;L„nge berechnen
			        (setq st
			          (+ st l„nge))                   ;neue Gesamtl„nge ST berechnen
			)
		)
		; STL
		(if (and                                ;wenn
			(equal 
			(cdr (assoc 0 (entget e)))      ;Objekt eine Linie und
			"LINE")
			(equal
			(cdr (assoc 8 (entget e)))      ;auf dem Layer "L-2"
			"L-7")
			)
			(progn                                    ;dann
				(setq startpunkt
				(cdr (assoc 10 (entget e))))      ;Startpunkt berechnen
				(setq endpunkt
				(cdr (assoc 11 (entget e))))      ;Endpunkt berechnen
				(setq l„nge
				(distance startpunkt endpunkt))   ;L„nge berechnen
			        (setq stl
			          (+ stl l„nge))                  ;neue Gesamtl„nge ST berechnen
			)
		)
		; AP110
		(if (and                                ;wenn
			(equal 
			(cdr (assoc 0 (entget e)))      ;Objekt eine Linie und
			"LINE")
			(equal
			(cdr (assoc 8 (entget e)))      ;auf dem Layer "L-2"
			"A-7")
			)
			(progn                                    ;dann
				(setq startpunkt
				(cdr (assoc 10 (entget e))))      ;Startpunkt berechnen
				(setq endpunkt
				(cdr (assoc 11 (entget e))))      ;Endpunkt berechnen
				(setq l„nge
				(distance startpunkt endpunkt))   ;L„nge berechnen
			        (setq ap110
			          (+ ap110 l„nge))                   ;neue Gesamtl„nge ST berechnen
			)
		)		
		; APG110
		(if (and                                ;wenn
			(equal 
			(cdr (assoc 0 (entget e)))      ;Objekt eine Linie und
			"LINE")
			(equal
			(cdr (assoc 8 (entget e)))      ;auf dem Layer "L-2"
			"A-2")
			)
			(progn                                    ;dann
				(setq startpunkt
				(cdr (assoc 10 (entget e))))      ;Startpunkt berechnen
				(setq endpunkt
				(cdr (assoc 11 (entget e))))      ;Endpunkt berechnen
				(setq l„nge
				(distance startpunkt endpunkt))   ;L„nge berechnen
			        (setq apg110
			          (+ apg110 l„nge))                   ;neue Gesamtl„nge ST berechnen
			)
		)
		; AP60
		(if (and                                ;wenn
			(equal 
			(cdr (assoc 0 (entget e)))      ;Objekt eine Linie und
			"LINE")
			(equal
			(cdr (assoc 8 (entget e)))      ;auf dem Layer "L-2"
			"A-8")
			)
			(progn                                    ;dann
				(setq startpunkt
				(cdr (assoc 10 (entget e))))      ;Startpunkt berechnen
				(setq endpunkt
				(cdr (assoc 11 (entget e))))      ;Endpunkt berechnen
				(setq l„nge
				(distance startpunkt endpunkt))   ;L„nge berechnen
			        (setq ap60
			          (+ ap60 l„nge))                   ;neue Gesamtl„nge ST berechnen
			)
		)
		; DRT80
		(if (and                                ;wenn
			(equal 
			(cdr (assoc 0 (entget e)))      ;Objekt eine Linie und
			"LINE")
			(equal
			(cdr (assoc 8 (entget e)))      ;auf dem Layer "L-2"
			"D-1")
			)
			(progn                                    ;dann
				(setq startpunkt
				(cdr (assoc 10 (entget e))))      ;Startpunkt berechnen
				(setq endpunkt
				(cdr (assoc 11 (entget e))))      ;Endpunkt berechnen
				(setq l„nge
				(distance startpunkt endpunkt))   ;L„nge berechnen
			        (setq drt80
			          (+ drt80 l„nge))                   ;neue Gesamtl„nge ST berechnen
			)
		)
		; RT8080
		(if (and                                ;wenn
			(equal 
			(cdr (assoc 0 (entget e)))      ;Objekt eine Linie und
			"LINE")
			(equal
			(cdr (assoc 8 (entget e)))      ;auf dem Layer "L-2"
			"D-5")
			)
			(progn                                    ;dann
				(setq startpunkt
				(cdr (assoc 10 (entget e))))      ;Startpunkt berechnen
				(setq endpunkt
				(cdr (assoc 11 (entget e))))      ;Endpunkt berechnen
				(setq l„nge
				(distance startpunkt endpunkt))   ;L„nge berechnen
			        (setq rt8080
			          (+ rt8080 l„nge))                   ;neue Gesamtl„nge ST berechnen
			)
		)
		(setq e (entnext e))                    ;e wird das n„chste Objekt der Zeichnung
	)
	; Hier die L„ngen eintragen ----------------------------------------------
	(princ "\n" datei)
	(princ (strcat (chr 34) "LAYR:43" (chr 34) "," (rtos (/ st 1000))) datei)
	(princ "\n" datei)
	(princ (strcat (chr 34) "LAYR:44" (chr 34) "," (rtos (/ stl 1000))) datei)
	(princ "\n" datei)
	(princ (strcat (chr 34) "LAYR:180" (chr 34) "," (rtos (/ ap110 1000))) datei)
	(princ "\n" datei)
	(princ (strcat (chr 34) "LAYR:182" (chr 34) "," (rtos (/ apg110 1000))) datei)
	(princ "\n" datei)
	(princ (strcat (chr 34) "LAYR:188" (chr 34) "," (rtos (/ ap60 1000))) datei)
	(princ "\n" datei)
	(princ (strcat (chr 34) "LAYR:60" (chr 34) "," (rtos (/ drt80 1000))) datei)
	(princ "\n" datei)
	(princ (strcat (chr 34) "LAYR:62" (chr 34) "," (rtos (/ rt8080 1000))) datei)
	(princ)
	(close datei)                                    ;Datei schlieáen
)



