




;																									
;	ALMACENA DADOS DE OTRO PROGAMA (PIEL-01)																		
;																									


;(PROMPT "FORMANDO PARAJAS DE PUNTOS MAS CERCANOS")  (TERPRI)

;(PROMPT "RELLENANDO LOS PUNTOS LIBRES "B" NO MAS CERCANOS ")  (TERPRI)





(DEFUN C:ALMACEN-00 (/ )

;																									







;																									
;		(P1) PUNTOS PRIMEROS LIBRES "B" (NO MAS CERCANOS) 3D=>2D=>PINTA 
;																									
		(DEFUN P1 ( / )
					(SETQ QQ Lon-LPB)
					(REPEAT (- Lon-LPB N3B1)
						(SETQ QQ (- QQ 1))

						(SETQ 3B1L (NTH QQ LIS-PB)) 		; Punto 3B1L
						(SETQ 3B2L (NTH (- QQ 1) LIS-PB)) 	; Punto 3B2L
						(SETQ 3A1L 3A1)

						(COMMAND "SCP" "N" "3P" 3B1L 3A1L 3B2L)	; SCP-A
						(SETQ 2A1L-A (TRANS 3A1L 0 1))
						(SETQ 2B1L-A (TRANS 3B1L 0 1))
						(SETQ 2B2L-A (TRANS 3B2L 0 1))
						(COMMAND "SCP" "U")

						(COMMAND "SCP" "N" "3P" 2KKB 2KKA "")	; SCP-2D 
						(SETQ 2A1L (TRANS 2A1L-A 1 0))
						(SETQ 2B1L (TRANS 2B1L-A 1 0))
						(SETQ 2B2L (TRANS 2B2L-A 1 0))
						(COMMAND "SCP" "U")

						(COMMAND "color" 5 ) ; AZUL
						(COMMAND "3DPOL" 2A1L 2B1L 2B2L 2A1L "" )
						(COMMAND "color" 2 ) ; AMARILLO
						(COMMAND "3DCARA" 3A1L 3B1L 3B2L 3A1L  "" )

						(SETQ 2KKB 2B2L 2KKA 2A1L) 
					) ;repeat
		) ; defun P1

;																									



;																									
;		(P2) PAREJAS DE PUNTOS MAS CERCANOS 3D=>2D=>PINTA (N3B2-N3B1=1)
;																									
		(DEFUN P2 ( / )
					(COMMAND "SCP" "N" "3P" 3B1 3A2 3B2)		; SCP-C 
					(SETQ 2B2-C (TRANS 3B2 0 1))
					(SETQ N2B2-C (LIST (CAR 2B2-C) (- (CADR 2B2-C)) (CADDR 2B2-C)))
					(COMMAND "SCP" "U")

					(COMMAND "SCP" "N" "3P" 3B1 3A2 3A1)		; SCP-B 
					(SETQ 2A1-B (TRANS 3A1 0 1))
					(SETQ 2B1-B (TRANS 3B1 0 1))
					(SETQ 2A2-B (TRANS 3A2 0 1))
					(SETQ 2B2-B N2B2-C)
					(COMMAND "SCP" "U")

					(COMMAND "SCP" "N" "3P" 2B1-B 2A1-B 2A2-B)		; SCP-A
					(SETQ 2A1-A (TRANS 2A1-B 0 1))
					(SETQ 2B1-A (TRANS 2B1-B 0 1))
					(SETQ 2A2-A (TRANS 2A2-B 0 1))
					(SETQ 2B2-A (TRANS 2B2-B 0 1))
					(COMMAND "SCP" "U")

					(COMMAND "SCP" "N" "3P" 2KKB 2KKA "")		; SCP-2D 
					(SETQ 2A1 (TRANS 2A1-A 1 0))
					(SETQ 2B1 (TRANS 2B1-A 1 0))
					(SETQ 2A2 (TRANS 2A2-A 1 0))
					(SETQ 2B2 (TRANS 2B2-A 1 0))
					(COMMAND "SCP" "U")

					(COMMAND "color" 5 ) ; AZUL
					(COMMAND "3DPOL" 2A1 2B1 2B2 2A2 2A1 "" )
					(COMMAND "color" 2 ) ; AMARILLO
					(COMMAND "3DCARA" 3A1 3B1 3B2 3A2 "" )

					(SETQ 2KKB 2B2 2KKA 2A2) 

					;																				
					;	LINEAS ROJAS PARA MARCAR BORDE SECCION "A"  ( 3B1/=3B2 )
					;																				
					(SETQ ENTRE-LINEAS 0.2)
					(SETQ D12 (DISTANCE 2A1 2A2))
					(SETQ X1 (CAR 2A1))
					(SETQ Y1 (CADR 2A1))
					(SETQ X2 (CAR 2A2))
					(SETQ Y2 (CADR 2A2))
					(IF (> Y1 Y2)
						(PROGN
							(SETQ QX (* (- (- Y2 Y1)) (/ ENTRE-LINEAS D12)))
							(SETQ QY (* (- X2 X1) (/ ENTRE-LINEAS D12)))
							(SETQ XX1 (+ X1 QX))
							(SETQ XX2 (+ X2 QX))
						)
						(PROGN
							(SETQ QX (* (- (- Y1 Y2)) (/ ENTRE-LINEAS D12)))
							(SETQ QY (* (- X2 X1) (/ ENTRE-LINEAS D12)))
							(SETQ XX1 (- X1 QX))
							(SETQ XX2 (- X2 QX))
						)
					) : if
					(SETQ YY1 (+ Y1 QY))
					(SETQ YY2 (+ Y2 QY))
					(SETQ Q1 (LIST XX1 YY1))
					(SETQ Q2 (LIST XX2 YY2))
					(COMMAND "color" 1 ) ; ROJO
					(COMMAND "POL" Q1 Q2 "" )
					;																				
					;	MARCA CON UN CIRCULO PRIMER CUADRILATERO  ( 3B1/=3B2 )
					;																				
					(IF (= N2 1) (COMMAND "CIRCULO" "2P" 3A1 3A2))
					(IF (= N2 1) (COMMAND "CIRCULO" "2P" 2A1 2A2))
					;																				
					;	MARCA CON NUMERO DE CAPA LA PIEZA  ( 3B1/=3B2 )
					;																				
					;(IF (= N2 5) (COMMAND "TEXTO" "U" "J" 2B2 Q2 NēCapa))
					;																				
		) ; defun P2

;																									



;																									
;		(P3) PAREJAS DE PUNTOS MAS CERCANOS 3D=>2D=>PINTA (N3B1=N3B2)
;																									
		(DEFUN P3 ( / )
					(COMMAND "SCP" "N" "3P" 3B1 3A1 3A2)	; SCP-AA
					(SETQ 2A1-AA (TRANS 3A1 0 1))
					(SETQ 2B1-AA (TRANS 3B1 0 1))
					(SETQ 2A2-AA (TRANS 3A2 0 1))
					(COMMAND "SCP" "U")

					(COMMAND "SCP" "N" "3P" 2KKB 2KKA "")	; SCP-2D 
					(SETQ 2A1 (TRANS 2A1-AA 1 0))
					(SETQ 2B1 (TRANS 2B1-AA 1 0))
					(SETQ 2A2 (TRANS 2A2-AA 1 0))
					(COMMAND "SCP" "U")

					(COMMAND "color" 5 ) ; AZUL
					(COMMAND "3DPOL" 2A1 2B1 2A2 2A1 "" )
					(COMMAND "color" 2 ) ; AMARILLO
					(COMMAND "3DCARA" 3A1 3B1 3B2 3A2  "" )

					(SETQ 2KKB 2B1 2KKA 2A2) 
					;																				
					;	LINEAS ROJAS PARA MARCAR BORDE SECCION "A"  ( 3B1=3B2 )
					;																				
					(SETQ ENTRE-LINEAS 0.2)
					(SETQ D12 (DISTANCE 2A1 2A2))
					(SETQ X1 (CAR 2A1))
					(SETQ Y1 (CADR 2A1))
					(SETQ X2 (CAR 2A2))
					(SETQ Y2 (CADR 2A2))
					(IF (> Y1 Y2)
						(PROGN
							(SETQ QX (* (- (- Y2 Y1)) (/ ENTRE-LINEAS D12)))
							(SETQ QY (* (- X2 X1) (/ ENTRE-LINEAS D12)))
							(SETQ XX1 (+ X1 QX))
							(SETQ XX2 (+ X2 QX))
						)
						(PROGN
							(SETQ QX (* (- (- Y1 Y2)) (/ ENTRE-LINEAS D12)))
							(SETQ QY (* (- X2 X1) (/ ENTRE-LINEAS D12)))
							(SETQ XX1 (- X1 QX))
							(SETQ XX2 (- X2 QX))
						)
					) : if
					(SETQ YY1 (+ Y1 QY))
					(SETQ YY2 (+ Y2 QY))
					(SETQ Q1 (LIST XX1 YY1))
					(SETQ Q2 (LIST XX2 YY2))
					(COMMAND "color" 1 ) ; ROJO
					(COMMAND "POL" Q1 Q2 "" )
					;																				
					;	MARCA CON CIRCULO PRIMER TRIANGULO  ( 3B1=3B2 )
					;																				
					(IF (= N2 1) (COMMAND "CIRCULO" "2P" 3A1 3A2))
					(IF (= N2 1) (COMMAND "CIRCULO" "2P" 2A1 2A2))
					;																				
					;	MARCA CON NUMERO DE CAPA LA PIEZA  ( 3B1=3B2 )
					;																				
					;(IF (= N2 5) (COMMAND "TEXTO" "U" "J" 2B2 Q2 NēCapa))
		) ; defun P3

;																									



;																									
;		(P4) PUNTOS INTERMEDIOS LIBRES "B" (NO MAS CERCANOS) 3D=>2D=>PINTA
;																									
		(DEFUN P4 ( / )
					(SETQ QQ N3B1)
					(SETQ 3A1L 3A1)
					(SETQ 3A2L 3A2)

					(REPEAT (- N3B1 N3B2)
						(SETQ QQ (- QQ 1))
						(SETQ 3B1L (NTH QQ LIS-PB)) 		; Punto 3B1L
						(SETQ 3B2L (NTH (- QQ 1) LIS-PB)) 	; Punto 3B2L

						(COMMAND "SCP" "N" "3P" 3B1L 3A1L 3B2L)	; SCP-A
						(SETQ 2A1L-A (TRANS 3A1L 0 1))
						(SETQ 2B1L-A (TRANS 3B1L 0 1))
						(SETQ 2B2L-A (TRANS 3B2L 0 1))
						(COMMAND "SCP" "U")

						(COMMAND "SCP" "N" "3P" 2KKB 2KKA "")	; SCP-2D 
						(SETQ 2A1L (TRANS 2A1L-A 1 0))
						(SETQ 2B1L (TRANS 2B1L-A 1 0))
						(SETQ 2B2L (TRANS 2B2L-A 1 0))
						(COMMAND "SCP" "U")

						(COMMAND "color" 5 ) ; AZUL
						(COMMAND "3DPOL" 2A1L 2B1L 2B2L 2A1L "" )
						(COMMAND "color" 2 ) ; AMARILLO
						(COMMAND "3DCARA" 3A1L 3B1L 3B2L 3A1L  "" )

						(SETQ 2KKB 2B2L 2KKA 2A1L) 
					) ;repeat

					(COMMAND "SCP" "N" "3P" 3B2L 3A1L 3a2L)		; SCP-A
					(SETQ 2A1L-A (TRANS 3A1L 0 1))
					(SETQ 2A2L-A (TRANS 3A2L 0 1))
					(SETQ 2B2L-A (TRANS 3B2L 0 1))
					(COMMAND "SCP" "U")

					(COMMAND "SCP" "N" "3P" 2KKB 2KKA "")		; SCP-2D 
					(SETQ 2A1L (TRANS 2A1L-A 1 0))
					(SETQ 2A2L (TRANS 2A2L-A 1 0))
					(SETQ 2B2L (TRANS 2B2L-A 1 0))
					(COMMAND "SCP" "U")

					(COMMAND "color" 5 ) ; AZUL
					(COMMAND "3DPOL" 2A1L 2B2L 2A2L 2A1L "" )
					(COMMAND "color" 2 ) ; AMARILLO
					(COMMAND "3DCARA" 3A1L 3B2L 3A2L 3A1L  "" )

					(SETQ 2KKB 2B2L 2KKA 2A2L) 

		) ; defun P4

;																									


;																									
;		(P5) PUNTOS FINALES LIBRES "B" (NO MAS CERCANOS) 3D=>2D=>PINTA
;																									
		(DEFUN P5 ( / )
					(SETQ QQ N3B2)
					(REPEAT (- N3B2 1)
						(SETQ QQ (- QQ 1))
						(SETQ 3B1L (NTH QQ LIS-PB)) 		; Punto 3B1L
						(SETQ 3B2L (NTH (- QQ 1) LIS-PB)) 												; Punto 3B2L
						(SETQ 3A1L 3A2)

						(COMMAND "SCP" "N" "3P" 3B1L 3A1L 3B2L); SCP-A
						(SETQ 2A1L-A (TRANS 3A1L 0 1))
						(SETQ 2B1L-A (TRANS 3B1L 0 1))
						(SETQ 2B2L-A (TRANS 3B2L 0 1))
						(COMMAND "SCP" "U")

						(COMMAND "SCP" "N" "3P" 2KKB 2KKA ""); SCP-2D 
						(SETQ 2A1L (TRANS 2A1L-A 1 0))
						(SETQ 2B1L (TRANS 2B1L-A 1 0))
						(SETQ 2B2L (TRANS 2B2L-A 1 0))
						(COMMAND "SCP" "U")

						(COMMAND "color" 5 ) ; AZUL
						(COMMAND "3DPOL" 2A1L 2B1L 2B2L 2A1L "" )
						(COMMAND "color" 2 ) ; AMARILLO
						(COMMAND "3DCARA" 3A1L 3B1L 3B2L 3A1L  "" )

						(SETQ 2KKB 2B2L 2KKA 2A1L) 

					) ;repeat
		) ; defun P5

;																									





;																									


		;																							
		;	FORMANDO PARAJAS DE PUNTOS MAS CERCANOS (PAx-PBm) => (LIS-LINE)												
		;																							

		(SETQ PAx      nil
			LIS-LINE nil
			Na        -1 )

		;-LIS-PA----------------------------------------------------------------------------------------------------------------------------------

		(REPEAT Lon-LPA
			(SETQ Na (+ Na 1))
			(SETQ PAx (NTH Na LIS-PA))					; Punto A (1=>N)

			(SETQ LIS-DisAnBn nil
				PBx         nil
				DISm      10000
				DIS  	      nil
				Nb           -1 )

			;-LIS-PB----------------------------------------------------------------------------------------------------------------------------

			(REPEAT Lon-LPB
				(SETQ Nb (+ Nb 1))
				(SETQ PBx (NTH Nb LIS-PB)) 				; Punto B (1=>N)

				(SETQ DIS (DISTANCE PAx PBx))
				(IF (< DIS DISm)  (SETQ DISm DIS  PPA PAx  PPB PBx))

			) ;repeat LPB Nb

			;-LIS-PB----------------------------------------------------------------------------------------------------------------------------


			(SETQ LIS-LINE (CONS (LIST PPA PPB) LIS-LINE))		; LIS-LINE = PAREJA DE PUNTOS MINIMA DISTANCIA (Pax-PBm)


		) ;repeat LPA Na

		;-LIS-PA----------------------------------------------------------------------------------------------------------------------------------


		(SETQ LIS-LINE  (REVERSE LIS-LINE))
		(SETQ Lon-LLINE (LENGTH  LIS-LINE))

		;																							



		;	PINTA LINEAS de (LIS-LINE) COMPROVACION																
		(SETQ N5 -1 )
		(REPEAT Lon-LLINE
			(SETQ N5 (+ N5 1))
			(SETQ QQ1 (CAR  (NTH N5 LIS-LINE)))
			(SETQ QQ2 (CADR (NTH N5 LIS-LINE)))
			(COMMAND "COLOR" 1 "LINEA" QQ1 QQ2 "")
		) ;repeat
		;																							





	 
		;																							

		(SETQ N2 0
			3B2 nil
			3B1 nil
			3A1 nil
			3A2 nil
			2KKB (LIST 0  0 0)
			2KKA (LIST 0 -1 0) )

	;	(REPEAT (- Lon-LPA 1)

			(SETQ N2 (+ N2 1))

			;	(PUNTOS CUATRITATERO 3D)   3A1-3A2-Seccion-A   3B1-3B2-Seccion-B 											

			(SETQ 3A1 (CAR  (NTH (- N2 1) LIS-LINE)))
			(SETQ 3B1 (CADR (NTH (- N2 1) LIS-LINE)))
			(SETQ 3A2 (CAR  (NTH    N2    LIS-LINE)))
			(SETQ 3B2 (CADR (NTH    N2    LIS-LINE)))

			;	NUMERO de Orden Puntos 3D ( N3A1 N3A2 N3B1 N3B2 ) en LIS-PA y PB											

			(SETQ N3A1 N2)
			(SETQ N3A2 (+ N2 1))

			(SETQ QQ (- 1))
		;	(REPEAT Lon-LPB
				(SETQ QQ (+ QQ 1))

				(SETQ PBqq1 (NTH QQ LIS-PB)) 			; Punto Bqq1

				(IF (EQUAL 3B1 PBqq1 XX) (SETQ N3B1(+ QQ 1)))
		;	) ;repeat

			(SETQ QQ (- 1))
		;	(REPEAT Lon-LPB
				(SETQ QQ (+ QQ 1))

				(SETQ PBqq2 (NTH QQ LIS-PB)) 			; Punto Bqq2

				(IF (EQUAL 3B2 PBqq2 XX) (SETQ N3B2(+ QQ 1)))
		;	) ;repeat


			;																						
			;	(P1)PUNTOS PRIMEROS LIBRES "B" (NO MAS CERCANOS) 3D=>2D=>PINTA 											
			;	(P2)PAREJAS DE PUNTOS MAS CERCANOS 3D=>2D=>PINTA (N3B2-N3B1=1)											
			;	(P3)PAREJAS DE PUNTOS MAS CERCANOS 3D=>2D=>PINTA (N3B1=N3B2)											
			;	(P4)PUNTOS INTERMEDIOS LIBRES "B" (NO MAS CERCANOS) 3D=>2D=>PINTA											
			;	(P5)PUNTOS FINALES LIBRES "B" (NO MAS CERCANOS) 3D=>2D=>PINTA											
			;																						


			(IF (AND (> Lon-LPB N3B1) (= N3A1 1))   (P1) ) ; (P1) PUNTOS PRIMEROS LIBRES "B" (NO MAS CERCANOS) 3D=>2D=>PINTA

			(IF (= (- N3B1 N3B2) 1)                 (P2) ) ; (P2) PAREJAS DE PUNTOS MAS CERCANOS 3D=>2D=>PINTA (N3B2-N3B1=1)

			(IF (= (- N3B1 N3B2) 0)                 (P3) ) ; (P3) PAREJAS DE PUNTOS MAS CERCANOS 3D=>2D=>PINTA (N3B1=N3B2)

			(IF (> (- N3B1 N3B2) 1)                 (P4) ) ; (P4) PUNTOS INTERMEDIOS LIBRES "B" (NO MAS CERCANOS) 3D=>2D=>PINTA

			(IF (AND (> N3B2 1) (= N3A2 Lon-LPA))   (P5) ) ; (P5) PUNTOS FINALES LIBRES "B" (NO MAS CERCANOS) 3D=>2D=>PINTA


			;																						




  
;																									


) ; DEFUN ALMACEN-00
