

;=====================================================================================================================================================
;																									
;	( PIEL-06 )	 		GRAFICA LOGARIZMICA (DISTANCIA INTERSECCION TANGENTES A CENTRO TRAZA)									
;																									
;																									
;					** SPLINES-PLANAS ** ABIERTAS ** en PLANOS NO PARALELOS **											
;																									
;					(SPLI-X)    Divide (MODU) (SPLINE-A) (SPLINE-B) => Puntos ( LIS-PA ) ( LIS-PB )							
;																									
;					(TRAZA-AB)  INTERSECCION PLANOS SPLINE-A SPLINE-B => (TRAZ-1) (TRAZ-2)									
;																									
;					(P-LIMITE)  PUNTOS LIMITE DE TRAMOS ENTRE INFINITOS => Puntos (LIS-InfiA) (LIS-InfiB)						
;																									
;					(LIS-PARES) EMPAREJA PUNTOS LIMITE-INFINITO DE (A) y (B) PARA FORMAR TRAMOS FUERA DEL INFINITO => (LIS-PARES)		
;																									
;					FORMA LISTAS A y B de Nş de ORDEN ( LISTA-NşA  LISTA-NşB ) POR TRAMOS FUERA DEL INFINITO						
;																									
;					DETERMINA CARAS ( 3DA1 3DA2 3DB1 3DB2 ) POR TRAMO con (TANGENTE a CIRCULO OSCULADOR desde INTER-TRAZA) ??????????		
;																									

;																									
;																									
;=====================================================================================================================================================



;=====================================================================================================================================================
;																									
;									*** ***  SUB-PROGRAMAS  *** ***											
;																									
;=====================================================================================================================================================

;																									
;	SPLINE-X   GRADUA (0.01) => ( LIS-PX )  																		

	(DEFUN SPLI-X ( / )

		(SETQ ALIS  (ENTGET NX00))  									; lista Spline A
		(SETQ AELE  (ASSOC 10 ALIS))  								; 1ş Punto Asociado a 10 (10.punto)
		(SETQ AELES (MEMBER AELE ALIS)) 								; lista a partir del Alterior (10.punto)....(11.punto)
		(SETQ X-primer (CDR (NTH 0 AELES))) 							; primer elemento (10.punto)
		(SETQ X-ultimo (CDR (NTH (- (LENGTH AELES) 1) AELES)))				; ultimo elemento (11.punto)
		(COMMAND "COLOR" COLO "TEXTO" X-primer 0.2 90 TEX)					; TEXTO = A
		(COMMAND "PUNTO" X-primer)									; PINTA 1Ş punto A
		(SETQ N-enti-A1 (ENTLAST))									; nombre ultima entidad principal 1ş punto A
		(COMMAND "DIVIDE" NX00 MODU)									; Divide SPLI-A
		(COMMAND "PUNTO" X-ultimo)									; PINTA Ultimo Punto A
	
		;	PUNTOS SECCION-A (PA1-PAn) =>   LIS-PX  Lon-LPA															
		(SETQ LIS-PX nil)											; LISTA  PUNTOS-A
		(SETQ LIS-PX (CONS (CDR (ASSOC 10 (ENTGET N-enti-A1))) LIS-PX))			; lista entidad -> (1ş Punto-A)
		(SETQ W1A T)
		(WHILE W1A
			(SETQ N-enti-A2 (ENTNEXT N-enti-A1))						; Nombre entidad siguiente
			(COMMAND "BORRA" N-enti-A1 "")
			(IF (= N-enti-A2 nil)  (SETQ W1A nil)
				(PROGN
					(SETQ LIS-PX (CONS (CDR (ASSOC 10 (ENTGET N-enti-A2))) LIS-PX))
					(SETQ N-enti-A1  N-enti-A2 )
				);progn
			);if
		) ;While W1A
		;	LISTA ( LIS-PX )																				
		(SETQ LIS-PX  (REVERSE LIS-PX))
		(SETQ NşPX (LENGTH LIS-PX))			; LIS-PX = 175+1 =

		;	LISTA ( LIS-PX )																				


		;	PINTA PUNTOS LIS-PX (COMPROVACION)																
	  
		(SETQ N1 -1 )
		(REPEAT (LENGTH LIS-PX)
			(SETQ N1 (+ N1 1))
			(SETQ PAAn (NTH N1 LIS-PX))
			(COMMAND "COLOR" COLO "PUNTO" PAAn  "TEXTO" PAAn 0.03 90 N1)
		) ; repeat

		;																							

	) ; Defun SPLI-X

;																									



