LISTATO
(defun C:TESI( / dcl_id )
(command "MOVE" "all" "" (list 0 0) (list 16 0) "")
;;;definisce la funzione di disegno della camera da letto matrimoniale 'Cmatrim'
(defun Cmatrim()
(setq pm1 (list -2 2)) ;alla variabile 'pm1' vengono assegnate le coordinate del primo punto
(setq pm2 (polar pm1 0 4))
(setq pm3 (polar pm2 (- (/ pi 2)) 4))
(setq pm4 (polar pm3 pi 4))
(command "pline" pm1 pm2 pm3 pm4 "c");viene disegnata la polilinea
(setq m (inters pm1 pm3 pm2 pm4)) ;definisce il punto centrale della camera 'm'
(command "TEXT" m 0.25 0 "Cm") ;stampa nel punto centrale la scritta 'Cm'
)
(command "LAYER" "m" "base" "")
(Cmatrim) ;esegue la funzione 'Cmatrim'
(command "LAYER" "m" "0" "")
(setq random (getvar "TDUSRTIMER")) ;genera numeri casuali
(setq angm1 (* 100000000 random)) ;moltiplica per 10000000 il numero casuale
;;;;ROTAZIONE DEI PUNTI DELLA CAMERA MATRIMONIALE
(setq xm1 (car pm1)
ym1 (cadr pm1)
)
(setq xm (car m)
ym (cadr m)
)
(setq xm1a (+ (* (- xm1 xm) (cos angm1)) (* (- ym1 ym) (sin angm1))) ;equazioni di rototraslazione
ym1a (- (* (- ym1 ym) (cos angm1)) (* (- xm1 xm) (sin angm1)))
)
(setq pm1 (list xm1a ym1a)) ;punto pm1 RUOTATO
(setq xm2 (car pm2)
ym2 (cadr pm2)
)
(setq xm2a (+ (* (- xm2 xm) (cos angm1)) (* (- ym2 ym) (sin angm1))) ;equazioni di rototraslazione
ym2a (- (* (- ym2 ym) (cos angm1)) (* (- xm2 xm) (sin angm1)))
)
(setq pm2 (list xm2a ym2a)) ;punto pm2 RUOTATO
(setq xm3 (car pm3)
ym3 (cadr pm3)
)
(setq xm3a (+ (* (- xm3 xm) (cos angm1)) (* (- ym3 ym) (sin angm1))) ;equazioni di rototraslazione
ym3a (- (* (- ym3 ym) (cos angm1)) (* (- xm3 xm) (sin angm1)))
)
(setq pm3 (list xm3a ym3a)) ;punto pm3 RUOTATO
(setq xm4 (car pm4)
ym4 (cadr pm4)
)
(setq xm4a (+ (* (- xm4 xm) (cos angm1)) (* (- ym4 ym) (sin angm1))) ;equazioni di rototraslazione
ym4a (- (* (- ym4 ym) (cos angm1)) (* (- xm4 xm) (sin angm1)))
)
(setq pm4 (list xm4a ym4a)) ;punto pm4 RUOTATO
(command "pline" pm1 pm2 pm3 pm4 "c");viene disegnata la polilinea
;;;definisce la funzione di disegno del bagno'Bagno'
(defun Bagno()
(setq pb1 (list 2 2)) ;alla variabile 'pb1' vengono assegnate le coordinate del primo punto
(setq pb2 (polar pb1 0 1.75))
(setq pb3 (polar pb2 (- (/ pi 2)) 3))
(setq pb4 (polar pb3 pi 1.75))
(setq b (inters pb1 pb3 pb2 pb4)) ;definisce il punto centrale della camera 'b'
(command "pline" pb1 pb2 pb3 pb4 "c");viene disegnata la polilinea
(command "TEXT" b 0.25 0 "Ba") ;stampa nel pun to centrale la scritta 'Ba'
)
(command "LAYER" "m" "base" "")
(Bagno) ;esegue la funzione 'Bagno'
(command "LAYER" "m" "0" "")
(setq random (getvar "TDUSRTIMER")) ;genera numeri casuali
(setq angm2 (* 100000000 random)) ;moltiplica per 10000000 il numero casuale
;;;;ROTAZIONE DEI PUNTI DEL BAGNO
(setq xb1 (car pb1)
yb1 (cadr pb1)
)
(setq xb (car b))
(setq yb (cadr b))
(setq xb1a (+ xb (+ (* (- xb1 xb) (cos angm2)) (* (- yb1 yb) (sin angm2)))) ;equazioni di rototraslazione
yb1a (+ yb (- (* (- yb1 yb) (cos angm2)) (* (- xb1 xb) (sin angm2))))
)
(setq pb1 (list xb1a yb1a)) ;punto pb1 RUOTATO
(setq xb2 (car pb2)
yb2 (cadr pb2)
)
(setq xb2a (+ xb (+ (* (- xb2 xb) (cos angm2)) (* (- yb2 yb) (sin angm2)))) ;equazioni di rototraslazione
yb2a (+ yb (- (* (- yb2 yb) (cos angm2)) (* (- xb2 xb) (sin angm2))))
)
(setq pb2 (list xb2a yb2a)) ;punto pb2 RUOTATO
(setq xb3 (car pb3)
yb3 (cadr pb3)
)
(setq xb3a (+ xb (+ (* (- xb3 xb) (cos angm2)) (* (- yb3 yb) (sin angm2)))) ;equazioni di rototraslazione
yb3a (+ yb (- (* (- yb3 yb) (cos angm2)) (* (- xb3 xb) (sin angm2))))
)
(setq pb3 (list xb3a yb3a)) ;punto pb3 RUOTATO
(setq xb4 (car pb4)
yb4 (cadr pb4)
)
(setq xb4a (+ xb (+ (* (- xb4 xb) (cos angm2)) (* (- yb4 yb) (sin angm2)))) ;equazioni di rototraslazione
yb4a (+ yb (- (* (- yb4 yb) (cos angm2)) (* (- xb4 xb) (sin angm2))))
)
(setq pb4 (list xb4a yb4a)) ;punto pb4 RUOTATO
(command "pline" pb1 pb2 pb3 pb4 "c");viene disegnata la polilinea
;;;definisce la funzione di disegno della camera da letto singola 'Csing'
(defun Csing()
(setq ps1 (list 3.75 2)) ;alla variabile 'ps1' vengono assegnate le coordinate del punto pb2
(setq ps2 (polar ps1 0 4))
(setq ps3 (polar ps2 (- (/ pi 2)) 4))
(setq ps4 (polar ps3 pi 4))
(command "pline" ps1 ps2 ps3 ps4 "c");viene disegnata la polilinea
(setq s (inters ps1 ps3 ps2 ps4)) ;definisce il punto centrale della camera 's'
(command "TEXT" s 0.25 0 "Cs") ;stampa nel pun to centrale la scritta 'Cs'
)
(command "LAYER" "m" "base" "")
(Csing) ;esegue la funzione 'Csing'
(command "LAYER" "m" "0" "")
(setq random (getvar "TDUSRTIMER")) ;genera numeri casuali
(setq angm3 (* 100000000 random)) ;moltiplica per 10000000 il numero casuale
;;;;ROTAZIONE DEI PUNTI DELLA CAMERA SINGOLA
(setq xs1 (car ps1)
ys1 (cadr ps1)
)
(setq xs (car s))
(setq ys (cadr s))
(setq xs1a (+ xs (+ (* (- xs1 xs) (cos angm3)) (* (- ys1 ys) (sin angm3)))) ;equazioni di rototraslazione
ys1a (+ ys (- (* (- ys1 ys) (cos angm3)) (* (- xs1 xs) (sin angm3))))
)
(setq ps1 (list xs1a ys1a)) ;punto ps1 RUOTATO
(setq xs2 (car ps2)
ys2 (cadr ps2)
)
(setq xs2a (+ xs (+ (* (- xs2 xs) (cos angm3)) (* (- ys2 ys) (sin angm3)))) ;equazioni di rototraslazione
ys2a (+ ys (- (* (- ys2 ys) (cos angm3)) (* (- xs2 xs) (sin angm3))))
)
(setq ps2 (list xs2a ys2a)) ;punto ps2 RUOTATO
(setq xs3 (car ps3)
ys3 (cadr ps3)
)
(setq xs3a (+ xs (+ (* (- xs3 xs) (cos angm3)) (* (- ys3 ys) (sin angm3)))) ;equazioni di rototraslazione
ys3a (+ ys (- (* (- ys3 ys) (cos angm3)) (* (- xs3 xs) (sin angm3))))
)
(setq ps3 (list xs3a ys3a)) ;punto ps3 RUOTATO
(setq xs4 (car ps4)
ys4 (cadr ps4)
)
(setq xs4a (+ xs (+ (* (- xs4 xs) (cos angm3)) (* (- ys4 ys) (sin angm3)))) ;equazioni di rototraslazione
ys4a (+ ys (- (* (- ys4 ys) (cos angm3)) (* (- xs4 xs) (sin angm3))))
)
(setq ps4 (list xs4a ys4a)) ;punto ps4 RUOTATO
(command "pline" ps1 ps2 ps3 ps4 "c");viene disegnata la polilinea
;;;definisce la funzione di disegno della cucina 'Cuci'
(defun Cuci()
(setq pc1 (list 3.75 -2)) ;alla variabile 'pc1' vengono assegnate le coordinate del punto ps4
(setq pc2 (polar pc1 0 3.5))
(setq pc3 (polar pc2 (- (/ pi 2)) 3.5))
(setq pc4 (polar pc3 pi 3.5))
(command "pline" pc1 pc2 pc3 pc4 "c");viene disegnata la polilinea
(setq c (inters pc1 pc3 pc2 pc4)) ;definisce il punto centrale della camera 'c'
(command "TEXT" c 0.25 0 "Cu") ;stampa nel pun to centrale la scritta 'Cu'
)
(command "LAYER" "m" "base" "")
(Cuci) ;esegue la funzione 'Cuci'
(command "LAYER" "m" "0" "")
(setq random (getvar "TDUSRTIMER")) ;genera numeri casuali
(setq angm4 (* 100000000 random)) ;moltiplica per 10000000 il numero casuale
;;;;ROTAZIONE DEI PUNTI DELLA CUCINA
(setq xc1 (car pc1)
yc1 (cadr pc1)
)
(setq xc (car c))
(setq yc (cadr c))
(setq xc1a (+ xc (+ (* (- xc1 xc) (cos angm4)) (* (- yc1 yc) (sin angm4)))) ;equazioni di rototraslazione
yc1a (+ yc (- (* (- yc1 yc) (cos angm4)) (* (- xc1 xc) (sin angm4))))
)
(setq pc1 (list xc1a yc1a)) ;punto pc1 RUOTATO
(setq xc2 (car pc2)
yc2 (cadr pc2)
)
(setq xc2a (+ xc (+ (* (- xc2 xc) (cos angm4)) (* (- yc2 yc) (sin angm4)))) ;equazioni di rototraslazione
yc2a (+ yc (- (* (- yc2 yc) (cos angm4)) (* (- xc2 xc) (sin angm4))))
)
(setq pc2 (list xc2a yc2a)) ;punto pc2 RUOTATO
(setq xc3 (car pc3)
yc3 (cadr pc3)
)
(setq xc3a (+ xc (+ (* (- xc3 xc) (cos angm4)) (* (- yc3 yc) (sin angm4)))) ;equazioni di rototraslazione
yc3a (+ yc (- (* (- yc3 yc) (cos angm4)) (* (- xc3 xc) (sin angm4))))
)
(setq pc3 (list xc3a yc3a)) ;punto pc3 RUOTATO
(setq xc4 (car pc4)
yc4 (cadr pc4)
)
(setq xc4a (+ xc (+ (* (- xc4 xc) (cos angm4)) (* (- yc4 yc) (sin angm4)))) ;equazioni di rototraslazione
yc4a (+ yc (- (* (- yc4 yc) (cos angm4)) (* (- xc4 xc) (sin angm4))))
)
(setq pc4 (list xc4a yc4a)) ;punto pc4 RUOTATO
(command "pline" pc1 pc2 pc3 pc4 "c");viene disegnata la polilinea
;;;definisce la funzione di disegno del soggiorno 'Sogg'
(defun Sogg()
(setq pl1 (list -1.5 -2)) ;alla variabile 'pl1' vengono assegnate le coordinate del punto pm4 con x traslata di 0.5
;verso destra, affinchè vi sia sempre un'intersezione fra i lati del soggiorno e della cucina
(setq pl2 (polar pl1 0 5.75))
(setq pl3 (polar pl2 (- (/ pi 2)) 5))
(setq pl4 (polar pl3 pi 5.75))
(command "pline" pl1 pl2 pl3 pl4 "c");viene disegnata la polilinea
(setq l (inters pl1 pl3 pl2 pl4)) ;definisce il punto centrale della camera 'l'
(command "TEXT" l 0.25 0 "So") ;stampa nel pun to centrale la scritta 'So'
)
(command "LAYER" "m" "base" "")
(Sogg) ;esegue la funzione 'Sogg'
(command "LAYER" "m" "0" "")
(setq random (getvar "TDUSRTIMER")) ;genera numeri casuali
(setq angm5 (* 100000000 random)) ;moltiplica per 10000000 il numero casuale
;;;;ROTAZIONE DEI PUNTI DEL SOGGIORNO
(setq xl1 (car pl1)
yl1 (cadr pl1)
)
(setq xl (car l))
(setq yl (cadr l))
(setq xl1a (+ xl (+ (* (- xl1 xl) (cos angm5)) (* (- yl1 yl) (sin angm5)))) ;equazioni di rototraslazione
yl1a (+ yl (- (* (- yl1 yl) (cos angm5)) (* (- xl1 xl) (sin angm5))))
)
(setq pl1 (list xl1a yl1a)) ;punto pl1 RUOTATO
(setq xl2 (car pl2)
yl2 (cadr pl2)
)
(setq xl2a (+ xl (+ (* (- xl2 xl) (cos angm5)) (* (- yl2 yl) (sin angm5)))) ;equazioni di rototraslazione
yl2a (+ yl (- (* (- yl2 yl) (cos angm5)) (* (- xl2 xl) (sin angm5))))
)
(setq pl2 (list xl2a yl2a)) ;punto pl2 RUOTATO
(setq xl3 (car pl3)
yl3 (cadr pl3)
)
(setq xl3a (+ xl (+ (* (- xl3 xl) (cos angm5)) (* (- yl3 yl) (sin angm5)))) ;equazioni di rototraslazione
yl3a (+ yl (- (* (- yl3 yl) (cos angm5)) (* (- xl3 xl) (sin angm5))))
)
(setq pl3 (list xl3a yl3a)) ;punto pl3 RUOTATO
(setq xl4 (car pl4)
yl4 (cadr pl4)
)
(setq xl4a (+ xl (+ (* (- xl4 xl) (cos angm5)) (* (- yl4 yl) (sin angm5)))) ;equazioni di rototraslazione
yl4a (+ yl (- (* (- yl4 yl) (cos angm5)) (* (- xl4 xl) (sin angm5))))
)
(setq pl4 (list xl4a yl4a)) ;punto pl4 RUOTATO
(command "pline" pl1 pl2 pl3 pl4 "c");viene disegnata la polilinea
(setq i1 (inters pm1 pm2 pb1 pb2);calcola i punti di intersezione fra i lati della camera matrimoniale
i2 (inters pm1 pm2 pb2 pb3);e del bagno
i3 (inters pm1 pm2 pb3 pb4)
i4 (inters pm1 pm2 pb4 pb1)
i5 (inters pm2 pm3 pb1 pb2)
i6 (inters pm2 pm3 pb2 pb3)
i7 (inters pm2 pm3 pb3 pb4)
i8 (inters pm2 pm3 pb4 pb1)
i9 (inters pm3 pm4 pb1 pb2)
i10 (inters pm3 pm4 pb2 pb3)
i11 (inters pm3 pm4 pb3 pb4)
i12 (inters pm3 pm4 pb4 pb1)
i13 (inters pm4 pm1 pb1 pb2)
i14 (inters pm4 pm1 pb2 pb3)
i15 (inters pm4 pm1 pb3 pb4)
i16 (inters pm4 pm1 pb4 pb1)
)
(command "color" 7)
(setq pol (list 0 0));definisce la lista 'pol'
(setq inter (list i1 i2 i3 i4 i5 i6 i7 i8 i9 i10 i11 i12 i13 i14 i15 i16)) ; definisce la lista contenente i punti di intersezione
(while inter ;inizia il ciclo
(setq primo (car inter)); assegna a 'primo' il primo elemento della lista
(setq inter (cdr inter));toglie dalla lista il primo elemento
(if (/= primo nil) (setq pol (append pol primo)));aggiunge alla lista 'pol' le coordinate dei punti
;di intersezione che via via trova
);chiusura ciclo
(setq pol (cdr pol));toglie il primo elemento di 'pol'
(setq pol (cdr pol));toglie un altro elemento a 'pol'
(setq a1 (list (car pol) (cadr pol))); assegna ad a1 le coordinate del primo punto di intersezione
(setq a2 (list (caddr pol) (cadddr pol))); assegna ad a2 le coordinate del secondo punto
(command "circle" a1 0.5)
(command "circle" a2 0.5)
(command "pline" a1 a2 "")
(command "color" 5)
(setq i1 (inters pb1 pb2 ps1 ps2);calcola i punti di intersezione fra i lati della camera singola
i2 (inters pb1 pb2 ps2 ps3);e del bagno
i3 (inters pb1 pb2 ps3 ps4)
i4 (inters pb1 pb2 ps4 ps1)
i5 (inters pb2 pb3 ps1 ps2)
i6 (inters pb2 pb3 ps2 ps3)
i7 (inters pb2 pb3 ps3 ps4)
i8 (inters pb2 pb3 ps4 ps1)
i9 (inters pb3 pb4 ps1 ps2)
i10 (inters pb3 pb4 ps2 ps3)
i11 (inters pb3 pb4 ps3 ps4)
i12 (inters pb3 pb4 ps4 ps1)
i13 (inters pb4 pb1 ps1 ps2)
i14 (inters pb4 pb1 ps2 ps3)
i15 (inters pb4 pb1 ps3 ps4)
i16 (inters pb4 pb1 ps4 ps1)
)
(command "color" 7)
(setq pol (list 0 0));definisce la lista 'pol'
(setq inter (list i1 i2 i3 i4 i5 i6 i7 i8 i9 i10 i11 i12 i13 i14 i15 i16)) ; definisce la lista contenente i punti di intersezione
(while inter ;inizia il ciclo
(setq primo (car inter)); assegna a 'primo' il primo elemento della lista
(setq inter (cdr inter));toglie dalla lista il primo elemento
(if (/= primo nil) (setq pol (append pol primo)));aggiunge alla lista 'pol' le coordinate dei punti
;di intersezione che via via trova
);chiusura ciclo
(setq pol (cdr pol));toglie il primo elemento di 'pol'
(setq pol (cdr pol));toglie un altro elemento a 'pol'
(setq a3 (list (car pol) (cadr pol))); assegna ad a3 le coordinate del primo punto di intersezione
(setq a4 (list (caddr pol) (cadddr pol))); assegna ad a4 le coordinate del secondo punto
(command "circle" a3 0.5)
(command "circle" a4 0.5)
(command "pline" a3 a4 "")
(command "color" 5)
(setq i1 (inters ps1 ps2 pc1 pc2);calcola i punti di intersezione fra i lati della camera singola
i2 (inters ps1 ps2 pc2 pc3);e della cucina
i3 (inters ps1 ps2 pc3 pc4)
i4 (inters ps1 ps2 pc4 pc1)
i5 (inters ps2 ps3 pc1 pc2)
i6 (inters ps2 ps3 pc2 pc3)
i7 (inters ps2 ps3 pc3 pc4)
i8 (inters ps2 ps3 pc4 pc1)
i9 (inters ps3 ps4 pc1 pc2)
i10 (inters ps3 ps4 pc2 pc3)
i11 (inters ps3 ps4 pc3 pc4)
i12 (inters ps3 ps4 pc4 pc1)
i13 (inters ps4 ps1 pc1 pc2)
i14 (inters ps4 ps1 pc2 pc3)
i15 (inters ps4 ps1 pc3 pc4)
i16 (inters ps4 ps1 pc4 pc1)
)
(command "color" 7)
(setq pol (list 0 0));definisce la lista 'pol'
(setq inter (list i1 i2 i3 i4 i5 i6 i7 i8 i9 i10 i11 i12 i13 i14 i15 i16)) ; definisce la lista contenente i punti di intersezione
(while inter ;inizia il ciclo
(setq primo (car inter)); assegna a 'primo' il primo elemento della lista
(setq inter (cdr inter));toglie dalla lista il primo elemento
(if (/= primo nil) (setq pol (append pol primo)));aggiunge alla lista 'pol' le coordinate dei punti
;di intersezione che via via trova
);chiusura ciclo
(setq pol (cdr pol));toglie il primo elemento di 'pol'
(setq pol (cdr pol));toglie un altro elemento a 'pol'
(setq a5 (list (car pol) (cadr pol))); assegna ad a5 le coordinate del primo punto di intersezione
(setq a6 (list (caddr pol) (cadddr pol))); assegna ad a6 le coordinate del secondo punto
(command "circle" a5 0.5)
(command "circle" a6 0.5)
(command "pline" a5 a6 "")
(command "color" 5)
(setq i1 (inters pc1 pc2 pl1 pl2);calcola i punti di intersezione fra i lati della cucina
i2 (inters pc1 pc2 pl2 pl3);e del soggiorno
i3 (inters pc1 pc2 pl3 pl4)
i4 (inters pc1 pc2 pl4 pl1)
i5 (inters pc2 pc3 pl1 pl2)
i6 (inters pc2 pc3 pl2 pl3)
i7 (inters pc2 pc3 pl3 pl4)
i8 (inters pc2 pc3 pl4 pl1)
i9 (inters pc3 pc4 pl1 pl2)
i10 (inters pc3 pc4 pl2 pl3)
i11 (inters pc3 pc4 pl3 pl4)
i12 (inters pc3 pc4 pl4 pl1)
i13 (inters pc4 pc1 pl1 pl2)
i14 (inters pc4 pc1 pl2 pl3)
i15 (inters pc4 pc1 pl3 pl4)
i16 (inters pc4 pc1 pl4 pl1)
)
(command "color" 7)
(setq pol (list 0 0));definisce la lista 'pol'
(setq inter (list i1 i2 i3 i4 i5 i6 i7 i8 i9 i10 i11 i12 i13 i14 i15 i16)) ; definisce la lista contenente i punti di intersezione
(while inter ;inizia il ciclo
(setq primo (car inter)); assegna a 'primo' il primo elemento della lista
(setq inter (cdr inter));toglie dalla lista il primo elemento
(if (/= primo nil) (setq pol (append pol primo)));aggiunge alla lista 'pol' le coordinate dei punti
;di intersezione che via via trova
);chiusura ciclo
(setq pol (cdr pol));toglie il primo elemento di 'pol'
(setq pol (cdr pol));toglie un altro elemento a 'pol'
(setq a7 (list (car pol) (cadr pol))); assegna ad a7 le coordinate del primo punto di intersezione
(setq a8 (list (caddr pol) (cadddr pol))); assegna ad a8 le coordinate del secondo punto
(command "circle" a7 0.5)
(command "circle" a8 0.5)
(command "pline" a7 a8 "")
(command "color" 5)
(setq i1 (inters pl1 pl2 pm1 pm2);calcola i punti di intersezione fra i lati del soggiorno
i2 (inters pl1 pl2 pm2 pm3);e della camera singola
i3 (inters pl1 pl2 pm3 pm4)
i4 (inters pl1 pl2 pm4 pm1)
i5 (inters pl2 pl3 pm1 pm2)
i6 (inters pl2 pl3 pm2 pm3)
i7 (inters pl2 pl3 pm3 pm4)
i8 (inters pl2 pl3 pm4 pm1)
i9 (inters pl3 pl4 pm1 pm2)
i10 (inters pl3 pl4 pm2 pm3)
i11 (inters pl3 pl4 pm3 pm4)
i12 (inters pl3 pl4 pm4 pm1)
i13 (inters pl4 pl1 pm1 pm2)
i14 (inters pl4 pl1 pm2 pm3)
i15 (inters pl4 pl1 pm3 pm4)
i16 (inters pl4 pl1 pm4 pm1)
)
(command "color" 7)
(setq pol (list 0 0));definisce la lista 'pol'
(setq inter (list i1 i2 i3 i4 i5 i6 i7 i8 i9 i10 i11 i12 i13 i14 i15 i16)) ; definisce la lista contenente i punti di intersezione
(while inter ;inizia il ciclo
(setq primo (car inter)); assegna a 'primo' il primo elemento della lista
(setq inter (cdr inter));toglie dalla lista il primo elemento
(if (/= primo nil) (setq pol (append pol primo)));aggiunge alla lista 'pol' le coordinate dei punti
;di intersezione che via via trova
);chiusura ciclo
(setq pol (cdr pol));toglie il primo elemento di 'pol'
(setq pol (cdr pol));toglie un altro elemento a 'pol'
(setq a9 (list (car pol) (cadr pol))); assegna ad a9 le coordinate del primo punto di intersezione
(setq a10 (list (caddr pol) (cadddr pol))); assegna ad a10 le coordinate del secondo punto
(command "circle" a9 0.5)
(command "circle" a10 0.5)
(command "pline" a9 a10 "")
;(command "pline" a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 "c" "")
(command "color" 5)
(setq xa1 (car a1)) ;estrae le coordinate x dei punti di intersezione
(setq xa2 (car a2))
(setq xa3 (car a3))
(setq xa4 (car a4))
(setq xa5 (car a5))
(setq xa6 (car a6))
(setq xa7 (car a7))
(setq xa8 (car a8))
(setq xa9 (car a9))
(setq xa10 (car a10))
(setq ya1 (cadr a1)) ;estrae le coordinate y dei punti di intersezione
(setq ya2 (cadr a2))
(setq ya3 (cadr a3))
(setq ya4 (cadr a4))
(setq ya5 (cadr a5))
(setq ya6 (cadr a6))
(setq ya7 (cadr a7))
(setq ya8 (cadr a8))
(setq ya9 (cadr a9))
(setq ya10 (cadr a10))
(setq coordx (list xa1 xa2 xa3 xa4 xa5 xa6 xa7 xa8 xa9 xa10));crea le liste con le coordinate
(setq coordy (list ya1 ya2 ya3 ya4 ya5 ya6 ya7 ya8 ya9 ya10));x e y dei punti di intersezione
(setq xmax (eval (cons max coordx)));trova la x massima
(if (= (car a1) xmax) (setq per1 a1)) ;assegna a 'per1' il primo punto del perimetro
(if (= (car a2) xmax) (setq per1 a2)) ;quello di x massima
(if (= (car a3) xmax) (setq per1 a3))
(if (= (car a4) xmax) (setq per1 a4))
(if (= (car a5) xmax) (setq per1 a5))
(if (= (car a6) xmax) (setq per1 a6))
(if (= (car a7) xmax) (setq per1 a7))
(if (= (car a8) xmax) (setq per1 a8))
(if (= (car a9) xmax) (setq per1 a9))
(if (= (car a10) xmax) (setq per1 a10))
(command "COLOR" 1)
(command "CIRCLE" per1 1)
(command "color" 5)
(setq xmin (eval (cons min coordx)));trova la x minima
(if (= (car a1) xmin) (setq per2 a1)) ;assegna a 'per2' il secondo punto del perimetro
(if (= (car a2) xmin) (setq per2 a2)) ;quello di x minima
(if (= (car a3) xmin) (setq per2 a3))
(if (= (car a4) xmin) (setq per2 a4))
(if (= (car a5) xmin) (setq per2 a5))
(if (= (car a6) xmin) (setq per2 a6))
(if (= (car a7) xmin) (setq per2 a7))
(if (= (car a8) xmin) (setq per2 a8))
(if (= (car a9) xmin) (setq per2 a9))
(if (= (car a10) xmin) (setq per2 a10))
(command "COLOR" 1)
(command "CIRCLE" per2 1)
(command "color" 5)
(setq ymax (eval (cons max coordy)));trova la y massima
(if (= (cadr a1) ymax) (setq per3 a1)) ;assegna a 'per3' il terzo punto del perimetro
(if (= (cadr a2) ymax) (setq per3 a2)) ;quello di y massima
(if (= (cadr a3) ymax) (setq per3 a3))
(if (= (cadr a4) ymax) (setq per3 a4))
(if (= (cadr a5) ymax) (setq per3 a5))
(if (= (cadr a6) ymax) (setq per3 a6))
(if (= (cadr a7) ymax) (setq per3 a7))
(if (= (cadr a8) ymax) (setq per3 a8))
(if (= (cadr a9) ymax) (setq per3 a9))
(if (= (cadr a10) ymax) (setq per3 a10))
(command "COLOR" 1)
;(command "CIRCLE" per3 1)
(command "color" 5)
(setq ymin (eval (cons min coordy)));trova la y minima
(if (= (cadr a1) ymin) (setq per4 a1)) ;assegna a 'per4' il secondo punto del perimetro
(if (= (cadr a2) ymin) (setq per4 a2)) ;quello di y minima
(if (= (cadr a3) ymin) (setq per4 a3))
(if (= (cadr a4) ymin) (setq per4 a4))
(if (= (cadr a5) ymin) (setq per4 a5))
(if (= (cadr a6) ymin) (setq per4 a6))
(if (= (cadr a7) ymin) (setq per4 a7))
(if (= (cadr a8) ymin) (setq per4 a8))
(if (= (cadr a9) ymin) (setq per4 a9))
(if (= (cadr a10) ymin) (setq per4 a10))
(command "COLOR" 1)
(command "CIRCLE" per4 1)
(command "color" 5)
;;trova il punto di y max successivo a per4
;(setq coordy2 (subst 0 (cadr per4) coordy))
;(setq coordy2 0)
(setq coordy2 (list -100 -100));definisce la lista 'coordy2'
(if (/= (cadr per3) ya1) (setq coordy2 (append coordy2 (list ya1))));aggiunge alla lista 'coordy2' le coordinate dei punti
(if (/= (cadr per3) ya2) (setq coordy2 (append coordy2 (list ya2))));diversi dalla ymax
(if (/= (cadr per3) ya3) (setq coordy2 (append coordy2 (list ya3))))
(if (/= (cadr per3) ya4) (setq coordy2 (append coordy2 (list ya4))))
(if (/= (cadr per3) ya5) (setq coordy2 (append coordy2 (list ya5))))
(if (/= (cadr per3) ya6) (setq coordy2 (append coordy2 (list ya6))))
(if (/= (cadr per3) ya7) (setq coordy2 (append coordy2 (list ya7))))
(if (/= (cadr per3) ya8) (setq coordy2 (append coordy2 (list ya8))))
(if (/= (cadr per3) ya9) (setq coordy2 (append coordy2 (list ya9))))
(if (/= (cadr per3) ya10) (setq coordy2 (append coordy2 (list ya10))))
(setq ymax2 (eval (cons max coordy2)));trova la y massima della nuova lista
(if (= (cadr a1) ymax2) (setq per5 a1)) ;assegna a 'per5' il quinto punto del perimetro
(if (= (cadr a2) ymax2) (setq per5 a2)) ;quello di y massima dopo 'per3'
(if (= (cadr a3) ymax2) (setq per5 a3))
(if (= (cadr a4) ymax2) (setq per5 a4))
(if (= (cadr a5) ymax2) (setq per5 a5))
(if (= (cadr a6) ymax2) (setq per5 a6))
(if (= (cadr a7) ymax2) (setq per5 a7))
(if (= (cadr a8) ymax2) (setq per5 a8))
(if (= (cadr a9) ymax2) (setq per5 a9))
(if (= (cadr a10) ymax2) (setq per5 a10))
;questa routine fa in modo che per5 sia sempre a sinistra di per3
(setq invers (list per5 per3))
(if (> (car per5) (car per3))
(progn
(setq per5 (cadr invers))
(setq per3 (car invers))
)
)
(command "COLOR" 1)
(command "CIRCLE" per5 1)
(command "CIRCLE" per3 1)
(command "color" 5)
(setq perimetro (list -100 -100));definisce la lista 'perimetro'
(if (OR (> (car per2) (car pm1)) (< (cadr per5) (cadr pm1))) (setq perimetro (append perimetro pm1)));confronta la x di per2
(if (OR (> (car per2) (car pm2)) (< (cadr per5) (cadr pm2))) (setq perimetro (append perimetro pm2)));con la x dei punti della
(if (OR (> (car per2) (car pm3)) (< (cadr per5) (cadr pm3))) (setq perimetro (append perimetro pm3)));camera matrimoniale
(if (OR (> (car per2) (car pm4)) (< (cadr per5) (cadr pm4))) (setq perimetro (append perimetro pm4)));quando ne trova uno con x< di x per2
;oppure con y> di y per5, lo aggiunge al perimetro
(setq perimetro (cdr perimetro));toglie il primo elemento di perimetro
(setq perimetro (cdr perimetro));toglie un altro elemento di perimetro
(setq per6 (list (car perimetro) (cadr perimetro)));definisce i punti del perimetro
(setq per7 (list (caddr perimetro) (cadddr perimetro)))
(setq per8 (list (nth 4 perimetro) (nth 5 perimetro)))
(command "COLOR" 2)
(command "CIRCLE" per6 1)
(command "CIRCLE" per7 1)
(command "CIRCLE" per8 1)
(command "color" 5)
(command "LAYER" "off" "base" "")
)