;Setup.lsp (C) 2004 by Michele Ingenuo Ingoenius
;CONV modif del 15 01 2004
;stage, setup piu info in finale 

(defun C:SETUP ()
  (setq DTR (/ PI 180)) ;fattore di moltiplicazione x gradi verso radianti
  (setq DESTRA (* 0 DTR))	;traduzione del comando polar
  (setq SINISTRA (* 180 DTR))	;traduzione del comando polar 
  (setq SU (* 90 DTR))		;traduzione del comando polar 
  (setq GIU (* 270 DTR))	;traduzione del comando polar 
  (setq DIAG (* 45 DTR))	;traduzione del comando polar x 45 gradi 

  (SETQ OSN (GETVAR "OSMODE"))	;salva gli snap  
  (SETVAR "OSMODE" 3)	        ;salva gli snap  

  (setq Z1 (getpoint "\nSeleziona ZONA angolo in basso a sinistra"))
  (command "_ucs" "o" Z1)	;mette l'origine in z1
  (setq Z1 (list 0 0 ))	
  (setq Z2 (getpoint "\nSeleziona ZONA angolo alto destra"))
  (setvar "osmode" 0)
  (setq xZ1(car Z1))
  (setq yZ1(cadr Z1))
  (setq xz2 (car z2))
  (setq yz2(cadr z2))
  (setq asseX (/ xz2 2)) ; coordinata del centro asse X dello spazio
  (Setq Z11 (list xz2 yz1))
  (setq distzona (distance Z1 Z11)) ;distanza massima senza corridoi
  (setq Bstage (getdist "\nSpazio dal fondo: ")) ; spazio dal fondo 
  (setq YCBstage (- Yz2 Bstage )) ; centro back stage
  (setq P0 (list assex YCBstage)) ; punto inserzione stage
  (setq SM  (getdist "\nSpazio laterale dai muri: ")) ; distanza dai muri laterali 
  (setq DB (getdist "\nSpazio dalla REGIA: "))	; distanza dal fondo sala 
  (setq YCBstage (- Yz2 Bstage )) ; centro back stage
  (setq P0 (list assex YCBstage)) ; punto inserzione stage
  (setq LUNG 0)
  (setq ALT 0)
  (setq P1 Z3)
  (setq Z3 (list SM  DB)) ; zona setup angolo basso sin  
  (setq P1 Z3)
  (setq Z2 (POLAR Z2 SINISTRA SM))
  (setq Z4 (POLAR Z2 GIU Bstage))
  (setq Z4 (POLAR Z4 GIU ALT))
  (setq XZ5 (car z4))
  (setq YZ5 (cadr z3))
  (setq Z5 (list Xz5 Yz5)) ; creo il punto Z5

  (princ)

  (setq Z4 (POLAR Z4 GIU (getdist "\nDistanza da FRONT STAGE: ")))
  (initget 1 "Theatre Classe")
  (setq SETUP (getkword "\nSetup Theatre Classe\n")) ; determina il tipo scelto 
  (cond
   ((= "Theatre" SETUP)
    (setq EcX 0.5) ; distance fixe entre chaise a changer pour classe etc etc
    (setq Ecy 1) ; distanza fixe entre colonne pour chaise a changer pour ecole etc
    (setq Mibloc 0.2101) ; mezza sedia
    (setq Bloc (* 2 Mibloc)) ; ingombro sedia intera
    (setq Blocco_setup "c:/pick/lisp/CHAISE")
    (setq P1 (POLAR P1 DESTRA mibloc))
    (setq P1 (POLAR P1 SU (+ bloc 0.0742)))
    (setq scorr (/ Bloc 2)) ; spazio per i corridoi
    (setq COMP mibloc) ; spazio per i corridoi
   );fine theatre
   ((= "Classe" SETUP)
    (setq EcX 2.43)
    (setq Ecy 1.75)
    (setq Mibloc 1.215)
    (setq Bloc (* 2 Mibloc))
    (setq Blocco_setup "c:/pick/lisp/ECOLE")
    (setq P1 (POLAR P1 DESTRA bloc))
    (setq P1 (POLAR P1 SU Ecy))
    (setq scorr mibloc)
    (setq COMP 0)
   ) ;fine classe
  )
  (setq P2 Z4)
  (setq xZ5 (car Z3))  ; primo elem di z3
  (setq yZ5 (cadr Z4)) ; secondo emem di z4
  (setq Distx (- distzona (* 2 SM))) ; zona di setup
  (setq Disty (- yz5 DB))            ; zona di setup
  ;variabili di spostamento blocchi
  (setq COL (/ Distx  ECx))
  (setq tcol (rtos COL 2 2 ))
  (setq LIN (/ Disty  ECy))
  (setq tlin (rtos LIN 2 2))
  (setq message_col (strcat tcol " colonne e " tlin " linee" ))
  (princ message_col)    ; messaggio colonne e linee inserire
  (setq PAKS (getint "\nQuanti packs? ")) ; 1 gruppo = 0 alles
  (cond
    ((= PAKS  1.0)  ; 1 gruppo vuol dire zero corridoi
     (setq COULOIRS PAKS)
     (setq Cor 0.0) ; largeur allées de securité
    )
    (
     (setq COULOIRS PAKS)
     (setq Cor (getreal "\nLarghezza corridoio: " ))
    )
  )
  ; compensazione rispetto ai punti di inserzione dei bocchi
  (setq sec  (+ Cor bloc))
  (setq distx (- distx (* couloirs Cor)))
  (setq COL (/ Distx  ECx))
  (setq tcol (rtos COL 2 2 ))
  (setq LIN (/ Disty  ECy))
  (setq tlin (rtos LIN 2 2))
  (setq message_col (strcat tcol " colonne e " tlin " linee" ))
  (terpri)
  (princ message_col)	; messaggio colonne e linee inserire
  (setq N COULOIRS)	; determina il numero di colonne da creare
  (setq LIN (fix LIN))	; lignes a repeter en array

  (setq DIV (rtos (/ col n))) ; stringa minimo blocchi
  ; stringa resto della divisione blocchi
  (setq RDIV (rtos (fix (rem col n)))) 
  (setq message_col 
   (strcat 
    DIV " blocchi " "resto " RDIV " blocchi " tcol " colonne e " tlin " linee")
  )

  (terpri)

  (princ message_col)	

  (setq ss nil) 
  (setq ss  (ssadd)) ; crea una selezione vuota
  (repeat N 
   (repeat (getint "\nNumero blocchi per fila: ")
    ; inserisce il primo blocco in P1
    (command "_insert" Blocco_setup P1 "" "" "") 
    (setq OB2 (entlast))
    ; aggiunge alla selezione ss il blocco creato
    (setq ss (ssadd ob2 ss))
    (setq P1 (POLAR P1 DESTRA Ecx))
   );fine rapeat 2
   (setq P1 (POLAR P1 DESTRA cor)) ; crea i corridoi 
  );fine repeat N range
  ; conta quanti blocchi inseriti nella prima linea
  (setq ssl (sslength ss))
  ;mette p1 alpunto di inserzione dell'ultimo blocco della riga 
  (setq P1 (polar P1 DESTRA (+ mibloc COMP)))
  (setq xp1 (car p1)) ; coord x del p1 finale
  (setq SPOSTA (/ 2.0 (- xz5 xp1)))
  ; spazio dai muri destro e sin  
  (setq P1 (polar P1 sinistra sec)) 
  (setq P1 (polar P1 sinistra ecx))
  (setq P1 (polar P1 destra  mibloc))
  (setq xp1 (car p1))
  (setq xp2 (car p2))
  ; quanti blocchi effettivamente inseriti sulla prima linea 
  (setq INSERITI (- (sslength SS) 1))
  ; spazio realmente occupato dai blocchi inseriti
  (setq SOCCU (* bloc INSERITI))	
  (setq SV (* (- N 1 ) Cor)) ; spazio dei corridoi
  (setq SOCCU (+ SV  SOCCU)) ; spazio occupato 
  (setq XZ5 (car z4))
  (setq YZ5 (cadr z3))
  (setq RESTO (/(- xz5 xp1)2))
  (setq ESlin ecy)  
  ; punto creato per centrare i blocchi test con scor oppure con resto 
  (setq PS (polar P1 DESTRA RESTO ))
  (command "_move" ss "" P1 PS "") ; centra la prima linea 
  (setq P1 (POLAR P1 DESTRA Ecx))
  ; array solo per le linee le colonne sono gia fatte
  (command "_array" SS "" "r" LIN 1 Ecy "" )
  ; conta quanti blocchi inseriti realmente con setup
  (setq count (rtos (* LIN  ssl)))		 
  (setq message_setup (strcat count " "  Blocco_setup))	
  (alert message_setup) ; messaggio stage
  (setvar "osmode" OSN)	; rimette lo snap
  (setq ss nil)	; risvuota ss per un riutilizzo dello script
  (command "_UCS" "_W" ); rimette l'ucs generale
  (princ)
)
;;;eof