;																									
;	Puntos ** TRAZA ** de PLANOS de Secciones (A) y (B) => (TRAZ-1) (TRAZ-2)												

	(DEFUN TRAZA-AB ( / )

		(COMMAND "SCP" "B" NA00 )		; PLANO S-a
 			(SETQ Sa0 (TRANS (LIST    0   0 0) 1 0))
 			(SETQ Sa1 (TRANS (LIST  100 100 0) 1 0))
 			(SETQ Sa2 (TRANS (LIST -100 100 0) 1 0))
		(COMMAND "SCP" "U")

		(COMMAND "SCP" "B" NB00 )		; PLANO S-b
 			(SETQ Sa0b (TRANS Sa0 0 1))
 			(SETQ Sa1b (TRANS Sa1 0 1))
 			(SETQ Sa2b (TRANS Sa2 0 1))
 			(SETQ Sb0 (TRANS (LIST (CAR Sa0b) (CADR Sa0b) 0) 1 0))
 			(SETQ Sb1 (TRANS (LIST (CAR Sa1b) (CADR Sa1b) 0) 1 0))
 			(SETQ Sb2 (TRANS (LIST (CAR Sa2b) (CADR Sa2b) 0) 1 0))
		(COMMAND "SCP" "U")


		(SETQ TRAZ-1  (INTERS Sa0 Sa1 Sb0 Sb1 nil))
		(SETQ TRAZ-2  (INTERS Sa0 Sa2 Sb0 Sb2 nil))

		(SETQ TRAZ-12 (LIST 	(+ (CAR   TRAZ-2) (/ (- (CAR   TRAZ-1) (CAR   TRAZ-2)) 2 ))
						(+ (CADR  TRAZ-2) (/ (- (CADR  TRAZ-1) (CADR  TRAZ-2)) 2 ))
						(+ (CADDR TRAZ-2) (/ (- (CADDR TRAZ-1) (CADDR TRAZ-2)) 2 )) ) )

			(COMMAND "COLOR" 7 "LINEA" TRAZ-1 TRAZ-2 "" )

	) ; Defun TRAZA-AB

;																									


;	INERSECCION TANGENTE-( Paa0 Paa1 ) con TRAZA-( TRAZ-1 TRAZ-2 ) => LIS-TTB  (Distancias INTERSECCION a TRAZ-12)						


	(DEFUN INTER-TAG ( / )

		(COMMAND "SCP" "3P" TRAZ-12 TRAZ-1 (NTH 0 LIS-PXX) )								; PLANO TRAZ-SPLINE-X
			(SETQ Naa -1 )
			(SETQ LIS-TTX nil)
			(REPEAT (LENGTH LIS-PXX)											; *** REPEAT LIS-PXX

				(SETQ Naa (+ Naa 1))
				(SETQ Paa0 (NTH (REM (+ Naa 0) (LENGTH LIS-PXX)) LIS-PXX))					; PUNTO Naa+0
				(SETQ Paa1 (NTH (REM (+ Naa 1) (LENGTH LIS-PXX)) LIS-PXX))					;   "   Naa+1

				(SETQ Paa0-TR (TRANS Paa0 0 1))									; PUNTO Naa+0 PLANO TRAZ-A
				(SETQ Paa1-TR (TRANS Paa1 0 1))									;   "   Naa+1   "     "

				(IF (AND (EQUAL (CADDR Paa0-TR) 0 0.0000001)
					   (EQUAL (CADDR Paa1-TR) 0 0.0000001) )					; Coplanario ( Paa0 Paa1 ) con ( TRAZ-1 TRAZ-2 Paa0 )

					(PROGN
						(IF (EQUAL (CADR Paa0-TR) (CADR Paa1-TR) 0.0000001)				; Paralela ( Paa0 Paa1 ) a ( TRAZ-1 TRAZ-2 )

							(SETQ PDIaa (LIST 100000000000000  0  0) )				; PARALELAS

							(SETQ PDIaa (TRANS (INTERS Paa0 Paa1  TRAZ-1 TRAZ-2 nil) 0 1) )	; SE CRUZAN => PDIaa SCP

						) ; if

						(SETQ DISx (CAR PDIaa) )

						(SETQ P-inT (TRANS PDIaa 1 0))							; PUNTO Interseccion TAG-TRAZA en SCU

						(SETQ LIS-TTX (CONS (LIST Naa  DISx  P-inT  Paa0 ) LIS-TTX))

					) ; progn
					(PROGN
						(PROMPT "------ (Paa0 Paa1) y (TRAZ-1 TRAZ-2) NO SON COPLANARIAS ") (TERPRI)
					) ; progn
				) ; if
			) ; repeat
		(COMMAND "SCP" "U")
		(SETQ LIS-TTX (REVERSE LIS-TTX))

	) ; Defun INTER-TAG

;																									


;	GRAFICA ( LIS-TTXX )  (Distancias INTERSECCION a TRAZ-12)															

	(DEFUN PINTA-GRA ( / )

		(SETQ Na -1 )


		(REPEAT (LENGTH LIS-TTXX)										; *** REPEAT LIS-TTB

			(SETQ Na (+ Na 1))
			(SETQ DISa (CADR (NTH Na LIS-TTXX)) )							; DISTANCIA-A

			(IF (>= DISa 0)

				(SETQ PAD2y (LOG (+ DISa 1.0)))							; DISa (POSITIVO)

				(SETQ PAD2y (* (LOG (+ (* DISa -1.0) 1.0)) -1.0) )				; DISa (NEGATIVO)

			) ; if

			(SETQ PAD2 (LIST (* Na ES-H) (* PAD2y ES-V) ))

			(IF (> Na 0) 
				(PROGN
					(IF (> (DISTANCE PAD1 PAD2) 2.30)
						(PROGN
							(SETQ X1 (CAR PAD1))
							(SETQ X2 (CAR PAD2))
							(SETQ X12 (+ X1 (/ (- X2 X1 ) 2) ) )

							(SETQ +YY (* (LOG 1000001 )    ES-V) )
							(SETQ -YY (* (LOG 1000001 ) -1 ES-V) )

							(SETQ P+INF (LIST X12 +YY ) )
							(SETQ P-INF (LIST X12 -YY ) )
						  
							(IF (> (CADR PAD1) 0) (COMMAND "COLOR" COLO  "LINEA" PAD1  P+INF ""  "LINEA" P-INF PAD2  "") )
							(IF (< (CADR PAD1) 0) (COMMAND "COLOR" COLO  "LINEA" PAD1  P-INF ""  "LINEA" P+INF PAD2  "") )

						) ;progn
		  
						(PROGN
							(COMMAND "COLOR" COLO  "LINEA" PAD1 PAD2 "")
						) ;progn
					) ;if
				) ;progn
			) ;if

			(SETQ PAD1 PAD2)

			(COMMAND  "COLOR" COLO  "PUNTO" PAD2 )

		) ; repeat

	) ; Defun PINTA-GRA

