;-----------------------------------------------------------------------------
; 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/DRT114/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 ()
  ; FIXE STRINGS ------------------------------------------------------------------------------------
  (setq string1 "          0          0          0                                             1    0")
  (setq string2 " ")
  (setq string3 "0                                               ")
  (setq string5 "                                                                                ")
  ;--------------------------------------------------------------------------------------------------
  (if (> st 0)		; ST
    (PROFIL_EINTRAGEN st "ST" "0_A1000010") 
  )
  (if (> stl 0)		; STL
    (PROFIL_EINTRAGEN stl "STL" "0_A1000011") 
  )
  (if (> ap110 0)
    (PROFIL_EINTRAGEN ap110 "AP110" "821106001")   
  )	
  (if (> apg110 0)
    (PROFIL_EINTRAGEN apg110 "APG110" "821106002")   
  )	
  (if (> ap60 0)
    (PROFIL_EINTRAGEN ap60 "AP60" "821096001")   
  )	
  (if (> drt80 0)
    (PROFIL_EINTRAGEN drt80 "DRT80" "0_D1000001")   
  )	
  (if (> rt8080 0)
    (PROFIL_EINTRAGEN rt8080 "RT8080" "0_D1000002")   
  )	
  (if (> drt114 0)
    (PROFIL_EINTRAGEN drt114 "DRT114" "0_D1000003")   
  )	
  (if (> ils2100_lp 0)
    (PROFIL_EINTRAGEN ils2100_lp "ILS2100-LP" "0_B3000100")   
  )	
  (if (> ils2100_lp_pin 0)
    (PROFIL_EINTRAGEN ils2100_lp_pin "ILS2100-LP MIT PIN" "0_B3000110")   
  )	
  (if (> ils2100_sp 0)
    (PROFIL_EINTRAGEN ils2100_sp "ILS2100-SP" "0_B3000120")   
  )	
  (princ)
	(close datei)                                    ;Datei schliessen
)

(defun PROFIL_EINTRAGEN(LAENGE_IN_MM PROFIL_ART ARTIKEL_NR)
;  (setq ges_menge (rtos (/ LAENGE_IN_MM 1000) 2 0))
  (setq ges_menge (rtos LAENGE_IN_MM 2 0))
  (setq InputLaenge (strlen ges_menge))
  (setq ArtikelNrLaenge (strlen ARTIKEL_NR))
  (STRING_BERECHNEN)
  (setq string4 PROFIL_ART)			
  
  (princ (strcat string1 ARTIKEL_NR DisplayString string3 string4  string5) datei)
  
  (princ "\n" datei)
)

(defun STRING_BERECHNEN()
  (if (= ArtikelNrLaenge 9)
    (cond 
      ((= InputLaenge 1)
        (setq DisplayString (strcat "        " ges_menge))
      )
      ((= InputLaenge 2)
        (setq DisplayString (strcat "       " ges_menge))    
      )
      ((= InputLaenge 3)
        (setq DisplayString (strcat "      " ges_menge))    
      )
      ((= InputLaenge 4)
        (setq DisplayString (strcat "     " ges_menge))    
      )
      ((= InputLaenge 5)
        (setq DisplayString (strcat "    " ges_menge))    
      )
      ((= InputLaenge 6)
        (setq DisplayString (strcat "   " ges_menge))    
      )
      ((= InputLaenge 7)
        (setq DisplayString (strcat "  " ges_menge))    
      )
      ((= InputLaenge 8)
        (setq DisplayString (strcat " " ges_menge))    
      )
    )  ; end cond
  )  ; endif

  (if (= ArtikelNrLaenge 10)
    (cond 
      ((= InputLaenge 1)
        (setq DisplayString (strcat "       " ges_menge))
      )
      ((= InputLaenge 2)
        (setq DisplayString (strcat "      " ges_menge))    
      )
      ((= InputLaenge 3)
        (setq DisplayString (strcat "     " ges_menge))    
      )
      ((= InputLaenge 4)
        (setq DisplayString (strcat "    " ges_menge))    
      )
      ((= InputLaenge 5)
        (setq DisplayString (strcat "   " ges_menge))    
      )
      ((= InputLaenge 6)
        (setq DisplayString (strcat "  " ges_menge))    
      )
      ((= InputLaenge 7)
        (setq DisplayString (strcat " " ges_menge))    
      )
      ((= InputLaenge 8)
        (setq DisplayString ges_menge)    
      )
    )  ; end cond
  )  ; endif
    
)

(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 drt114 hfsprof hfsfor ils2100_lp ils2100_lp_pin ils2100_sp 
                   startpunkt endpunkt laenge
                )

	;Laengen-Variablen initialisieren
	(setq st 0 stl 0 ap60 0 ap110 0 apg110 0 drt80 0 rt8080 0 drt114 0 hfsprof 0 hfsfor 0 ils2100_lp 0 ils2100_lp_pin 0 ils2100_sp 0)
	;Ausgabedatei abfragen und eroeffnen
  (Setq 
     datei1 (Getfiled "Auswahl Stuecklistendatei" (strcat "h:" "/daten") "txt" 8 )
  )
	(setq datei (open datei1 "a")) 

	; 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))
				)
		)
		;** DRT114
		(if (and (equal (cdr (assoc 0 (entget (ssname asatz alauf)))) "LINE")
				(or (equal (cdr (assoc 8 (entget (ssname asatz alauf)))) "D-3") 
						(equal (cdr (assoc 8 (entget (ssname asatz alauf)))) "d-3"))
				)
				(progn
					(LAENGE_BERECHNEN)
					(setq drt114	(+ drt114 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))
				)
		)
		;** ILS - Laufprofil
		(if (and (equal (cdr (assoc 0 (entget (ssname asatz alauf)))) "LINE")
				(or (equal (cdr (assoc 8 (entget (ssname asatz alauf)))) "ILS-LP") 
						(equal (cdr (assoc 8 (entget (ssname asatz alauf)))) "ils-lp"))
				)
				(progn
					(LAENGE_BERECHNEN)
					(setq ils2100_lp	(+ ils2100_lp laenge))
				)
		)
		;** ILS - Laufprofil mit Pin
		(if (and (equal (cdr (assoc 0 (entget (ssname asatz alauf)))) "LINE")
				(or (equal (cdr (assoc 8 (entget (ssname asatz alauf)))) "ILS-LP-PIN") 
						(equal (cdr (assoc 8 (entget (ssname asatz alauf)))) "ils-lp-pin"))
				)
				(progn
					(LAENGE_BERECHNEN)
					(setq ils2100_lp_pin	(+ ils2100_lp_pin laenge))
				)
		)
		;** ILS - Stauprofil (Gefällestrecke)
		(if (and (equal (cdr (assoc 0 (entget (ssname asatz alauf)))) "LINE")
				(or (equal (cdr (assoc 8 (entget (ssname asatz alauf)))) "ILS-SP") 
						(equal (cdr (assoc 8 (entget (ssname asatz alauf)))) "ils-sp"))
				)
				(progn
					(LAENGE_BERECHNEN)
					(setq ils2100_sp	(+ ils2100_sp laenge))
				)
		)

	
		(setq alauf (1+ alauf))
	)  ; end while
	(LAENGEN_EINTRAGEN)
)