Files
Walz/MENU/STUECKL.LSP
T

317 lines
9.8 KiB
Common Lisp

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