;																									


;	EJES GRAFICA																						

	(DEFUN EJES-GRA ( / )

		(COMMAND "COLOR" 8 "LINEA" (LIST 0 (* (LOG 1000001 )    ES-V) ) (LIST (* (- (LENGTH LIS-TTA) 1) ES-H) (* (LOG 1000001 )    ES-V) ) "")
		(COMMAND "COLOR" 8 "LINEA" (LIST 0 (* (LOG  100001 )    ES-V) ) (LIST (* (- (LENGTH LIS-TTA) 1) ES-H) (* (LOG  100001 )    ES-V) ) "")
		(COMMAND "COLOR" 8 "LINEA" (LIST 0 (* (LOG   10001 )    ES-V) ) (LIST (* (- (LENGTH LIS-TTA) 1) ES-H) (* (LOG   10001 )    ES-V) ) "")
		(COMMAND "COLOR" 8 "LINEA" (LIST 0 (* (LOG    1001 )    ES-V) ) (LIST (* (- (LENGTH LIS-TTA) 1) ES-H) (* (LOG    1001 )    ES-V) ) "")
		(COMMAND "COLOR" 8 "LINEA" (LIST 0 (* (LOG     101 )    ES-V) ) (LIST (* (- (LENGTH LIS-TTA) 1) ES-H) (* (LOG     101 )    ES-V) ) "")
		(COMMAND "COLOR" 8 "LINEA" (LIST 0 (* (LOG      11 )    ES-V) ) (LIST (* (- (LENGTH LIS-TTA) 1) ES-H) (* (LOG      11 )    ES-V) ) "")
		(COMMAND "COLOR" 7 "LINEA" (LIST 0 (* (LOG       1 )    ES-V) ) (LIST (* (- (LENGTH LIS-TTA) 1) ES-H) (* (LOG       1 )    ES-V) ) "")
		(COMMAND "COLOR" 8 "LINEA" (LIST 0 (* (LOG      11 ) -1 ES-V) ) (LIST (* (- (LENGTH LIS-TTA) 1) ES-H) (* (LOG      11 ) -1 ES-V) ) "")
		(COMMAND "COLOR" 8 "LINEA" (LIST 0 (* (LOG     101 ) -1 ES-V) ) (LIST (* (- (LENGTH LIS-TTA) 1) ES-H) (* (LOG     101 ) -1 ES-V) ) "")
		(COMMAND "COLOR" 8 "LINEA" (LIST 0 (* (LOG    1001 ) -1 ES-V) ) (LIST (* (- (LENGTH LIS-TTA) 1) ES-H) (* (LOG    1001 ) -1 ES-V) ) "")
		(COMMAND "COLOR" 8 "LINEA" (LIST 0 (* (LOG   10001 ) -1 ES-V) ) (LIST (* (- (LENGTH LIS-TTA) 1) ES-H) (* (LOG   10001 ) -1 ES-V) ) "")
		(COMMAND "COLOR" 8 "LINEA" (LIST 0 (* (LOG  100001 ) -1 ES-V) ) (LIST (* (- (LENGTH LIS-TTA) 1) ES-H) (* (LOG  100001 ) -1 ES-V) ) "")
		(COMMAND "COLOR" 8 "LINEA" (LIST 0 (* (LOG 1000001 ) -1 ES-V) ) (LIST (* (- (LENGTH LIS-TTA) 1) ES-H) (* (LOG 1000001 ) -1 ES-V) ) "")
		(COMMAND "COLOR" 7)
		(COMMAND  "TEXTO" (LIST (* (- (LENGTH LIS-TTA) 1) ES-H)  (* (LOG 1000001 )    ES-V) )  0.2  90 "  + 1.000.000 Ud." )
		(COMMAND  "TEXTO" (LIST (* (- (LENGTH LIS-TTA) 1) ES-H)  (* (LOG  100001 )    ES-V) )  0.2  90 "   + 100.000 Ud." )
		(COMMAND  "TEXTO" (LIST (* (- (LENGTH LIS-TTA) 1) ES-H)  (* (LOG   10001 )    ES-V) )  0.2  90 "    + 10.000 Ud." )
		(COMMAND  "TEXTO" (LIST (* (- (LENGTH LIS-TTA) 1) ES-H)  (* (LOG    1001 )    ES-V) )  0.2  90 "     + 1.000 Ud." )
		(COMMAND  "TEXTO" (LIST (* (- (LENGTH LIS-TTA) 1) ES-H)  (* (LOG     101 )    ES-V) )  0.2  90 "      + 100 Ud." )
		(COMMAND  "TEXTO" (LIST (* (- (LENGTH LIS-TTA) 1) ES-H)  (* (LOG      11 )    ES-V) )  0.2  90 "       + 10 Ud." )
		(COMMAND  "TEXTO" (LIST (* (- (LENGTH LIS-TTA) 1) ES-H)  (* (LOG       1 )    ES-V) )  0.2  90 "         00 Ud." )
		(COMMAND  "TEXTO" (LIST (* (- (LENGTH LIS-TTA) 1) ES-H)  (* (LOG      11 ) -1 ES-V) )  0.2  90 "       - 10 Ud." )
		(COMMAND  "TEXTO" (LIST (* (- (LENGTH LIS-TTA) 1) ES-H)  (* (LOG     101 ) -1 ES-V) )  0.2  90 "      - 100 Ud." )
		(COMMAND  "TEXTO" (LIST (* (- (LENGTH LIS-TTA) 1) ES-H)  (* (LOG    1001 ) -1 ES-V) )  0.2  90 "     - 1.000 Ud." )
		(COMMAND  "TEXTO" (LIST (* (- (LENGTH LIS-TTA) 1) ES-H)  (* (LOG   10001 ) -1 ES-V) )  0.2  90 "    - 10.000 Ud." )
		(COMMAND  "TEXTO" (LIST (* (- (LENGTH LIS-TTA) 1) ES-H)  (* (LOG  100001 ) -1 ES-V) )  0.2  90 "   - 100.000 Ud." )
		(COMMAND  "TEXTO" (LIST (* (- (LENGTH LIS-TTA) 1) ES-H)  (* (LOG 1000001 ) -1 ES-V) )  0.2  90 "  - 1.000.000 Ud." )

	) ; Defun EJES-GRA

