119 lines
3.3 KiB
Common Lisp
119 lines
3.3 KiB
Common Lisp
;---------- Erstellung von S„ulenraster f�r Lagerbl”cke --------------
|
|
; 24.3.93 AW
|
|
;---------------------------------------------------------------------
|
|
|
|
|
|
|
|
(DEFUN c:saeule (/ p0 l b rl rb fk1 fk2 art typ etage sl_sym ebene)
|
|
;------------------------------------------------------------------
|
|
; p0 - linke-untere Ecke
|
|
; l - L„nge des Bereiches
|
|
; b - Breite des Bereiches
|
|
; rl - L„nge des S„ulenrasters
|
|
; rb - Breite des S„ulenrasters
|
|
; fk1 - f�r die Optimierung, dann Anzahl SPALTEN
|
|
; fk2 - f�r die Optimierung, dann Anzahl ZEILEN
|
|
; art - S„ulenart - (P)rofil/(S)tahl
|
|
; typ - nur f�r Stahl: 1-4.3x3/2-5x3/3-5x5/4-4.8x4.8
|
|
; etage - S„ulenh”he
|
|
; sl_sym - Symbolname
|
|
; ebene - "P-8" f�r Profil / "S-8" f�r Stahl
|
|
;--------------------------------------------------------------------
|
|
|
|
(SETVAR "limcheck" 0)
|
|
(PROMPT "*************** SŽULENRASTER **********************")
|
|
(PROMPT "")
|
|
;<<<Abfrageteil>>>
|
|
(INITGET (+ 2 4))
|
|
(SETQ p0 (GETPOINT "\nUntere-linke Ecke des Bereiches antippen: "))
|
|
(SETQ l (GETREAL "\nLŽNGE der verf�gbaren Fl„che: "))
|
|
(SETQ b (GETREAL "\nBREITE der verf�gbaren Fl„che: "))
|
|
(SETQ rl (GETREAL "\nS„ulenraster-> LŽNGE <5000>: "))
|
|
(IF
|
|
(= nil rl)
|
|
(SETQ rl 5000)
|
|
)
|
|
(SETQ rb (GETREAL "\nS„ulenraster-> BREITE <3000>: "))
|
|
(IF
|
|
(= nil rb)
|
|
(SETQ rb 3000)
|
|
)
|
|
|
|
;--------------------------------------------------------------------------
|
|
;<<<< Abfrage der S„ulenart / Etagen und Name der Symbole definieren >>>>
|
|
;--------------------------------------------------------------------------
|
|
(INITGET 1 "P S ")
|
|
(SETQ art (STRCASE (SUBSTR (GETKWORD "Profil/<Stahl>: ") 1 1)))
|
|
(IF
|
|
(= nil art)
|
|
(SETQ art "S")
|
|
)
|
|
(INITGET (+ 2 4))
|
|
(SETQ etage (GETINT "\nAnzahl Ebenen <1>: "))
|
|
(IF
|
|
(= nil etage)
|
|
(SETQ etage 1)
|
|
)
|
|
(SETQ typ (GETINT "\nTyp: (1) 4.3x3 (2) 5x3 (3) 5x5 (4) 4.8x4.8 <2>: "))
|
|
(IF
|
|
(= nil typ)
|
|
(SETQ typ 2)
|
|
)
|
|
|
|
(Cond
|
|
((Or (= art "S") (= art "")) ; Stahlger�st
|
|
(SETQ ebene "S-8")
|
|
(Cond
|
|
)
|
|
)
|
|
((= art "P") ; Profilger�st
|
|
(SETQ ebene "P-8")
|
|
(Cond
|
|
)
|
|
)
|
|
)
|
|
;-----------------------------------
|
|
;<<<Berechnung und Optimierung >>>>
|
|
;-----------------------------------
|
|
; L„nge und Breite konform dem S„ulenraster optimieren
|
|
(SETQ fk1 (/ l rl) fk2 (FIX (/ l rl)))
|
|
(IF
|
|
(> (- fk1 fk2) 0)
|
|
(SETQ l (* (+ fk2 1) rl))
|
|
)
|
|
(SETQ fk1 (/ b rb) fk2 (FIX (/ b rb)))
|
|
(IF
|
|
(> (- fk1 fk2) 0)
|
|
(SETQ b (* (+ fk2 1) rb))
|
|
)
|
|
; Anzahl SPALTEN und ZEILEN definieren
|
|
(SETQ fk1 (+ 1 (/ l rl)) fk2 (+ 1 (/ b rb)))
|
|
|
|
;---------------------------------------------
|
|
;<<<Punkte definieren
|
|
;---------------------------------------------
|
|
(SETQ p1 (LIST (car p0) (- (cadr p0) 500))
|
|
p2 (LIST (car p0) (+ (cadr p0) (+ b 500)))
|
|
p3 (LIST (- (car p0) 500) (cadr p0))
|
|
p4 (LIST (+ (car p0) (+ l 500)) (cadr p0))
|
|
)
|
|
|
|
;---------------------------------------------
|
|
;<<<S„ulenraster zeichnen
|
|
;---------------------------------------------
|
|
|
|
(COMMAND "_layer" "_m" ebene "_c" "8" "" "")
|
|
(COMMAND "_line" p1 p2 "")
|
|
(COMMAND "_line" p3 p4 "")
|
|
|
|
(IF (> fk1 1) ; SPALTEN
|
|
(command "_array" p1 "" "r" "1" (FIX fk1) rl)
|
|
)
|
|
(IF (> fk2 1) ; ZEILEN
|
|
(command "_array" p3 "" "r" (FIX fk2) "1" rb)
|
|
)
|
|
|
|
) ;------------ ENDE S„ulenraster ---------------
|
|
|
|
|
|
|