Files
Walz/MENU/STUECKL.SAV
T

294 lines
9.4 KiB
Plaintext

;-----------------------------------------------------------------------------
; 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
)