

;-----------------------------------------------------------------------------------------------------------------------------------------------------
;																																																	  |
;	( DESA-KIWI-TriCª-EMBUDOS-022 )	DESARROLLO DE SUPERFICIE de SECCION TRIANGULAR ENTRE SPLINE-EJE y SPLINE-VERTICE    11/07/2007	=> 04/12/2012	  |
;																																																	  |
;                                                    SPLINE-EJE  PLANOS de CORTE SECCIONES  																	 		  |
;                                                    SPLINE-B    PUN-CORTE-B => VERTICE-(BB)	 																		  |
;																																																	  |
;                                                ### SPLINE-A = SPLINE-EJE ###   PUN-CORTE-A => CHca  PcorA  (AA)  (CC) = COLINEALES 					  |
;																																																	  |
;																		EN INICIO (BASE) PUN-CORTE-A = PUNTO MEDIO (AA) (CC) 														  |
;																																																	  |
;                                 	(DWG: ESCULTURA-PAJARO-KIWI-02 dwg) (CAPA: 0741 ) 																					  |
;																																																	  |
;-----------------------------------------------------------------------------------------------------------------------------------------------------


	;--------------------------------------------------------------------------------------------------------------------------------------------------
	;" *** PROGRAMA *** *** PROGRAMA *** *** PROGRAMA *** *** PROGRAMA *** *** PROGRAMA *** *** PROGRAMA *** *** PROGRAMA ***								"	
	;--------------------------------------------------------------------------------------------------------------------------------------------------
	;                                                                                                                                                  
	;  (0) ARRANCANDO																																												
	;  (1) FIJA VARIABLES EN EL PROGRAMA																																					
	;	(1) MARGEN EQUAL para VECTORES UNITARIOS  ( 1.01e-008 ) de LIMITE-MAR-INTER-RECT-01 lsp																			
	;  (2) TOMA DATOS => TRIANGULO-BASE (VERTICES)																																		
	;  (3) TOMA DATOS => (SPLINES-EJE A y B)																																				
	;  (4) CALCULO LISTAS (PUNTOS SPLINES)  																																				
	;	(5) FILTRA  de ( LIS-P-SPL-EJE ) los PUNTOS (P1 P2 P3)>COLIMEALES y (P1 P2 P3 P4)>COPLANARIOS => ( LIS-P-EJE-FILTRO )									
	;  (6) ARISTA de REPROCESO INTERSECCION PLANOS NORMALES (CHARNELAS)  CENTRO ESFERA OSCULADORA  ( MED12 CIR123 ESF1234 )									   
	;  (7) PUNTOS DE CORTE Entre  Lineas de ( LIS-P-SPL-AA ) y Planos de ( LIS-P-MED-CEN-ESF )  =>  ( LIS-P-CORTE-A )												
	;	(8) INTERSECCION PLANO-BASE con PLANO.1       PUNTOS-BASE ( BaseVA  BaseVB  BaseVC  Base## )     (PLANO.1 con PLANO.2 => CEN.1 ESF.1)			   
	;  (9) CALCULO de PUNTOS HOMOLOGOS  ==>   1º-TRIANGULO (AA1 BB1 CC1  XX1)  ==>   2º-TRIANGULO (AA2 BB2 CC2  XX2)												
	; (10) PINTA PIEL 3DCARAS 3D  PATRONES 2D																																		   	
	; (11) PARANDO																																													
	;                                                                                                                                                  
	;--------------------------------------------------------------------------------------------------------------------------------------------------
	;" ***    SUB-PROGRAMA    ***    SUB-PROGRAMA    ***    SUB-PROGRAMA    ***    SUB-PROGRAMA    ***    SUB-PROGRAMA    ***								"	
	;--------------------------------------------------------------------------------------------------------------------------------------------------
	;                                                                                                                                                  
	;  PUNTEA SPLINE a NºDIVISIONES ( NºDiv N-SPL ) => (LIS-PUN-SPLI)																												
	;  INTERSECCION en PLANO-1 de LINEAS (LADOS TRIANGULO com CHARNELA)=>(P-CHARNALA)   (PL1a PL1b)+(PL2a PL2b)=>(IntRS)											
	;  INTERSECCION en PLANO-2 de LINEAS (P-CHARNALA P-CORTE-SPL)=>(VERTICES)           (PL1a PL1b)+(PL2a PL2b)=>(IntRS)											
	;                                                                                                                                                  
	;  PINTA PUNTOS  LIS-P-EJE-FILTRO  ( F1 F2 F3 F4 )																																	
	;	PINTA CENTROS CIRCULOS y ESFERAS OSCULADORAS	  (LIST  MED12 CIR123 ESF1234)																							
	;  PINTA PUNTOS y LINEA  LIS-P-CORTE-A  LIS-P-CORTE-B																																
	;                                                                                                                                                  
	;--------------------------------------------------------------------------------------------------------------------------------------------------


;-----------------------------------------------------------------------------------------------------------------------------------------------------
;		PUNTEA SPLINE a NºDIVISIONES ( NºDiv N-SPL ) => (LIS-PUN-SPLI)																												
;																																																		
(DEFUN PUNTOS-SPLINE_N-SPL (/  )

	(SETQ LIS-PUN-SPLI  nil)
	(SETQ	 Elen (MEMBER (ASSOC 10 (ENTGET N-SPL)) (ENTGET N-SPL))								; lista a partir del elemento (incluido)
		    P-1º    (CDR (NTH      0              Elen))											; primer elemento
		    P-Uo    (CDR (NTH (- (LENGTH Elen) 1) Elen)) )											; ultimo elemento

	(COMMAND  "COLOR" 1 "PUNTO"  P-1º)	(SETQ  N-1ºP (ENTLAST))									; PINTA Primer Punto (en Base de Datos)
 																													; Nombre ultima entidad principal = 1º punto
	(COMMAND	 "COLOR" 2 "DIVIDE" N-SPL NºDiv															; PINTA Punto Divide (en Base de Datos)
			    "COLOR" 5 "PUNTO"  P-Uo       )															; PINTA Ultimo Punto (en Base de Datos)

	;	PUNTOS SECCION X (PX1-PXn) =>  LIS-PUN-SPLI																																		
	(SETQ	N-P1      nil
		   N-P2      nil
		   N-P2      N-1ºP
		   LIS-PUN-SPLI   nil
		   LIS-PUN-SPLI  (LIST (CDR (ASSOC 10 (ENTGET N-1ºP))))									; LIS-PUN-SPLI => 1º punto
		   WW        T )

	(WHILE WW
	  	(SETQ N-P1 (ENTNEXT N-1ºP))																		; nombre entidad siguiente
				
		(IF (= N-P1 nil)	(SETQ WW nil)
			(PROGN
				(SETQ LIS-PUN-SPLI (CONS (CDR (ASSOC 10 (ENTGET N-P1))) LIS-PUN-SPLI))		; LIS-PUN-SPLI => Resto PUNTOS con ULTIMO
				(SETQ  N-1ºP N-P1 )
				(ENTDEL N-P1)																					; BORRA PUNTO
			) ; pro
		) ; if 
	) ; whi
	(SETQ LIS-PUN-SPLI (REVERSE LIS-PUN-SPLI))
	(ENTDEL N-P2)																								; BORRA PUNTO

) ;  DEFUN PUNTOS-SPLINE_N-SPL
;																																																	
;--------------------------------------------------------------------------------------------------------------------------------------------------


;--------------------------------------------------------------------------------------------------------------------------------------------------
;  INTERSECCION en PLANO-1 de LINEAS (LADOS TRIANGULO com CHARNELA)=>(P-CHARNALA)   (PL1a PL1b)+(PL2a PL2b)=>(IntRS)											
;																																																	
(DEFUN LINEAS-INTER-PLANO-1 (/  )

		(SETQ IntRS  nil)

		(SETQ 3P-LINE  nil )
		(SETQ 4P-PLANO nil )

		(SETQ VR1R2 (CAL "VEC1(PL1a , PL1b)"))
		(SETQ VR1S1 (CAL "VEC1(PL1a , PL2a)"))
		(SETQ VR1S2 (CAL "VEC1(PL1a , PL2b)"))

		(SETQ VS1S2 (CAL "VEC1(PL2a , PL2b)"))
		(SETQ VS1R1 (CAL "VEC1(PL2a , PL1a)"))
		(SETQ VS1R2 (CAL "VEC1(PL2a , PL1b)"))

		(COND
			((OR (EQUAL VR1R2 VR1S1 mUNI+ ) (EQUAL VR1R2 (CAL " VR1S1 * -1 ") mUNI+ )) (SETQ 3P-LINE T ))	; En Linea RR1-RR2 PL2a  4pPLANO 
			((OR (EQUAL VR1R2 VR1S2 mUNI+ ) (EQUAL VR1R2 (CAL " VR1S2 * -1 ") mUNI+ )) (SETQ 3P-LINE T ))	; En Linea RR1-RR2 PL2b 

			((OR (EQUAL VS1S2 VS1R1 mUNI+ ) (EQUAL VS1S2 (CAL " VS1R1 * -1 ") mUNI+ )) (SETQ 3P-LINE T ))	; EN Linea SS1-SS2 PL1a 
			((OR (EQUAL VS1S2 VS1R2 mUNI+ ) (EQUAL VS1S2 (CAL " VS1R2 * -1 ") mUNI+ )) (SETQ 3P-LINE T ))	; EN Linea SS1-SS2 PL1b 

			( T  	(SETQ V11R (CAL "NOR(PL1b , PL2b , PL1a)"))
					(SETQ V11S (CAL "NOR(PL1b , PL2b , PL2a)"))
					(IF (OR (EQUAL V11R  V11S  mUNI+) (EQUAL V11R  (CAL " V11S * -1 ")  mUNI+))
						(PROGN  ;  LINEAS COPLANARIAS 
							(SETQ 4P-PLANO T )
						) ; pro

						(PROGN
							(TERPRI) (PROMPT " >>>>>>>>>> LINEAS que se CRUZAN ???  >>> NºHo = ") (PRIN1 NºHo)   ; LINEAS NO COPLANARIAS
							(SETQ WWho nil)
						) ; pro
					) ; if
			) ; T
		) ; con

		(IF (OR (= 3P-LINE T ) (= 4P-PLANO T ))
			(PROGN  ;  LINEAS COPLANARIAS 
				(SETQ Vrr (CAL "VEC1(PL1a , PL1b)"))
				(SETQ Vss (CAL "VEC1(PL2a , PL2b)"))

				(IF (OR (EQUAL Vrr Vss mUNI+ ) (EQUAL Vrr (CAL " Vss * -1 ") mUNI+ ))
					(PROGN  ;  >>>>>>>>> LINEAS PARALELAS => SE CORTAN en INFINITO >>>>>> 
						(TERPRI) (PROMPT " >>>>>>>>>> LINEAS PARALELAS ???  >>>     NºHo = ") (PRIN1 NºHo)
						(SETQ WWho nil)

						;(SETQ IntRS (CAL "( PL2a + (Vb12 / mUNI+))")) ; ??? INFINITO ??? 
					) ; pro 

					(PROGN  ;  LINEAS COPLANARIAS NO PARALELAS => SE CORTAN

						(SETQ IntRS (CAL "ILL(PL1a , PL1b , PL2a , PL2b)"))

						(IF (= IntRS nil)
							(PROGN

								(COMMAND "SCP" "3P" Sc12o Sc12x Sc1y )				; PLANO-1  Sc2y

									(SETQ RR1o (TRANS (LIST (CAR (TRANS PL1a 0 1 )) (CADR (TRANS PL1a 0 1 )) 0.0 ) 1 0 ))
									(SETQ RR2o (TRANS (LIST (CAR (TRANS PL1b 0 1 )) (CADR (TRANS PL1b 0 1 )) 0.0 ) 1 0 ))
									(SETQ SS1o (TRANS (LIST (CAR (TRANS PL2a 0 1 )) (CADR (TRANS PL2a 0 1 )) 0.0 ) 1 0 ))
									(SETQ SS2o (TRANS (LIST (CAR (TRANS PL2b 0 1 )) (CADR (TRANS PL2b 0 1 )) 0.0 ) 1 0 ))

								(COMMAND "SCP" "" )

								(SETQ IntRS (CAL "ILL(RR1o , RR2o , SS1o , SS2o)"))

								(TERPRI) (PROMPT " >>>>>>>>>> REPARADO Funcion ILL  >>>>>>> NºHo = ") (PRIN1 NºHo)
							) ; pro
						) ; if
					) ; pro 
				) ; if
			) ; pro
		) ; if

) ;  DEFUN  LINEAS-INTER-PLANO-1
;																																																	
;--------------------------------------------------------------------------------------------------------------------------------------------------



;--------------------------------------------------------------------------------------------------------------------------------------------------
;  INTERSECCION en PLANO-2 de LINEAS (P-CHARNALA P-CORTE-SPL)=>(VERTICES)           (PL1a PL1b)+(PL2a PL2b)=>(IntRS)											
;																																																	
(DEFUN LINEAS-INTER-PLANO-2 (/  )

		(SETQ IntRS  nil)

		(SETQ 3P-LINE  nil )
		(SETQ 4P-PLANO nil )

		(SETQ VR1R2 (CAL "VEC1(PL1a , PL1b)"))
		(SETQ VR1S1 (CAL "VEC1(PL1a , PL2a)"))
		(SETQ VR1S2 (CAL "VEC1(PL1a , PL2b)"))

		(SETQ VS1S2 (CAL "VEC1(PL2a , PL2b)"))
		(SETQ VS1R1 (CAL "VEC1(PL2a , PL1a)"))
		(SETQ VS1R2 (CAL "VEC1(PL2a , PL1b)"))

		(COND
			((OR (EQUAL VR1R2 VR1S1 mUNI+ ) (EQUAL VR1R2 (CAL " VR1S1 * -1 ") mUNI+ )) (SETQ 3P-LINE T ))	; En Linea RR1-RR2 PL2a  4pPLANO 
			((OR (EQUAL VR1R2 VR1S2 mUNI+ ) (EQUAL VR1R2 (CAL " VR1S2 * -1 ") mUNI+ )) (SETQ 3P-LINE T ))	; En Linea RR1-RR2 PL2b 

			((OR (EQUAL VS1S2 VS1R1 mUNI+ ) (EQUAL VS1S2 (CAL " VS1R1 * -1 ") mUNI+ )) (SETQ 3P-LINE T ))	; EN Linea SS1-SS2 PL1a 
			((OR (EQUAL VS1S2 VS1R2 mUNI+ ) (EQUAL VS1S2 (CAL " VS1R2 * -1 ") mUNI+ )) (SETQ 3P-LINE T ))	; EN Linea SS1-SS2 PL1b 

			( T  	(SETQ V11R (CAL "NOR(PL1b , PL2b , PL1a)"))
					(SETQ V11S (CAL "NOR(PL1b , PL2b , PL2a)"))
					(IF (OR (EQUAL V11R  V11S  mUNI+) (EQUAL V11R  (CAL " V11S * -1 ")  mUNI+))
						(PROGN  ;  LINEAS COPLANARIAS 
							(SETQ 4P-PLANO T )
						) ; pro

						(PROGN
							(TERPRI) (PROMPT " >>>>>>>>>> LINEAS que se CRUZAN ???  >>> NºHo = ") (PRIN1 NºHo)   ; LINEAS NO COPLANARIAS
							(SETQ WWho nil)
						) ; pro
					) ; if
			) ; T
		) ; con

		(IF (OR (= 3P-LINE T ) (= 4P-PLANO T ))
			(PROGN  ;  LINEAS COPLANARIAS 
				(SETQ Vrr (CAL "VEC1(PL1a , PL1b)"))
				(SETQ Vss (CAL "VEC1(PL2a , PL2b)"))

				(IF (OR (EQUAL Vrr Vss mUNI+ ) (EQUAL Vrr (CAL " Vss * -1 ") mUNI+ ))
					(PROGN  ;  >>>>>>>>> LINEAS PARALELAS => SE CORTAN en INFINITO >>>>>> 
						(TERPRI) (PROMPT " >>>>>>>>>> LINEAS PARALELAS ???  >>>     NºHo = ") (PRIN1 NºHo)
						(SETQ WWho nil)

						;(SETQ IntRS (CAL "( PL2a + (Vb12 / mUNI+))")) ; ??? INFINITO ??? 
					) ; pro 

					(PROGN  ;  LINEAS COPLANARIAS NO PARALELAS => SE CORTAN

						(SETQ IntRS (CAL "ILL(PL1a , PL1b , PL2a , PL2b)"))

						(IF (= IntRS nil)
							(PROGN

								(COMMAND "SCP" "3P" Sc12o Sc12x Sc2y )				; PLANO-2  

									(SETQ RR1o (TRANS (LIST (CAR (TRANS PL1a 0 1 )) (CADR (TRANS PL1a 0 1 )) 0.0 ) 1 0 ))
									(SETQ RR2o (TRANS (LIST (CAR (TRANS PL1b 0 1 )) (CADR (TRANS PL1b 0 1 )) 0.0 ) 1 0 ))
									(SETQ SS1o (TRANS (LIST (CAR (TRANS PL2a 0 1 )) (CADR (TRANS PL2a 0 1 )) 0.0 ) 1 0 ))
									(SETQ SS2o (TRANS (LIST (CAR (TRANS PL2b 0 1 )) (CADR (TRANS PL2b 0 1 )) 0.0 ) 1 0 ))

								(COMMAND "SCP" "" )

								(SETQ IntRS (CAL "ILL(RR1o , RR2o , SS1o , SS2o)"))

								(TERPRI) (PROMPT " >>>>>>>>>> REPARADO Funcion ILL  >>>>>>> NºHo = ") (PRIN1 NºHo)
							) ; pro
						) ; if
					) ; pro 
				) ; if
			) ; pro
		) ; if

) ;  DEFUN  LINEAS-INTER-PLANO-2 
;																																																	
;--------------------------------------------------------------------------------------------------------------------------------------------------


	;--------------------------------------------------------------------------------------------------------------------------------------------------
	;  PINTA PUNTOS  LIS-P-EJE-FILTRO  ( F1 F2 F3 F4 )																																	
	;																																																	
	(DEFUN PINTA-P-EJE (/  )

			(SETQ NºE -1)
			(REPEAT (LENGTH LIS-P-EJE-FILTRO)
				(SETQ NºE (+ NºE 1))

				(SETQ F1 (NTH 0 (NTH NºE  LIS-P-EJE-FILTRO)))
				(SETQ F2 (NTH 1 (NTH NºE  LIS-P-EJE-FILTRO)))
				(SETQ F3 (NTH 2 (NTH NºE  LIS-P-EJE-FILTRO)))
				(SETQ F4 (NTH 3 (NTH NºE  LIS-P-EJE-FILTRO)))

				(IF (= (REM (+ NºE 1) 5) 0) (SETQ Colo3 5) (SETQ Colo3 (REM (+ NºE 1) 5)))
				(COMMAND "COLOR" 7 "LINEA"  F1 F2 "")
				(COMMAND "COLOR" 7 "PUNTO"  F1)
				;(COMMAND "COLOR" 7 "TEXTO" "MI" F1 0.6  0  (STRCAT "-PUN-" (ITOA (+ NºE 1))))

				(SETQ MF12 (CAL "PLT ( F1 , F2 , 0.5 )"))  (COMMAND "COLOR" 255 "PUNTO"  MF12)

				(IF (= NºE (- (LENGTH LIS-P-EJE-FILTRO) 1))																; PINTA ULTIMOS PUNTOS 
					(PROGN
						(COMMAND "COLOR" 7 "LINEA"  F2 F3 "")
						(COMMAND "COLOR" 7 "LINEA"  F3 F4 "")

						(COMMAND "COLOR" 7 "PUNTO"  F2) ;(COMMAND "COLOR" 7 "TEXTO" "MI" F2 0.6  0  (STRCAT "-PUN-" (ITOA (+ NºE 2))))
						(COMMAND "COLOR" 7 "PUNTO"  F3) ;(COMMAND "COLOR" 7 "TEXTO" "MI" F3 0.6  0  (STRCAT "-PUN-" (ITOA (+ NºE 3))))
						(COMMAND "COLOR" 7 "PUNTO"  F4) ;(COMMAND "COLOR" 7 "TEXTO" "MI" F4 0.6  0  (STRCAT "-PUN-" (ITOA (+ NºE 4))))

						(SETQ MF23 (CAL "PLT ( F2 , F3 , 0.5 )"))  (COMMAND "COLOR" 255 "PUNTO"  MF23)
						(SETQ MF34 (CAL "PLT ( F3 , F4 , 0.5 )"))  (COMMAND "COLOR" 255 "PUNTO"  MF34)
					) ; pro
				) ; if
			) ; repe

	) ; Defun   PINTA-P-EJE
	;																																																	
	;--------------------------------------------------------------------------------------------------------------------------------------------------


	;--------------------------------------------------------------------------------------------------------------------------------------------------
	;	PINTA CENTROS CIRCULOS y ESFERAS OSCULADORAS	  (LIST  MED12 CIR123 ESF1234)																							
	;																																																	
	(DEFUN PINTA-P-MED-CEN-ESF-PLANOS (/  )

			(SETQ NºC -1)
			(REPEAT  (- (LENGTH LIS-P-MED-CEN-ESF) 1)
				(SETQ NºC (+ NºC 1))

				(SETQ MED1 (NTH 0 (NTH (+ NºC 0) LIS-P-MED-CEN-ESF)))
				(SETQ CIR1 (NTH 1 (NTH (+ NºC 0) LIS-P-MED-CEN-ESF)))
				(SETQ ESF1 (NTH 2 (NTH (+ NºC 0) LIS-P-MED-CEN-ESF)))

				(SETQ MED2 (NTH 0 (NTH (+ NºC 1) LIS-P-MED-CEN-ESF)))
				(SETQ CIR2 (NTH 1 (NTH (+ NºC 1) LIS-P-MED-CEN-ESF)))
				(SETQ ESF2 (NTH 2 (NTH (+ NºC 1) LIS-P-MED-CEN-ESF)))

				(IF (= (REM (+ NºC 1) 5) 0) (SETQ Colo5 5) (SETQ Colo5 (REM (+ NºC 1) 5)))

				(COMMAND "COLOR" Colo5 "PUNTO"      MED1 )										; P-MEDIO 
				;(COMMAND "COLOR" Colo5 "TEXTO" "MI" MED1 0.6 0 (STRCAT "-MED-" (ITOA (+ NºC 1)) ":" (ITOA (+ NºC 2))))

				;(COMMAND "COLOR" 14    "LINEA"      CIR1 CIR2 "")								; CIRCULO 
				;(COMMAND "COLOR" Colo5 "PUNTO"      CIR1 )
				;(COMMAND "COLOR" Colo5 "TEXTO" "MI" CIR1 0.6 0 (STRCAT "-CIR-" (ITOA (+ NºC 1)) ":" (ITOA (+ NºC 2)) ":" (ITOA (+ NºC 3))))

				;(COMMAND "COLOR" 254   "LINEA"      ESF1 ESF2 "")								; ESFERA  
				;(COMMAND "COLOR" Colo5 "PUNTO"      ESF1 )
				;(COMMAND "COLOR" Colo5 "TEXTO" "MI" ESF1 0.6 0 (STRCAT "-ESF-" (ITOA (+ NºC 1)) ":" (ITOA (+ NºC 2)) ":" (ITOA (+ NºC 3)) ":" (ITOA (+ NºC 4))))

				;(COMMAND "COLOR" Colo5  "LINEA" MED1 CIR1 ESF1 "")								; MED1 + CHARNELA 

				(SETQ VMC1 (CAL " VEC1 ( MED1 , CIR1 )"))
				(SETQ VCE1 (CAL " VEC1 ( CIR1 , ESF1 )"))

				(IF (< (CAR  VMC1)  0.0) (SETQ VMC1 (CAL " VMC1 * -1 ")))					; CONDICION => SIEMPRE  VMC1x > 0 
				(IF (< (CADR VCE1)  0.0) (SETQ VCE1 (CAL " VCE1 * -1 ")))					; CONDICION => SIEMPRE  VCE1y > 0 

				(SETQ P1Q1 (CAL " MED1 + ( VMC1 * -10 ) + ( VCE1 * -10 )"))
				(SETQ P1Q2 (CAL " MED1 + ( VMC1 * +10 ) + ( VCE1 * -10 )"))
				(SETQ P1Q3 (CAL " MED1 + ( VMC1 * +10 ) + ( VCE1 * +30 )"))
				(SETQ P1Q4 (CAL " MED1 + ( VMC1 * -10 ) + ( VCE1 * +30 )"))

				(COMMAND "COLOR" Colo5 "3DCARA" P1Q1  P1Q2  P1Q3  P1Q4 "")					; PLANO GENERICO  3DCARA 

				;(COMMAND "COLOR" Colo5 "LINEA"  MED1  CIR1  ESF1 "")							; ESCUADRA 

				; PINTA ULTIMOS PUNTOS 																																							

				(IF (= NºC (- (LENGTH LIS-P-MED-CEN-ESF) 2))											; ULTIMOS PUNTOS CHARNE 
					(PROGN
						(IF (= (REM (+ NºC 2) 5) 0) (SETQ Colo5+1 5) (SETQ Colo5+1 (REM (+ NºC 2) 5)))

						(COMMAND "COLOR" Colo5+1 "PUNTO"      MED2 )								; P-MEDIO 
						;(COMMAND "COLOR" Colo5+1 "TEXTO" "MI" MED2 0.6 0 (STRCAT "-MED-" (ITOA (+ NºC 2)) ":" (ITOA (+ NºC 3))))

						;(COMMAND "COLOR" Colo5+1 "PUNTO"      CIR2 )								; CIRCULO 
						;(COMMAND "COLOR" Colo5+1 "TEXTO" "MI" CIR2 0.6 0 (STRCAT "-CIR-" (ITOA (+ NºC 2)) ":" (ITOA (+ NºC 3)) ":" (ITOA (+ NºC 4))))

						;(COMMAND "COLOR" Colo5+1 "PUNTO"      ESF2 )								; ESFERA  
						;(COMMAND "COLOR" Colo5+1 "TEXTO" "MI" ESF2 0.6 0 (STRCAT "-ESF-" (ITOA (+ NºC 2)) ":" (ITOA (+ NºC 3)) ":" (ITOA (+ NºC 4)) ":" (ITOA (+ NºC 5))))

						;(COMMAND "COLOR" Colo5+1  "LINEA" MED2 CIR2 ESF2 "")								; MED2 + CHARNELA 

						(SETQ VMC2 (CAL " VEC1 ( MED2 , CIR2 )"))
						(SETQ VCE2 (CAL " VEC1 ( CIR2 , ESF2 )"))

						(IF (< (CAR  VMC2)  0.0) (SETQ VMC2 (CAL " VMC2 * -1 ")))					; CONDICION => SIEMPRE  VMC2x > 0 
						(IF (< (CADR VCE2)  0.0) (SETQ VCE2 (CAL " VCE2 * -1 ")))					; CONDICION => SIEMPRE  VCE2y > 0 

						(SETQ P2Q1 (CAL " MED2 + ( VMC2 * -10 ) + ( VCE2 * -10 )"))
						(SETQ P2Q2 (CAL " MED2 + ( VMC2 * +10 ) + ( VCE2 * -10 )"))
						(SETQ P2Q3 (CAL " MED2 + ( VMC2 * +10 ) + ( VCE2 * +30 )"))
						(SETQ P2Q4 (CAL " MED2 + ( VMC2 * -10 ) + ( VCE2 * +30 )"))

						(COMMAND "COLOR" Colo5+1 "3DCARA" P2Q1  P2Q2  P2Q3  P2Q4 "")		; PLANO ULTINO  3DCARA 

						;(COMMAND "COLOR" Colo5+1 "LINEA"  MED2  CIR2  ESF2 "")				; ESCUADRA 
					) ; pro
				) ; if
			) ; repe

	) ; Defun   PINTA-P-MED-CEN-ESF-PLANOS 
	;																																																	
	;--------------------------------------------------------------------------------------------------------------------------------------------------


	;--------------------------------------------------------------------------------------------------------------------------------------------------
	;  PINTA PUNTOS y LINEA  LIS-P-CORTE-A  LIS-P-CORTE-B																																
	;																																																	
	(DEFUN PINTA-PUN-CORTE (/  )

		(IF (= (LENGTH LIS-P-CORTE-A) (LENGTH LIS-P-CORTE-B))
			(PROGN

				(SETQ Nº2 -1)
				(REPEAT  (LENGTH LIS-P-CORTE-A)
					(SETQ Nº2 (+ Nº2 1))

					(SETQ PcoA (NTH Nº2  LIS-P-CORTE-A))
					(SETQ PcoB (NTH Nº2  LIS-P-CORTE-B))

					(IF (= (REM (+ Nº2 1) 5) 0) (SETQ Colo4 5) (SETQ Colo4 (REM (+ Nº2 1) 5)))
					(COMMAND "COLOR" Colo4 "PUNTO" PcoA)   ;(COMMAND "COLOR" Colo4 "TEXTO" "MD" PcoA 0.6 0 (STRCAT (ITOA Nº2) "-"))
					(COMMAND "COLOR" Colo4 "PUNTO" PcoB)   ;(COMMAND "COLOR" Colo4 "TEXTO" "MI" PcoB 0.6 0 (STRCAT "-" (ITOA Nº2)))
					(COMMAND "COLOR" Colo4 "LINEA" PcoA PcoB "")
				) ; repe
			) ; pro

			(PROGN
				(TERPRI) (PROMPT " >>> LISTAS de CORTE NO IGUALES ??? ")
			) ; pro
		) ; if

  	) ; Defun   PINTA-PUN-CORTE
	;																																																	
	;--------------------------------------------------------------------------------------------------------------------------------------------------



;-----------------------------------------------------------------------------------------------------------------------------------------------------
"####################################################################################################################################################"
;-----------------------------------------------------------------------------------------------------------------------------------------------------
; 						*** PROGRAMA *** PROGRAMA *** PROGRAMA *** PROGRAMA *** PROGRAMA *** PROGRAMA *** PROGRAMA *** PROGRAMA ***									
;-----------------------------------------------------------------------------------------------------------------------------------------------------
"####################################################################################################################################################"
;---------------------------------------------------------------------------------------------------------------------------------------------------- 


(DEFUN C:DESA-KIWI-TriCª-EMBUDOS-022 ( / )

	;--------------------------------------------------------------------------------------------------------------------------------------------------
	;  (0) ARRANCANDO																																												
	;																																																	

	(SETVAR "blipmode" 0)  (SETVAR "cmdecho" 0)  (GRAPHSCR)  (COMMAND "-REFENT" "DES")  (COMMAND "SCP" "U"  )  (COMMAND "ORTO" "DES")

	(TERPRI) (PROMPT " ============================================ ")
	(TERPRI) (PROMPT " >>>>>>>>>>>>>>>>>> INICIO >>>>>>>>>>>>>>>>>> ")
	(TERPRI) (PROMPT " ============================================ ") (TERPRI)

	(IF (= CAL nil)(COMMAND "ARX" "L" "GEOMCAL.ARX"))							; CARGA CALCULADORA 
	;																																																	
	;--------------------------------------------------------------------------------------------------------------------------------------------------

  
	;--------------------------------------------------------------------------------------------------------------------------------------------------
	;  (1) FIJA VARIABLES EN EL PROGRAMA																																					
	;																																																	

		(SETQ NºDi-EJ   100 )									; NºDIVIDE  SPLINE-BASE-PLANOS CORTE SECCIONES 
		(SETQ NºDi-AB   300 )									; NºDIVIDE  SPLINE(A) PUNTOS-CORTE 

	;--------------------------------------------------------------------------------------------------------------------------------------------------
	;  (1) MARGEN EQUAL para VECTORES UNITARIOS  ( 1.01e-008 ) de LIMITE-MAR-INTER-RECT-01 lsp																			

		(SETQ mUNI+ 1.02e-006 )								; mUNI+ 1.02e-008  MAYOR que LIMITE 		COPROBAR SIGNOS en NOMBRES ??? 
		(SETQ mUNI= 1.01e-008 )								; mUNI= 1.02e-008  IGUAL que LIMITE 
		(SETQ mUNI- 1.00e-008 )								; mUNI- 1.00e-008  MENOR que LIMITE 

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


	;--------------------------------------------------------------------------------------------------------------------------------------------------
	;  (2) TOMA DATOS => TRIANGULO-BASE (VERTICES)																																		
	;																																																	

	(COMMAND "-REFENT" "_NOD")
		(TERPRI) (SETQ BaseVA (GETPOINT " >>>>>>>>> MARCA 1/3 VERT-BASE (1ºP-SpliA) Verti-A "))
		(TERPRI) (SETQ BaseVB (GETPOINT " >>>>>>>>> MARCA 2/3 VERT-BASE (1ºP-SpliB) Verti-B "))
		(TERPRI) (SETQ BaseVC (GETPOINT " >>>>>>>>> MARCA 3/3 VERT-BASE (           Verti-C ")) (TERPRI)
	(COMMAND "-REFENT" "DES")
	;																																																	
	;--------------------------------------------------------------------------------------------------------------------------------------------------


	;--------------------------------------------------------------------------------------------------------------------------------------------------
	;  (3) TOMA DATOS => (SPLINES)																																							
	;																																																	

 	(TERPRI)  (SETQ N-SPL-EJ (CAR (ENTSEL "------ (BASE-PLANOS) y PUN-CORTE(A)   MARCA SPLINE-EJE" )))  (TERPRI)
 	(TERPRI)  (SETQ N-SPL-BB (CAR (ENTSEL "---------------------- PUN-CORTE(B)   MARCA SPLINE(B) " )))  (TERPRI)

 	;(TERPRI)  (SETQ N-SPL-AA (CAR (ENTSEL "-----------------  MARCA  SPLINE(A) PUN-CORTE(A)  <== " )))  (TERPRI)   

	(SETQ N-SPL-AA  N-SPL-EJ  )						; ### SPLINE-A = SPLINE-EJE ### 	

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

  
	;--------------------------------------------------------------------------------------------------------------------------------------------------
	;  (4) CALCULO LISTAS (PUNTOS SPLINES)  																																				
	;																																																	

	(SETQ N-SPL  N-SPL-EJ     NºDiv  NºDi-EJ )  (PUNTOS-SPLINE_N-SPL )  (SETQ LIS-P-SPL-EJE  LIS-PUN-SPLI )				; (LENGTH LIS-P-SPL-EJE) 
	(SETQ N-SPL  N-SPL-BB     NºDiv  NºDi-AB )  (PUNTOS-SPLINE_N-SPL )  (SETQ LIS-P-SPL-BB   LIS-PUN-SPLI )				; (LENGTH LIS-P-SPL-BB ) 

	(SETQ N-SPL  N-SPL-AA     NºDiv  NºDi-AB )  (PUNTOS-SPLINE_N-SPL )  (SETQ LIS-P-SPL-AA   LIS-PUN-SPLI )				; (LENGTH LIS-P-SPL-AA ) 
	; ### SPLINE-A = SPLINE-EJE ### 

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


	;--------------------------------------------------------------------------------------------------------------------------------------------------
	;	(5) FILTRA  de ( LIS-P-SPL-EJE ) los PUNTOS (P1 P2 P3)>COLIMEALES y (P1 P2 P3 P4)>COPLANARIOS => ( LIS-P-EJE-FILTRO )									
	;																																																	
	(SETQ  FILTRA-PUNTOS-EJE  'SI )  (IF (= FILTRA-PUNTOS-EJE  'SI )  (PROGN

		(SETQ LIS-P-EJE-FILTRO nil)

		(SETQ NºNO 0 )
		(SETQ Nº4  0 )
		(SETQ NºF -1 )
		(REPEAT (- (LENGTH LIS-P-SPL-EJE) 3)
			(SETQ NºF (+ NºF 1))
			(SETQ Nº4 (+ Nº4 1))

			(SETQ PF1 (NTH (+ NºF 0) LIS-P-SPL-EJE))																	; PUNTOS EJE 
			(SETQ PF2 (NTH (+ NºF 1) LIS-P-SPL-EJE))
			(SETQ PF3 (NTH (+ NºF 2) LIS-P-SPL-EJE))
			(SETQ PF4 (NTH (+ NºF 3) LIS-P-SPL-EJE))

			(SETQ VF12 (CAL "VEC1 ( PF1 , PF2 )"))																		; VEC-12   UNI (P1 P2) 
			(SETQ VF23 (CAL "VEC1 ( PF2 , PF3 )"))
			(SETQ VF34 (CAL "VEC1 ( PF3 , PF4 )"))

			(SETQ VF123 (CAL "NOR ( PF1 , PF2 , PF3 )"))																; VEC-Z    UNI (P1 P2 P3) 
			(SETQ VF234 (CAL "NOR ( PF2 , PF3 , PF4 )"))

			(IF (OR  (EQUAL VF12  VF23  mUNI+)																			; COLIMEALES  (P1 P2 P3)     
						(EQUAL VF23  VF34  mUNI+)																			; COLIMEALES  (P2 P3 P4)     
						(EQUAL VF123 VF234 mUNI+))																			; COPLANARIOS (PLANO1 PLANO2)

					(PROGN
								(SETQ NºNO (+ NºNO 1))  																	; >>> NO PASA FILTRO 
					) ; pro

					(PROGN
								(SETQ LIS-P-EJE-FILTRO (CONS (LIST PF1 PF2 PF3 PF4) LIS-P-EJE-FILTRO ))
					) ; pro
			) ; if
		) ; repe NºPE 

		(SETQ LIS-P-EJE-FILTRO (REVERSE LIS-P-EJE-FILTRO))												; (LENGTH LIS-P-EJE-FILTRO)

		(TERPRI) (PROMPT " >>> NO PASAN FILTRO  NºPUN =   ") (PRIN1 NºNO) (PROMPT "/") (PRIN1 Nº4)
								(IF (= NºNO 0) (PROMPT " ( BIEN )") (PROMPT " ( MAL )"))

		(TERPRI) (PROMPT " >>> SI PASAN FILTRO  NºPUN = ") (PRIN1 (LENGTH LIS-P-EJE-FILTRO)) (PROMPT "/") (PRIN1 Nº4)
								(IF (= (LENGTH LIS-P-EJE-FILTRO) Nº4) (PROMPT " ( BIEN )") (PROMPT " ( MAL )"))


	)) ; pro if   FILTRA-PUNTOS-EJE
	;																																																	
	;--------------------------------------------------------------------------------------------------------------------------------------------------

  
	;--------------------------------------------------------------------------------------------------------------------------------------------------
	;  (6) ARISTA de REPROCESO INTERSECCION PLANOS NORMALES (CHARNELAS)  CENTRO ESFERA OSCULADORA  ( MED12 CIR123 ESF1234 )										
	;																																																	
	(SETQ  CALCULA-MED-CEN-ESF  'SI )  (IF (= CALCULA-MED-CEN-ESF  'SI )  (PROGN

		;-----------------------------------------------------------------------------------------------------------------------------------------------
		;  PUNTOS en el PLANO NORMAL en Punto MEDIO P(n) P(n+1) =>	P1 P2 P3 P4 P5 P6 ...																			   	
		;-----------------------------------------------------------------------------------------------------------------------------------------------
		;  Punto Medio  MED12 =>   MED12    CIR.123                               ESF.1234                                PLANO.1-2 =>  C1  E1       	
		;  Punto Medio  MED23 =>   MED23    CIR.123 CIR.234                       ESF.1234 ESF.2345                       PLANO.2-3 =>  C2  E2  E1   	
		;  Punto Medio  MED34 =>   MED34            CIR.234 CIR.345               ESF.1234 ESF.2345 ESF.3456              PLANO.3-4 =>  C3  E3  E2   	
		;  Punto Medio  M45 =>   M45                    CIR.345 CIR.456           ESF.2345 ESF.3456  ESF.4567             PLANO.4-5 =>  C4  E4  E3   	
		;  Punto Medio  M56 =>   M56                            CIR.456  CIR.567           ESF.3456  ESF.4567  ESF.5678   PLANO.5-6 =>  C5  E5  E4   	
		;-----------------------------------------------------------------------------------------------------------------------------------------------
		;	PUNTOS en el PLANO(N3) NORMAL en Punto MED(N3) =>    MED(N3)      CIR(N2)  CIR(N3)      ESF(N1)  ESF(N2)  ESF(N3)                         	
		;-----------------------------------------------------------------------------------------------------------------------------------------------
		;  PLANOS QUE SE CORTAN EN CENTROS DE ESFERAS CONSECUTIVAS =>  PLANOS: PLANO(N2)-PLANO(N3)     CENTROS: ESF(N1) ESF(N2)   CH(N1) CH(N2)      	
		;-----------------------------------------------------------------------------------------------------------------------------------------------

		(SETQ LIS-P-MED-CEN-ESF nil)
		(SETQ NºCEN 0 )

		(SETQ NºPE -1 )
		(REPEAT (LENGTH LIS-P-EJE-FILTRO)
			(SETQ NºPE  (+ NºPE  1))
			(SETQ NºCEN (+ NºCEN 1))

			(SETQ P1 (NTH 0 (NTH NºPE  LIS-P-EJE-FILTRO)))															; PUNTOS EJE-FILTRO 
			(SETQ P2 (NTH 1 (NTH NºPE  LIS-P-EJE-FILTRO)))
			(SETQ P3 (NTH 2 (NTH NºPE  LIS-P-EJE-FILTRO)))
			(SETQ P4 (NTH 3 (NTH NºPE  LIS-P-EJE-FILTRO)))

			(SETQ MED12 (CAL "PLT ( P1 , P2 , 0.5 )"))																; PUNTO MEDIO	
			(SETQ MED23 (CAL "PLT ( P2 , P3 , 0.5 )"))
			(SETQ MED34 (CAL "PLT ( P3 , P4 , 0.5 )"))

			(SETQ Vz123 (CAL "NOR ( P1 , P2 , P3 )"))																	; VEC-Z    UNI (P1 P2 P3) 
			(SETQ Vz234 (CAL "NOR ( P2 , P3 , P4 )"))

			(SETQ V1r12 (CAL "NOR ( P1 , P2 , P2 + Vz123 )"))														; VEC-RADI UNI (P1 P2 P3) 
			(SETQ V1r23 (CAL "NOR ( P2 , P3 , P3 + Vz123 )"))

			(SETQ V2r23 (CAL "NOR ( P2 , P3 , P3 + Vz234 )"))														; VEC-RADI UNI (P2 P3 P4) 
			(SETQ V2r34 (CAL "NOR ( P3 , P4 , P4 + Vz234 )"))

			;	CENTROS CIRCULOS y ESFERA OSCULADORES ( P1 P2 P3 ) ( P2 P3 P4 ) (P1 P2 P3 P4)																				

			(SETQ CIR123  (CAL "ILL ( MED12 , MED12 + V1r12 ,  MED23 , MED23 + V1r23 )"))
			(SETQ CIR234  (CAL "ILL ( MED23 , MED23 + V2r23 ,  MED34 , MED34 + V2r34 )"))

			(SETQ ESF1234 (CAL "ILL ( CIR123 , CIR123 + Vz123 ,  CIR234 , CIR234 + Vz234 )"))

			(SETQ LIS-P-MED-CEN-ESF (CONS (LIST MED12 CIR123 ESF1234) LIS-P-MED-CEN-ESF ))

		) ; repe NºPE 

		(SETQ LIS-P-MED-CEN-ESF (REVERSE LIS-P-MED-CEN-ESF))																				; (LENGTH LIS-P-MED-CEN-ESF)

		(SETQ NºP-EJE (LENGTH LIS-P-EJE-FILTRO))
		(IF (= NºCEN  NºP-EJE)
			(PROGN (TERPRI) (PROMPT " >>> TODOS CENTROS de ESFERAS ") (PRIN1 NºCEN) (PROMPT "/") (PRIN1 NºP-EJE) (PROMPT " ( BIEN ) "))
			(PROGN (TERPRI) (PROMPT " >>> NO TODOS CENTROS ESFERAS ") (PRIN1 NºCEN) (PROMPT "/") (PRIN1 NºP-EJE) (PROMPT " ( MAL )  "))
		) ; if

	)) ; pro if   CALCULA-MED-CEN-ESF
	;																																																	
	;--------------------------------------------------------------------------------------------------------------------------------------------------


	;--------------------------------------------------------------------------------------------------------------------------------------------------
	;  (7) PUNTOS DE CORTE Entre  Lineas de ( LIS-P-SPL-AA ) y Planos de ( LIS-P-MED-CEN-ESF )  =>  ( LIS-P-CORTE-A )												
	;                             Lineas de ( LIS-P-SPL-BB ) y Planos de ( LIS-P-MED-CEN-ESF )  =>  ( LIS-P-CORTE-B )												
	;																																																	
	(SETQ  CALCULA-PUN-CORTE  'SI )  (IF (= CALCULA-PUN-CORTE  'SI )  (PROGN

		(SETQ LIS-P-CORTE-A nil )
		(SETQ LIS-P-CORTE-B nil )

		(SETQ NºA  -1)
		(SETQ NºB  -1)

		(SETQ NºCH -1)
		(REPEAT (LENGTH LIS-P-MED-CEN-ESF)
			(SETQ NºCH (+ NºCH 1))

			(IF (= (REM (+ NºCH 1) 5) 0) (SETQ Colo2 5) (SETQ Colo2 (REM (+ NºCH 1) 5)))

			(SETQ L-CH (NTH NºCH LIS-P-MED-CEN-ESF))														; (MED.12 CIR.123 ESF.1234) 

			(SETQ MEx (NTH 0 L-CH))																				; PLANOx
			(SETQ CIx (NTH 1 L-CH))
			(SETQ ESx (NTH 2 L-CH))


			;	LIS-P-CORTE-A																																										

			(SETQ WWa T )
			(WHILE WWa																								; LIS-P-SPL-AA 
				(SETQ NºA (+ NºA 1))
				(IF (> (+ NºA 1) (- (LENGTH LIS-P-SPL-AA) 1))
					(PROGN  (SETQ WWa nil)) ; pro
					(PROGN
						(SETQ PA1  (NTH (+ NºA 0) LIS-P-SPL-AA))
						(SETQ PA2  (NTH (+ NºA 1) LIS-P-SPL-AA))
						(SETQ PinA (CAL "ILP ( PA1 , PA2 , MEx , CIx , ESx )"))						; INTERSECCION LINEA-SPLI-A con PLANOx
						(COND
							((EQUAL PinA PA1 mUNI+)
															;(COMMAND "COLOR" 7 "PUNTO" PinA )
															(SETQ WWa nil) (SETQ NºA (- NºA 1)) (SETQ LIS-P-CORTE-A (CONS PinA  LIS-P-CORTE-A)))
							((EQUAL PinA PA2 mUNI+)
															;(COMMAND "COLOR" 7 "PUNTO" PinA )
															(SETQ WWa nil) (SETQ NºA (- NºA 1)) (SETQ LIS-P-CORTE-A (CONS PinA  LIS-P-CORTE-A)))
							(  T
															(SETQ D0a (CAL "DIST ( PA1  , PA2  )"))
															(SETQ D1a (CAL "DIST ( PA1  , PinA )"))
															(SETQ D2a (CAL "DIST ( PinA , PA2  )"))
															(IF (EQUAL D0a (+ D1a D2a) mUNI+)
																(PROGN 	;(COMMAND "COLOR" Colo2 "PUNTO" PinA )
																			(SETQ WWa nil) (SETQ NºA (- NºA 1))
																			(SETQ LIS-P-CORTE-A (CONS PinA  LIS-P-CORTE-A)))))
						) ; con
					) ; pro
				) ; if
			) ; WWa


			;	LIS-P-CORTE-B																																										

			(SETQ WWb T )
			(WHILE WWb																								; LIS-P-SPL-BB 
				(SETQ NºB (+ NºB 1))
				(IF (> (+ NºB 1) (- (LENGTH LIS-P-SPL-BB) 1))
					(PROGN  (SETQ WWb nil)) ; pro
					(PROGN
						(SETQ PB1  (NTH (+ NºB 0) LIS-P-SPL-BB))
						(SETQ PB2  (NTH (+ NºB 1) LIS-P-SPL-BB))
						(SETQ PinB (CAL "ILP ( PB1 , PB2 , MEx , CIx , ESx )"))						; INTERSECCION LINEA-SPLI-B con PLANOx 
						(COND
							((EQUAL PinB PB1 mUNI+)
															;(COMMAND "COLOR" 7 "PUNTO" PinB )
															(SETQ WWb nil) (SETQ NºB (- NºB 1)) (SETQ LIS-P-CORTE-B (CONS PinB  LIS-P-CORTE-B)))
							((EQUAL PinB PB2 mUNI+)
															;(COMMAND "COLOR" 7 "PUNTO" PinB )
															(SETQ WWb nil) (SETQ NºB (- NºB 1)) (SETQ LIS-P-CORTE-B (CONS PinB  LIS-P-CORTE-B)))
							(  T
															(SETQ D0b (CAL "DIST ( PB1  , PB2  )"))
															(SETQ D1b (CAL "DIST ( PB1  , PinB )"))
															(SETQ D2b (CAL "DIST ( PinB , PB2  )"))
															(IF (EQUAL D0b (+ D1b D2b) mUNI+)
																(PROGN 	;(COMMAND "COLOR" Colo2 "PUNTO" PinB )
																			(SETQ WWb nil) (SETQ NºB (- NºB 1))
																			(SETQ LIS-P-CORTE-B (CONS PinB  LIS-P-CORTE-B)))))
						) ; con
					) ; pro
				) ; if
			) ; WWb

		) ; repe CHARNE

		(SETQ LIS-P-CORTE-A (REVERSE LIS-P-CORTE-A ))													; (LENGTH LIS-P-CORTE-A) 98/100 
		(SETQ LIS-P-CORTE-B (REVERSE LIS-P-CORTE-B ))													; (LENGTH LIS-P-CORTE-B) 98/100 

		(SETQ NºP-CoA (LENGTH LIS-P-CORTE-A))
		(SETQ NºP-CoB (LENGTH LIS-P-CORTE-B))
		(IF (= NºP-CoA  NºP-CoB )
			(PROGN (TERPRI) (PROMPT " >>> IGUALES NºPUN-CORTE A/B  ") (PRIN1 NºP-CoA) (PROMPT "/") (PRIN1 NºP-CoB) (PROMPT " ( BIEN )") (TERPRI))
			(PROGN (TERPRI) (PROMPT " > NO IGUALES NºPUN-CORTE A/B ") (PRIN1 NºP-CoA) (PROMPT "/") (PRIN1 NºP-CoB) (PROMPT " ( MAL ) ") (TERPRI))
		) ; if

	)) ; pro if   CALCULA-PUN-CORTE 
	;																																																	
	;--------------------------------------------------------------------------------------------------------------------------------------------------



	;--------------------------------------------------------------------------------------------------------------------------------------------------
	;	(8) INTERSECCION PLANO-BASE con PLANO.1       PUNTOS-BASE ( BaseVA  BaseVB  BaseVC  Base## )     (PLANO.1 con PLANO.2 => CEN.1 ESF.1)				
	;																																																	

	(SETQ  INTER-PLANO-BASE  'SI )  (IF (= INTER-PLANO-BASE  'SI )  (PROGN

		(SETQ M1 (NTH 0 (NTH 0 LIS-P-MED-CEN-ESF)))  ; PUNTOS  PLANO-1 
		(SETQ C1 (NTH 1 (NTH 0 LIS-P-MED-CEN-ESF)))
		(SETQ E1 (NTH 2 (NTH 0 LIS-P-MED-CEN-ESF)))

		(SETQ Vpla0 (CAL "NOR ( BaseVA , BaseVB , BaseVC )"))

		(SETQ BaSA1 (CAL "ILP ( BaseVA , BaseVA + Vpla0 , M1 , C1 , E1 )"))
		(SETQ BaSB1 (CAL "ILP ( BaseVB , BaseVB + Vpla0 , M1 , C1 , E1 )"))
		(SETQ BaVA1 (CAL "ILP ( BaseVC , BaseVC + Vpla0 , M1 , C1 , E1 )"))

		(SETQ Sc12o  BaseVA )																			; SCP-PLANO-BASE SCP-Bo 
		(SETQ Sc12x  BaseVB )																			;                SCP-Bx 
		(SETQ Sc1y   BaseVC )																			;                SCP-By 

		;(SETQ CHbaseA (CAL "ILL ( BaseVA , BaseVB , BaSA1 , BaSB1 )"))				; CHARNELA  PLANO-BASE con PLANO-1 
		;(SETQ CHbaseB (CAL "ILL ( BaseVB , BaseVC , BaSB1 , BaVA1 )"))

		(SETQ PL1a BaseVA  PL1b BaseVB  PL2a BaSA1  PL2b BaSB1 ) (LINEAS-INTER-PLANO-1) (IF (= IntRS nil) (PROGN (TERPRI) (PROMPT " >>> CHbaseA = nil ??")) (SETQ CHbaseA IntRS))
		(SETQ PL1a BaseVB  PL1b BaseVC  PL2a BaSB1  PL2b BaVA1 ) (LINEAS-INTER-PLANO-1) (IF (= IntRS nil) (PROGN (TERPRI) (PROMPT " >>> CHbaseB = nil ??")) (SETQ CHbaseB IntRS))

		;(COMMAND "COLOR" 255 "LINEA" CHbaseA CHbaseB "")

	)) ; pro if   INTER-PLANO-BASE
	;																																																	
	;--------------------------------------------------------------------------------------------------------------------------------------------------


	;--------------------------------------------------------------------------------------------------------------------------------------------------
	;  (9) CALCULO de PUNTOS HOMOLOGOS  ==>   1º-TRIANGULO (AA1 BB1 CC1  SAA1 ?)  ==>   2º-TRIANGULO (CC2 AA2 BB2  SAA2 ?)										
	;																																																	
	(SETQ  TRIANGULO-HOMOLOGO  'SI )  (IF (= TRIANGULO-HOMOLOGO  'SI )  (PROGN

	;                                                                                                                                                  
	;   INICIO => TRIANGULO-BASE: BaseVA              VERTICE(BB) SPLINE-B                (DWG: ESCULTURA-PAJARO-KIWI-02 dwg  CAPA: 0731 )         		
	;                             BaseVB                       O                                                                                       
	;                             BaseVC                      / \                                                                                      
	;                                                        /   \                            VERTICE(BB) = PUN-CORTE-SPLINE-B                         
	;                                                       /     \                                                                                    
	;                                                      /       \                              (PcorA) = PUN-SPLINE-A COLINEAL con (CHca) (AA) (CC) 
	;                                                     /         \                                                                                  
	;                                                    /           \                        VERTICE(AA) = INTERS (CHca)-(PcorA) con (BB)-(CHab)      
	;                                                   /             \                                                                                
	;                                                  /               \                      VERTICE(CC) = INTERS (CHca)-(PcorA) con (BB)-(CHbc)      
	;                                                 /                 \                                                                              
	;                                                /                   \                           (AA) = ( PcorA)  en la BASE INICIO                
	;                                               /                     \                                                                            
	;                                              /                       \                                                                           
	;                                             /                         \                                                                          
	;                               VERTICE(CC)  /                           \                                                                         
	;                                           O....                         \                                                                        
	;                                          /      .......                  \                                                                       
	;                                                         .......           \                                                                      
	;                                        /                        .......    \ VERTICE(AA)                                                         
	;                                       /                                 ....O....                                                                
	;                                      /                                       \    .......                                                        
	;                                     /                                         \          .......   (PcorA) SPLINE-A = SPLINE-EJE                 
	;                                    /                                           \                 ...O...                                         
	;                                   /                                             \                       .......                                  
	;                                  /                                               \                             .......                           
	;                                 /                                                 \                                   .......                    
	;                                /                       CHARNELA                    \                                         .......             
	;     --------------------------O-----------------------------------------------------O-----------------------------------------------O------------
	;                              (CHbc)                                                (CHab)                                          (CHca)        
	;                                                                                                                                                  


		(SETQ LIS-3P-SECC nil )

		;(COMMAND "COLOR" 7 "3DCARA" BaseVC  BaseVA  BaseVB  BaseVC "")  									; TRIANGULO BASE 

		(SETQ LIS-3P-SECC (CONS (LIST BaseVA  BaseVB  BaseVC ) LIS-3P-SECC ))							; LIST TRIANGULO BASE 

		(SETQ AA1  BaseVA )
		(SETQ BB1  BaseVB )
		(SETQ CC1  BaseVC )

		(SETQ WWho  T )
		(SETQ NºHo -1 )

		(WHILE WWho

			(IF (= NºHo (- (LENGTH LIS-P-MED-CEN-ESF) 1)  )
				(PROGN
						(SETQ WWho nil)
				) ; pro

				(PROGN
					(SETQ NºHo (+ NºHo 1))

					(IF (= NºHo 0)
						(PROGN	; (= NºHo 0) 
							(SETQ CH1     CHbaseA )																				; PLANO-BASE + PLANO-1  CHARNELA  (= NºHo 0) INICIO 
							(SETQ CH2     CHbaseB )
							(SETQ PcorA  (NTH NºHo  LIS-P-CORTE-A))														; PLANO-1  (P-CORTE-A) 
							(SETQ PcorB  (NTH NºHo  LIS-P-CORTE-B))														; PLANO-1  (P-CORTE-B) 

							(SETQ Sc12o   CH1    )																				; SCP-PLANOS-By1  SCP12o 
							(SETQ Sc12x   CH2    )																				;     PLANOS-By1  SCP12x 
							(SETQ Sc1y    BaseVA )																				;     PLANO-Base  SCP-1y 
							(SETQ Sc2y    PcorA  )																				;     PLANO-1     SCP-2y 
						) ; pro

						(PROGN	; (> NºHo 0) 
							(SETQ CH1    (NTH 1 (NTH (- NºHo 1)  LIS-P-MED-CEN-ESF )))								; PLANO-1 + PLANO-2     CHARNELA  (> NºHo 0) RESTO 
							(SETQ CH2    (NTH 2 (NTH (- NºHo 1)  LIS-P-MED-CEN-ESF )))
							(SETQ PcorA  (NTH    NºHo     LIS-P-CORTE-A))												; PLANO-2  (P-CORTE-A) 
							(SETQ PcorB  (NTH    NºHo     LIS-P-CORTE-B))												; PLANO-2  (P-CORTE-B) 

							(SETQ Sc12o   CH1   )																				; SCP-PLANOS-1y2  SCP12o 
							(SETQ Sc12x   CH2   )																				;     PLANOS-1y2  SCP12x 
							(SETQ Sc1y   (NTH (- NºHo 1) LIS-P-CORTE-A))													;     PLANO-1     SCP-1y 
							(SETQ Sc2y    PcorA )																				;     PLANO-2     SCP-2y 
						) ; pro
					) ; if

					;	PLANO-1  PUNTOS INTERSECCION de LADOS-TRIANGULO con CHARNELA  (PL2a PL2b)																										

					(SETQ CHab nil   CHbc nil   CHca nil )

					(IF (= WWho T) (PROGN
                    (SETQ PL1a AA1   PL2a CH1
                          PL1b BB1   PL2b CH2 )  (LINEAS-INTER-PLANO-1)
						                               (IF (= IntRS nil) (PROGN (TERPRI) (PROMPT " >>>PLANO-1 CHab-1 nil --> NºHo = ") (PRIN1 NºHo)) (SETQ CHab IntRS))))
					(IF (= WWho T) (PROGN
                    (SETQ PL1a BB1   PL2a CH1
                          PL1b CC1   PL2b CH2 )  (LINEAS-INTER-PLANO-1)
						                               (IF (= IntRS nil) (PROGN (TERPRI) (PROMPT " >>>PLANO-1 CHbc-2 nil --> NºHo = ") (PRIN1 NºHo)) (SETQ CHbc IntRS))))
					(IF (= WWho T) (PROGN
                    (SETQ PL1a CC1   PL2a CH1
                          PL1b AA1   PL2b CH2 )  (LINEAS-INTER-PLANO-1)
						                               (IF (= IntRS nil) (PROGN (TERPRI) (PROMPT " >>>PLANO-1 CHca-3 nil --> NºHo = ") (PRIN1 NºHo)) (SETQ CHca IntRS))))

				  
					;	PLANO-2  PUNTOS INTERSECCION de LINEAS PUNTOS-CHARNELA PUNTOS-CORTE Entre ELLAS  																							

					(IF (OR (= CHab nil) (= CHbc nil) (= CHca nil) )
						(PROGN
									(TERPRI) (PROMPT " >>>>>>>>>> ALGUN (NIL) PLANO-2     NºHo = ") (PRIN1 NºHo)
									(SETQ WWho nil)
						) ; pro

						(PROGN
							(IF (= WWho T )
								(PROGN
									(SETQ  AA2 nil   BB2 nil   CC2 nil )

									(SETQ BB2 PcorB)                (IF (= BB2 nil)   (PROGN (TERPRI) (PROMPT " >>>PLANO-2 BB2-5 --> NºHo = ") (PRIN1 NºHo)) (SETQ BB2  PcorB ))

									(SETQ PL1a CHab   PL2a CHca
											PL1b BB2    PL2b PcorA )  (LINEAS-INTER-PLANO-2)
								                                   (IF (= IntRS nil) (PROGN (TERPRI) (PROMPT " >>>PLANO-2 AA2-6 --> NºHo = ") (PRIN1 NºHo)) (SETQ AA2  IntRS ))
									(SETQ PL1a CHbc   PL2a CHca
											PL1b BB2    PL2b PcorA )  (LINEAS-INTER-PLANO-2)
								                                   (IF (= IntRS nil) (PROGN (TERPRI) (PROMPT " >>>PLANO-2 CC2-7 --> NºHo = ") (PRIN1 NºHo)) (SETQ CC2 IntRS ))

								  
									(IF (OR  (= AA2 nil) (= BB2 nil) (= CC2 nil))
										(PROGN
												(TERPRI) (PROMPT " >>>>>>>>>> ALGUN (NIL) PLANO-2     NºHo = ") (PRIN1 NºHo)
												(SETQ WWho nil)
										) ; pro

										(PROGN

											;(IF (= (REM (+ NºHo 1) 5) 0) (SETQ Colo6 5) (SETQ Colo6 (REM (+ NºHo 1) 5)))
											;(COMMAND "COLOR" Colo6 "3DCARA" CC2  AA2  BB2  CC2 "")													; TRIANGULO SECCIONES 

											(SETQ LIS-3P-SECC (CONS (LIST AA2 BB2 CC2 )  LIS-3P-SECC ))											; LIST TRIANGULO SECCIONES 

											(SETQ AA1  AA2 )
											(SETQ BB1  BB2 )
											(SETQ CC1  CC2 )

										) ; pro
									) ; if
								) ; pro
							) ; if
						) ; pro
					) ; if
				) ; pro
			) ; if
		) ; While WWho

		(SETQ LIS-3P-SECC (REVERSE LIS-3P-SECC))


	)) ; pro if   TRIANGULO-HOMOLOGO 
	;																																																	
	;--------------------------------------------------------------------------------------------------------------------------------------------------


	;--------------------------------------------------------------------------------------------------------------------------------------------------
	;  (10) PINTA PIEL 3DCARAS 3D  PATRONES 2D																																		   
	;																																																	
	(SETQ  PINTA-3D-2D  'SI )  (IF (= PINTA-3D-2D  'SI )  (PROGN

		(SETQ KKx  790 )						; PUNTO OREGEN 1ºPATRONES 
		(SETQ KKy  350 )

		(SETQ Nº3º -1)
		(REPEAT 3								; 3 CARAS 
			(SETQ Nº3º (+ Nº3º 1))
			(SETQ Nº4º (+ Nº3º 1)) (IF (= Nº4º 3) (SETQ Nº4º 0)  )

			(SETQ KKx (+ KKx 200 ))			; SEPARACION ENTRE PATRONES 

			(SETQ KK1 (LIST    KKx     KKy  0 ))
			(SETQ KK2 (LIST (+ KKx 1)  KKy  0 ))

			(SETQ NºCA -1)
			(REPEAT (- (LENGTH LIS-3P-SECC) 1)    ; (LIST AA2 BB2 CC2 )
				(SETQ NºCA (+ NºCA 1))

				(SETQ A-1 (NTH Nº3º (NTH (+ NºCA 0)  LIS-3P-SECC )))
				(SETQ A-2 (NTH Nº4º (NTH (+ NºCA 0)  LIS-3P-SECC )))

				(SETQ B-1 (NTH Nº3º (NTH (+ NºCA 1)  LIS-3P-SECC )))
				(SETQ B-2 (NTH Nº4º (NTH (+ NºCA 1)  LIS-3P-SECC )))

				(COMMAND "COLOR" 2 "3DCARA" A-1  B-1  B-2  A-2 "")																					; PINTA 3DCARA  3D 

				(COMMAND "SCP" "3P" A-1  A-2  B-1 )
					(SETQ A-1pz (TRANS A-1 0 1))
					(SETQ A-2pz (TRANS A-2 0 1))

					(SETQ B-1pz (TRANS B-1 0 1))
					(SETQ B-2pz (TRANS B-2 0 1))

					;(SETQ AA1p (CAL "XYof( A-1pz )"))  ; Z = 0 
					;(SETQ BB1p (CAL "XYof( A-2pz )"))
					;(SETQ AA2p (CAL "XYof( B-1pz )"))
					;(SETQ BB2p (CAL "XYof( B-2pz )"))

					;(COMMAND "COLOR" 2  "TEXTO" A-1pz 0.4 0 (STRCAT " " (+ Nº3º 1) "-" (ITOA NºCA)))										; TEXTO 3DCARA   3D

				(COMMAND "SCP" "U" )

				(COMMAND "SCP" "3P" KK1 KK2 "" )

							;(COMMAND "COLOR" 5 "3DCARA" AA1p AA2p BB2p BB1p "")																			; PINTA 3DCARA  2D  Z=0 

					;(COMMAND "COLOR" 5 "3DCARA" A-1pz B-1pz B-2pz A-2pz "")																		; PINTA 3DCARA  2D

					;(COMMAND "COLOR" 5  "TEXTO" A-1pz 0.4 0 (STRCAT " " (ITOA (+ Nº3º 1)) "-" (ITOA NºCA)))							; TEXTO 3DCARA  2D

					;(SETQ AA2pU (TRANS AA2p 1 0))
					;(SETQ BB2pU (TRANS BB2p 1 0))

					(SETQ AA2pU (TRANS B-1pz 1 0))
					(SETQ BB2pU (TRANS B-2pz 1 0))

				(COMMAND "SCP" "U" )

				(SETQ KK1  AA2pU)
				(SETQ KK2  BB2pU)

			) ; repe NºCA
		) ; repe Nº3

	)) ; pro if  PINTA-3D-2D
	;																																																	
	;--------------------------------------------------------------------------------------------------------------------------------------------------


	;--------------------------------------------------------------------------------------------------------------------------------------------------
	;  (11) PINTA SECCIONES en PLANO -XY 																																		   		
	;																																																	
	(SETQ  PINTA-SECCIONES  'SI )  (IF (= PINTA-SECCIONES  'SI )  (PROGN

		(SETQ Qax  400 )																						; PUNTO OREGEN ORDENADAS SECCIONES-A en PLANO-XY 
		(SETQ Qay  350 )
		(SETQ Qa1 (LIST    Qax     Qay  0 ))
		(SETQ Qa2 (LIST (+ Qax 1)  Qay  0 ))

		(SETQ Qbx  300 )																						; PUNTO OREGEN ORDENADAS SECCIONES-B en PLANO-XY 
		(SETQ Qby  350 )
		(SETQ Qb1 (LIST    Qbx     Qby  0 ))
		(SETQ Qb2 (LIST (+ Qbx 1)  Qby  0 ))

		(SETQ NºSE -1)
		(REPEAT (- (LENGTH LIS-3P-SECC) 2)	; 99 ???  98 ???    									; (LIST AA2 BB2 CC2 ) 
			(SETQ NºSE (+ NºSE 1))

			; SECCIONES-A  OREGEN ORDENADAS PUNTO MEDIO VERTICES AA CC																												

			(SETQ AAs1 (NTH 0 (NTH    NºSE     LIS-3P-SECC )))										; (LENGTH LIS-3P-SECC)  99 ??? 
			(SETQ BBs1 (NTH 1 (NTH    NºSE     LIS-3P-SECC )))
			(SETQ CCs1 (NTH 2 (NTH    NºSE     LIS-3P-SECC )))

			(SETQ AAs2 (NTH 0 (NTH (+ NºSE 1)  LIS-3P-SECC )))
			(SETQ BBs2 (NTH 1 (NTH (+ NºSE 1)  LIS-3P-SECC )))
			(SETQ CCs2 (NTH 2 (NTH (+ NºSE 1)  LIS-3P-SECC )))

			(SETQ MEDac1 (CAL "PLT ( AAs1 , CCs1 , 0.5 )"))											; PUNTO MEDIO AAs1-CCs1 
			(SETQ MEDac2 (CAL "PLT ( AAs2 , CCs2 , 0.5 )"))											; PUNTO MEDIO AAs2-CCs2 

			(COMMAND "SCP" "3P" MEDac1  AAs1  BBs1 )
				(SETQ AAs1pa (TRANS AAs1 0 1))
				(SETQ BBs1pa (TRANS BBs1 0 1))
				(SETQ CCs1pa (TRANS CCs1 0 1))
			(COMMAND "SCP" "U" )

			(COMMAND "SCP" "3P" MEDac2  AAs2  BBs2 )
				(SETQ AAs2pa (TRANS AAs2 0 1))
				(SETQ BBs2pa (TRANS BBs2 0 1))
				(SETQ CCs2pa (TRANS CCs2 0 1))
			(COMMAND "SCP" "U" )

			(COMMAND "SCP" "3P" Qa1 Qa2 "" )
				(IF (= NºSE 0) (COMMAND "COLOR" 1 "POL"   AAs1pa  BBs1pa  CCs1pa  "C" ))		; PINTA SECCION-1A  2D 
									(COMMAND "COLOR" 1 "POL"   AAs2pa  BBs2pa  CCs2pa  "C" )			; PINTA SECCION-2A  2D 
									(COMMAND "COLOR" 7 "LINEA" BBs1pa  BBs2pa "")
			(COMMAND "SCP" "U" )

			; SECCIONES-B  OREGEN ORDENADAS PUNTO MEDIO SPLINE EJE																													

			(SETQ MEDeje1 (NTH 0 (NTH    NºSE     LIS-P-MED-CEN-ESF )))							; (LENGTH LIS-P-MED-CEN-ESF)  98 ??? 
			(SETQ MEDeje2 (NTH 0 (NTH (+ NºSE 1)  LIS-P-MED-CEN-ESF )))

			(COMMAND "SCP" "3P" MEDeje1  AAs1  BBs1 )
				(SETQ AAs1pb (TRANS AAs1 0 1))
				(SETQ BBs1pb (TRANS BBs1 0 1))
				(SETQ CCs1pb (TRANS CCs1 0 1))
			(COMMAND "SCP" "U" )

			(COMMAND "SCP" "3P" MEDeje2  AAs2  BBs2 )
				(SETQ AAs2pb (TRANS AAs2 0 1))
				(SETQ BBs2pb (TRANS BBs2 0 1))
				(SETQ CCs2pb (TRANS CCs2 0 1))
			(COMMAND "SCP" "U" )

			(COMMAND "SCP" "3P" Qb1 Qb2 "" )
				(IF (= NºSE 0) (COMMAND "COLOR" 1 "POL"   AAs1pb  BBs1pb  CCs1pb  "C" ))		; PINTA SECCION-1B  2D 
									(COMMAND "COLOR" 1 "POL"   AAs2pb  BBs2pb  CCs2pb  "C" )			; PINTA SECCION-2B  2D 
									(COMMAND "COLOR" 7 "LINEA" BBs1pb  BBs2pb "")
			(COMMAND "SCP" "U" )

		) ; repe NºSE

	)) ; pro if  PINTA-SECCIONES
	;																																																	
	;--------------------------------------------------------------------------------------------------------------------------------------------------


	;  PINTA PUNTOS  LIS-P-EJE-FILTRO  ( F1 F2 F3 F4 )																																	
	;	(PINTA-P-EJE)

	;	PINTA CENTROS CIRCULOS y ESFERAS OSCULADORAS	  (LIST  MED12 CIR123 ESF1234)																							
	;	(PINTA-P-MED-CEN-ESF-PLANOS)

	;  PINTA PUNTOS y LINEA  LIS-P-CORTE-A  LIS-P-CORTE-B																																
	;	(PINTA-PUN-CORTE)

	;--------------------------------------------------------------------------------------------------------------------------------------------------
	;	(11) PARANDO																																												
	;																																																	

	(SETVAR "blipmode" 1)  (SETVAR "cmdecho"  1) (TERPRI)

	(TERPRI) (PROMPT " ============================================ ")
	(TERPRI) (PROMPT " >>>>>>>>>>>>>>>>>>> FINAL >>>>>>>>>>>>>>>>>> ")
	(TERPRI) (PROMPT " ============================================ ")

) ;  DESA-KIWI-TriCª-EMBUDOS-022

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