;																									


; PUNTOS CONSECUTIVOS (DTB+0) (DTB+1) de (LIS-TTB) que contienen a PUNTO (DISa) de (LIS-TTA)										

	(DEFUN CONTIENE-PUNTO ( / )

		(SETQ N2 -1)
		(SETQ LIS-NşP0 nil)

		(REPEAT (LENGTH LIS-TTA)

			(SETQ N2 (+ N2 1))
			(SETQ TTA (NTH N2 LIS-TTA))								; (LIS-TTA) => ( Naa  DISx  P-inT  Paa0 )

			(SETQ Naa    (NTH 0 TTA))								; Nş Punto A
			(SETQ DISa   (NTH 1 TTA))								; Distancia en Traza de A
			(SETQ P-inTa (NTH 2 TTA))								; Cordenadas Punto Distancia de A
			(SETQ Paa0   (NTH 3 TTA))								; PUNTO-A0 de la Tag.A 

		  	(SETQ N3 -1)
			(SETQ LIS-Nş0 nil)

			(REPEAT (LENGTH LIS-TTB)

				(SETQ N3 (+ N3 1))

				(SETQ TTB+0 (NTH (REM (+ N3 0) (LENGTH LIS-TTB)) LIS-TTB))		; (LIS-TTB) => ( Nbb  DISx  P-inT  Pbb0 )
				(SETQ TTB+1 (NTH (REM (+ N3 1) (LENGTH LIS-TTB)) LIS-TTB))


				(SETQ Nbb+0    (NTH 0 TTB+0))							; Nş Punto B+0
				(SETQ DISb+0   (NTH 1 TTB+0))							; Distancia en Traza de B+0
				(SETQ P-inTb+0 (NTH 2 TTB+0))							; Cordenadas Punto Distancia de B+0
				(SETQ Pbb0+0   (NTH 3 TTB+0))							; PUNTO-B0 de la Tag.B+0

				(SETQ Nbb+1    (NTH 0 TTB+1))							; Nş Punto B+1
				(SETQ DISb+1   (NTH 1 TTB+1))							; Distancia en Traza de B+1
				(SETQ P-inTb+1 (NTH 2 TTB+1))							; Cordenadas Punto Distancia de B+1
				(SETQ Pbb0+1   (NTH 3 TTB+1))							; PUNTO-B0 de la Tag.B+1

				(SETQ PPbb2 (CADDR TTB+0))							; PUNTO.B Comun a Tag.B y Tag.B+1

				(COND

					( (< DISb+0  DISa  DISb+1)    (SETQ LIS-Nş0 (CONS (LIST Naa  Nbb+0  Nbb+1  P-inTa  Paa0  Pbb0+1 ) LIS-Nş0)) )

					;   ??????????    
	
				) ;cond

			) ;repeat

			;	ELIGE de ( LIS-Nş0 ) ( Nbb+0 Nbb+1 ) MAS PROSIMOS a ( Naa ) => ( LIS-NşP0 )									

		  	(SETQ N4 -1)
			(SETQ Nşmm 10000)

			(REPEAT (LENGTH LIS-Nş0)
				(SETQ N4 (+ N4 1))
				(SETQ PNş0 (NTH N4 LIS-Nş0))			; LIS-Nş0 => ( Naa  Nbb+0  Nbb+1  P-inTa  Paa0  Pbb0+1 )



				(IF (< (ABS (- (NTH 0 PNş0) (/ (+ (NTH 1 PNş0) (NTH 2 PNş0)) 2)))   Nşmm )

					(PROGN

						(SETQ Nşmm  (ABS (- (NTH 0 PNş0) (/ (+ (NTH 1 PNş0) (NTH 2 PNş0)) 2))) )

						(SETQ
							NşPa  (NTH 0 PNş0)
							NşPb0 (NTH 1 PNş0)
							NşPb1 (NTH 2 PNş0)
							INa0  (NTH 3 PNş0)
							Ta0   (NTH 4 PNş0)
							Tb01  (NTH 5 PNş0) )

					) ;progn
				) ;if
			) ;repeat

			(SETQ LIS-NşP0 (CONS (LIST NşPa  NşPb0  NşPb1  INa0  Ta0  Tb01 ) LIS-NşP0))

		) ;repeat

		(SETQ LIS-NşP0 (REVERSE LIS-NşP0))			; (LENGTH LIS-NşP0)  => (  NşPa  NşPb0  NşPb1  INa0  Ta0  Tb01 )


	) ; Defun CONTIENE-PUNTO

