Files

205 lines
6.6 KiB
Common Lisp

;-----------------------------------------------------------------------
; 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 lnge)
;--------------------------
; 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 lnge
(distance startpunkt endpunkt)) ;L„nge berechnen
(setq st
(+ st lnge)) ;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 lnge
(distance startpunkt endpunkt)) ;L„nge berechnen
(setq stl
(+ stl lnge)) ;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 lnge
(distance startpunkt endpunkt)) ;L„nge berechnen
(setq ap110
(+ ap110 lnge)) ;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 lnge
(distance startpunkt endpunkt)) ;L„nge berechnen
(setq apg110
(+ apg110 lnge)) ;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 lnge
(distance startpunkt endpunkt)) ;L„nge berechnen
(setq ap60
(+ ap60 lnge)) ;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 lnge
(distance startpunkt endpunkt)) ;L„nge berechnen
(setq drt80
(+ drt80 lnge)) ;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 lnge
(distance startpunkt endpunkt)) ;L„nge berechnen
(setq rt8080
(+ rt8080 lnge)) ;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
)