;																									



;	PUNTOS LIMITE DE TRAMOS ENTRE INFINITOS																		

	(DEFUN P-LIMITE ( / )

		(COMMAND "SCP" "3P" TRAZ-12 TRAZ-1 (NTH 0 LIS-Po) )								; PLANO TRAZ-SPLINE-X

			(SETQ LIS-InfiX nil)
			(SETQ Nff -1 )
			(REPEAT (LENGTH LIS-Po)											; *** REPEAT LIS-Po

				(SETQ Nff (+ Nff 1))
				(SETQ Pf0 (NTH (REM (+ Nff 0) (LENGTH LIS-Po)) LIS-Po))					; PUNTO Nff+0
				(SETQ Pf1 (NTH (REM (+ Nff 1) (LENGTH LIS-Po)) LIS-Po))					;   "   Nff+1
				(SETQ Pf2 (NTH (REM (+ Nff 2) (LENGTH LIS-Po)) LIS-Po))					;   "   Nff+2

				(SETQ Pf0t (TRANS Pf0 0 1))										; PUNTO Nff+0 PLANO TRAZ-A 
				(SETQ Pf1t (TRANS Pf1 0 1))										;   "   Nff+1   "     "    
				(SETQ Pf2t (TRANS Pf2 0 1))										;   "   Nff+2   "     "    

				(SETQ Ag01 (ANGLE Pf0t Pf1t ))
				(SETQ Ag12 (ANGLE Pf1t Pf2t ))

				(COND
					( (AND (< 0  Ag01      PI ) 	(< PI Ag12 (* 2 PI)))
					 	(COMMAND "COLOR" 7 "CIRCULO" Pf1t 0.05)  (SETQ LIS-InfiX (CONS (LIST (+ Nff 1) 'ARR  Pf1 ) LIS-InfiX)) )

					( (AND (< PI Ag01 (* 2 PI)) 	(< 0  Ag12      PI ))
					 	(COMMAND "COLOR" 9 "CIRCULO" Pf1t 0.05)  (SETQ LIS-InfiX (CONS (LIST (+ Nff 1) 'ABA  Pf1 ) LIS-InfiX)) )
				) ;cond

			  
			) ; repeat
 
		(COMMAND "SCP" "U")
 
		(SETQ LIS-InfiX (REVERSE LIS-InfiX))				;  (LENGTH LIS-InfiX)

	) ; Defun P-LIMITE

;																									





;=====================================================================================================================================================
;=====================================================================================================================================================
;																									
;	  *** PROGRAMA *** PROGRAMA *** PROGRAMA *** PROGRAMA *** PROGRAMA *** PROGRAMA *** PROGRAMA *** PROGRAMA *** PROGRAMA *** PROGRAMA ***		
;																									
;=====================================================================================================================================================
;=====================================================================================================================================================

(DEFUN C:PIEL-06 (/ )
  
	;	ARRANCANDO																						
	(SETVAR "blipmode" 0) (SETVAR "cmdecho" 0) (GRAPHSCR) (COMMAND "-REFENT" "DES"  "SCP" "U"  "ORTO" "DES")

	;	NOMBRE DE CAPAS																					

	;(SETQ NşCapa  (GETINT " NOMBRE de CAPA (461 ?) = ")) (TERPRI)		; Nş NOMBRE DE 1Ş CAPA
	;(SETQ NşCapa (- NşCapa 1))
	;(SETQ W1 T)

	;(WHILE W1

		;(SETQ NşCapa (+ NşCapa 1))
		;(COMMAND "CAPA" "E" NşCapa "") 										; crea y activa capa NşCapa

		;	SELECCCION DE SECCIONES																			
  
		(TERPRI) (SETQ NA00  (CAR (ENTSEL" MARCA --- SPLINE ABIERTA-3D --- SECCION-A ? "))) 	; nombre Spline A 
		(TERPRI) (SETQ NB00  (CAR (ENTSEL" MARCA --- SPLINE ABIERTA-3D --- SECCION-B ? "))) 	; nombre Spline B 

		;-----------------------------------------------------------------------------------------------------------------------------------------
		;	FIJA PARAMETROS																				

		(SETQ MODU   (FIX (/ 35.0  0.2)) )						; Nş de Partes de DIVIDE ( Long-Spline / 0.2 ) = 175 

		;-----------------------------------------------------------------------------------------------------------------------------------------


		;																							
		;	CALCULOS																					

		(TERPRI) (SETQ NX00 NA00  COLO 1 TEX "A" )  (SPLI-X)  (SETQ LIS-PA LIS-PX)	; Divide (SPLINE-A) => Puntos ( LIS-PA )
		(TERPRI) (SETQ NX00 NB00  COLO 5 TEX "B" )  (SPLI-X)  (SETQ LIS-PB LIS-PX)	; Divide (SPLINE-B) => Puntos ( LIS-PB )

		(TRAZA-AB)											; INTERSECCION PLANOS SPLINE-A SPLINE-B => (TRAZ-1) (TRAZ-2)

		(SETQ LIS-Po LIS-PA) (P-LIMITE) (SETQ LIS-InfiA LIS-InfiX)			; PUNTOS LIMITE DE TRAMOS ENTRE INFINITOS => Puntos ( LIS-InfiA )
		(SETQ LIS-Po LIS-PB) (P-LIMITE) (SETQ LIS-InfiB LIS-InfiX)			; PUNTOS LIMITE DE TRAMOS ENTRE INFINITOS => Puntos ( LIS-InfiB )

		;																							

			; REFERENCIA (COMPROVACION)

			'LIS-InfiA (QUOTE ((50 ABA ) (85 ARR ) (88 ABA ) (90 ARR ) (125 ABA ) (176 ARR )))
			'LIS-InfiB (QUOTE ((51 ABA )                     (91 ARR ) (124 ABA ) (175 ARR )))

			'LIS-PARES (QUOTE ((50 51)   (85 nil)  (88 nil)  (90 91)   (125 124)  (176 175)))

		;	EMPAREJA PUNTOS LIMITE-INFINITO DE (A) y (B) PARA FORMAR TRAMOS FUERA DEL INFINITO => (LIS-PARES)						

  		(SETQ LIS-PARES nil)
		(SETQ N6 -1)
		(REPEAT (LENGTH LIS-InfiA)
			(SETQ N6 (+ N6 1))

			(SETQ PfA (NTH N6 LIS-InfiA))				;  ( (+ Nff 1) 'ABA  Pf1 )
			(SETQ QA1 (CAR   PfA))
			(SETQ QA2 (CADR  PfA))
			(SETQ QA3 (CADDR PfA))

			(SETQ DIS-Q 10000)
			(SETQ QA1m nil)
			(SETQ QB1m nil)
			(SETQ N7 -1)
			(REPEAT (LENGTH LIS-InfiB)
				(SETQ N7 (+ N7 1))

				(SETQ PfB (NTH N7 LIS-InfiB))			;  ( (+ Nff 1) 'ABA  Pf1 )
				(SETQ QB1 (CAR   PfB))
				(SETQ QB2 (CADR  PfB))
				(SETQ QB3 (CADDR PfB))

				(COND
					( (AND (< (DISTANCE QA3 QB3) DIS-Q ) (= QA2 QB2) )  (SETQ  DIS-Q (DISTANCE QA3 QB3)  QA1m QA1  QB1m QB1) )
				) ;cond
			) ;repeat

			(COND
				( (> (ABS (- QA1m QB1m)) 3)  (SETQ LIS-PARES (CONS (LIST QA1m  nil ) LIS-PARES)) )
				( (< (ABS (- QA1m QB1m)) 3)  (SETQ LIS-PARES (CONS (LIST QA1m QB1m ) LIS-PARES)) )
			) ;cond
		) ;repeat
  
		(SETQ LIS-PARES (REVERSE LIS-PARES))						    ; ( (50 51) (85 nil) (88 nil) (90 91) (125 124) (176 175) )

		(SETQ LIS-PARES (CONS (NTH (- (LENGTH LIS-PARES) 1) LIS-PARES) LIS-PARES))	; AÑADE AL PRINCIPIO EL ULTIMO ( LIS-PARES )

													; ( (176 175) (50 51) (85 nil) (88 nil) (90 91) (125 124) (176 175) )

		;	PINTA LINEA ENTRE PARES (COMPROVACION)																
		(SETQ N7 -1)
		(REPEAT (LENGTH LIS-PARES)
			(SETQ N7 (+ N7 1))
			(SETQ P7 (NTH N7 LIS-PARES))				;  ( QA1m QB1m )
			(SETQ P7A (CAR   P7))
			(SETQ P7B (CADR  P7))
			(IF (/= P7B nil)

				(COMMAND "COLOR" 7 "LINEA" (NTH (REM P7A (LENGTH LIS-PA)) LIS-PA) (NTH (REM P7B (LENGTH LIS-PB)) LIS-PB) "")

			) ;if
		) ;repeat
		;																							


		;	FORMA LISTAS A y B de Nş de ORDEN ( LISTA-NşA  LISTA-NşB ) POR TRAMOS FUERA DEL INFINITO								

		(SETQ N8 -1)
		(REPEAT 1				;	(- (LENGTH LIS-PARES) 1)		   ; N8   0   1   2   3   4   5   6
			(SETQ N8 (+ N8 1))
			(SETQ P8A   (REM (CAR  (NTH    N8    LIS-PARES)) (LENGTH LIS-PA)) )	;   0  50  85  88  90 125   0
			(SETQ P8A+1 (REM (CAR  (NTH (+ N8 1) LIS-PARES)) (LENGTH LIS-PA)) )	;  50  85  88  90 125   0   0

			(SETQ P8B   (REM (CADR (NTH    N8    LIS-PARES)) (LENGTH LIS-PB)) )	; 175  51 nil nil  91 124 175
			(SETQ P8B+1 (REM (CADR (NTH (+ N8 1) LIS-PARES)) (LENGTH LIS-PB)) )	;  51 nil nil  91 124 175 175		REM żż nil ??
		  
			; LIS-PARES = ((176 175) (50 51) (85 nil) (88 nil) (90 91) (125 124) (176 175))

			(SETQ LIS-NşA-1 nil) 
		  	(SETQ N9 (- P8A 1))
			(REPEAT (+ (- P8A+1 P8A) 1)

				(SETQ N9 (+ N9 1))
				(SETQ LIS-NşA-1 (CONS N9 LIS-NşA-1))
			) ;repeat
			(SETQ LIS-NşA-1 (REVERSE LIS-NşA-1))   	; (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
		  								; 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50)
			(SETQ LIS-NşB-1 nil) 
		  	(SETQ N10 (- P8B 1))
			(REPEAT (+ P8B+1 2)	; truco (mal)  ??????????????????????????????????????????????     ż nil ?

				(SETQ N10 (+ N10 1))
				(SETQ N100 (REM N10 (LENGTH LIS-PB)) )

				(SETQ LIS-NşB-1 (CONS N100 LIS-NşB-1))
			) ;repeat
			(SETQ LIS-NşB-1 (REVERSE LIS-NşB-1))	; (175 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
		  								; 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51)
		) ;repeat

		;																							

		;-----------------------------------------------------------------------------------------------------------------------------------------

		;(SETQ LIS-PXX LIS-PA)  (INTER-TAG)  (SETQ LIS-TTA LIS-TTX)			; (LENGTH LIS-PA) = 175+1 
		;(SETQ LIS-PXX LIS-PB)  (INTER-TAG)  (SETQ LIS-TTB LIS-TTX)			; (LENGTH LIS-PB) = 175+1 

		;-----------------------------------------------------------------------------------------------------------------------------------------


		;	DETERMINA CARAS ( 3DA1 3DA2 3DB1 3DB2 ) POR TRAMO con (TANGENTE a CIRCULO OSCULADOR desde INTER-TRAZA)	??????????			


		(COMMAND "SCP" "B" NB00 )											; PLANO SPLINE-B 

			(COMMAND "CAPA" "DES" (CDR (ASSOC 8 ALIS)) "") 							; DESCONECTA CAPA SPLINES por "LINEA" "TAN"

			(SETQ NNşa -1)
			(SETQ NNşb -1 )

			(REPEAT (- (LENGTH LIS-NşA-1) 1)  ; LIS-NşA-1 = 51 

				(SETQ NNşa (+ NNşa 1))

				(SETQ PPA1  (NTH (NTH (+ NNşa 0) LIS-NşA-1) LIS-PA))
				(SETQ PPA2  (NTH (NTH (+ NNşa 1) LIS-NşA-1) LIS-PA))

				(SETQ INT-A12 (INTERS PPA1 PPA2  TRAZ-1 TRAZ-2 nil))					; SCU 

				(SETQ DISm 100000.0)
				(SETQ NNN  0 )
				(SETQ W1   T )

				(WHILE W1

					(SETQ NNşb (+ NNşb 1))

					(IF (= (NTH (+ NNşb 2) LIS-NşB-1) nil)  (SETQ W1 nil)

						(PROGN

							(SETQ PPB1  (NTH (NTH (+ NNşb 0) LIS-NşB-1) LIS-PB))	; LIS-NşB-1 = 53 
							(SETQ PPB2  (NTH (NTH (+ NNşb 1) LIS-NşB-1) LIS-PB))
							(SETQ PPB3  (NTH (NTH (+ NNşb 2) LIS-NşB-1) LIS-PB))

 							(SETQ PPB1-b    (TRANS PPB1    0 1))
 							(SETQ PPB2-b    (TRANS PPB2    0 1))
 							(SETQ PPB3-b    (TRANS PPB3    0 1))

 							(SETQ PPA2-b    (TRANS PPA2    0 1))
 							(SETQ INT-A12-b (TRANS INT-A12 0 1))							; SCP 

							(COMMAND  "COLOR"  255 )

							(COMMAND  "LINEA"       PPA2-b INT-A12-b ""  ) (SETQ NlineaA (ENTLAST))

							(COMMAND "CIRCULO" "3P" PPB1-b PPB2-b PPB3-b ) (SETQ Ncircu  (ENTLAST))
	
							(COMMAND  "LINEA" "TAN" PPB2-b INT-A12-b ""  ) (SETQ NlineaT (ENTLAST))	; Tangente Inposible: PUNTO DENTRO

							(SETQ P-TaG-b  (TRANS (CDR (ASSOC 10 (ENTGET NlineaT))) 0 1))			; SCP 
							(SETQ P-Tag           (CDR (ASSOC 10 (ENTGET NlineaT)))     )			; SCU 

							(IF (AND (< (DISTANCE P-Tag PPB2) (DISTANCE PPB1 PPB2))  (< (DISTANCE PPA2 PPB2) DISm) )

								(PROGN

									(SETQ DISm  (DISTANCE PPA2 PPB2) )
									(SETQ TTAA  PPA2-b    )
									(SETQ TTBB  P-TaG-b   )
									(SETQ NNBB  NNşb      )
									(SETQ NNN   (+ NNN 1))

									(IF (> NNN 1) (SETQ W1 nil) )


								) ;progn
							) ;if

							(COMMAND "BORRA" Ncircu  "")
							(COMMAND "BORRA" NlineaT "")
							(COMMAND "BORRA" NlineaA "")

						) ;progn
					) ;if
				) ;while

				(COND
				  	( (AND (= NNşa 0) (> NNN 0) )

				  		(SETQ NNşb* NNBB )
						(SETQ NNşb NNşb*)

						(COMMAND "COLOR" 2 "LINEA" TTAA TTBB "")

						(PROMPT " Nş-Tags = ") (PRIN1 NNN)
			  			(PROMPT " Nşa = ")     (PRIN1 NNşa)
					 	(PROMPT " Nşb = ")     (PRIN1 NNşb)
			  			(PROMPT " Nşb* = ")    (PRIN1 NNşb*)
			  			(TERPRI)
					)

					( (AND (> NNşa 0) (> NNN 0) )

						(SETQ NNşb** NNBB)

						(COMMAND "COLOR" 2 "LINEA" TTAA TTBB "")

						(PROMPT " Nş-Tags = ") (PRIN1 NNN)
			  			(PROMPT " Nşa = ")     (PRIN1 NNşa)
					 	(PROMPT " Nşb = ")     (PRIN1 NNşb)
			  			(PROMPT " Nşb* = ")    (PRIN1 NNşb*)
					 	(PROMPT " Nşb** = ")   (PRIN1 NNşb**)
			  			(TERPRI)

						(IF (> NNşb** NNşb*) (SETQ NNşb* NNşb**) (SETQ NNşb* NNşb*) )
						(SETQ NNşb NNşb*)
					)

					( T   (IF (> NNşb** NNşb*) (SETQ NNşb* NNşb**) (SETQ NNşb* NNşb*))
						(SETQ NNşb NNşb*)

					 	(PROMPT " NO CUMPLE CONDICION en Nşa ") (PRIN1 NNşa) (TERPRI)
					)
				) cond

			) ;repeat

		(COMMAND "SCP" "U")





  
		;																							

  




		;	FIJA PARAMETROS GRAFICA																			

		;(SETQ ES-H (/ 1.5 10.0))										; FACTOR ESCALA HORIZONTAL GRAFICA
		;(SETQ ES-V (/ 1.0  2.0))										; FACTOR ESCALA VERTICAL   GRAFICA

		;(SETQ LIS-TTXX LIS-TTA   COLO 1 )    (PINTA-GRA)				; (LENGTH LIS-TTA) => ( Naa  DISx  P-inT  Paa0 )
		;(SETQ LIS-TTXX LIS-TTB   COLO 5 )    (PINTA-GRA)				; (LENGTH LIS-TTB) => ( Nbb  DISx  P-inT  Pbb0 )

		;(EJES-GRA)

		;(CONTIENE-PUNTO)



		;																							





		;	PERFIL SECCION  CARAS-B																			
	;	(SETQ N5 -1)
	;	(REPEAT (- (LENGTH LIS-NşP0) 2)
	;		(SETQ N5 (+ N5 1))
	;		(SETQ TTAB+0 (NTH (+ N5 0) LIS-NşP0))		;  => (  NşPa  NşPb0  NşPb1  INa0  Ta0  Tb01 )
	;		(SETQ TTAB+1 (NTH (+ N5 1) LIS-NşP0))
	;		(SETQ TTAB+2 (NTH (+ N5 2) LIS-NşP0))
	;		(SETQ T0+0 (NTH 3 TTAB+0))
	;		(SETQ TB+0 (NTH 5 TTAB+0))
	;		(SETQ T0+1 (NTH 3 TTAB+1))
	;		(SETQ TB+1 (NTH 5 TTAB+1))
	;		(SETQ T0+2 (NTH 3 TTAB+2))
	;		(SETQ TB+2 (NTH 5 TTAB+2))
	;		(SETQ INT1 (INTERS T0+0 TB+0  T0+1 TB+1 nil) )
	;		(SETQ INT2 (INTERS T0+1 TB+1  T0+2 TB+2 nil) )
	;		(IF (AND (/= INT1 nil) (/= INT2 nil) )  (COMMAND "COLOR" 2 "LINEA" INT1 INT2 "") )
	;	) ;repeat
		;																							

		;	ARISTAS DE CARAS-PLANAS																			
	;	(SETQ N5 -1)
	;	(REPEAT (- (LENGTH LIS-NşP0) 1)
	;		(SETQ N5 (+ N5 1))
	;		(SETQ TTAB   (NTH (+ N5 0) LIS-NşP0))
	;		(SETQ TTAB+1 (NTH (+ N5 1) LIS-NşP0))
	;		(SETQ T0 (NTH 3 TTAB))
	;		(SETQ TA (NTH 4 TTAB))
	;		(SETQ TB (NTH 5 TTAB))
	;		(SETQ T0+1 (NTH 3 TTAB+1))
	;		(SETQ TA+1 (NTH 4 TTAB+1))
	;		(SETQ TB+1 (NTH 5 TTAB+1))
	;		(SETQ 3DA (INTERS T0 TA  T0+1 TA+1 nil) )
	;		(SETQ 3DB (INTERS T0 TB  T0+1 TB+1 nil) )
	;		(IF (AND (/= 3DA nil) (/= 3DB nil) )  (COMMAND "COLOR" 2 "LINEA" 3DA 3DB "") )
	;	) ;repeat
		;																							


		;																							


	;	(SETQ 2KKB (LIST 0 0  0))
 	;	(SETQ 2KKA (LIST 0 -1 0))


	;	(TERPRI) (TERPRI) 
	;	(SETQ NW1 (GETSTRING "QUIERE SEGUIR (S) o N : "))
	;	(IF (EQUAL NW1 "N") (SETQ W1 nil) (SETQ W1 T))

	;) ;CIERRE WHILE W1
  
	;																								

	;	PARANDO																						
	(SETVAR "blipmode" 1) (SETVAR "cmdecho" 1)
) ;CIERRE DEFUN PIEL-06
;=====================================================================================================================================================



