
;==========================================================================================================================================
;																																														 
;	 ( PIN-3DC3d2d-PROYECCION-Perfiles2DPOLI3D )																								03-11-2013			 	 
;																																														 
;		PINTA 3DCaras en 3D y 2D del SOLIDO Formado por la INTERSECCION de la PROYECCION-RECTA de PERFILES (NORTE Izq-Der) y (OESTE Aba-Arr) 
;		POLILINEAS 3D -> PERFILES (NORTE Izq-Der) y (OESTE Aba-Arr)									 																 
;																																														 
;==========================================================================================================================================


	;----------------------------------------------------------------------------------------------------------------------------------------
	;	LISTA de PUNTOS de POLILINEA-3D																																		  

	(DEFUN LIS-PUN-POLI-3D ( / )

		(SETQ LIS-PUNoPOL-3D  nil )
		(SETQ LISpO-3D-0 (ENTGET  NoPOL-3D-0 ))      ; Introducir lista entidad 
		(SETQ WW1 T )
		(WHILE WW1
			(SETQ NoPOL-3D-1 (ENTNEXT NoPOL-3D-0 ))   ; Siguiente 
			(SETQ LISpO-3D-1 (ENTGET  NoPOL-3D-1 ))   ; Introducir lista entidad 
			(SETQ ENDI  (CDR (ASSOC 0 LISpO-3D-1 )))  ; Nombre entidad 

			(IF (= ENDI "VERTEX" )
				(PROGN
					(SETQ CORD (CDR (ASSOC 10 LISpO-3D-1 )))
					(SETQ LIS-PUNoPOL-3D (CONS CORD  LIS-PUNoPOL-3D ))
					(SETQ NoPOL-3D-0  NoPOL-3D-1 )
				) ; pro
				(PROGN
					(SETQ WW1 nil )
				) ; pro
			) ; if
		) ; WW1
	
		(SETQ LIS-PUNoPOL-3D (REVERSE LIS-PUNoPOL-3D ))

	) ; Defun LIS-PUN-POLI-3D

	;																																													 


	;----------------------------------------------------------------------------------------------------------------------------------------
	;	PINTA 3DCaras en 3D y 2D																																				  

	(DEFUN PIN-3DCaras ( / )

			(SETQ Nș1 -1 )
			(REPEAT (- NșNoIz 1 )
				(SETQ Nș1 (+ Nș1 1 ))

				(IF (= (REM (+ Nș1 1 ) 5 ) 0 )
					(SETQ COLO 5 )
					(SETQ COLO (REM (+ Nș1 1 ) 5 ))
				) ; if 

				(SETQ P1 (NTH    Nș1     LIS-PUNTOS-1))			;      P4 o------------o P3       
				(SETQ P2 (NTH    Nș1     LIS-PUNTOS-2))			;         |    3DC     |          
				(SETQ P3 (NTH (+ Nș1 1 ) LIS-PUNTOS-2))			;  Lis1   |            |   Lis2   
				(SETQ P4 (NTH (+ Nș1 1 ) LIS-PUNTOS-1))			; KK1  P1 o------------o P2  KK2  


				(COMMAND "SCP" "3P" P1 P2 P4 )
					(SETQ P1p (TRANS P1 0 1 ))
					(SETQ P2p (TRANS P2 0 1 ))
					(SETQ P3p (TRANS P3 0 1 ))
					(SETQ P4p (TRANS P4 0 1 ))

					(COMMAND "COLOR" COLO  "3DCARA" P1p P2p P3p P4p "")   ; 3D 

					(IF (= (REM Nș1 10 ) 1 ) (PROGN
						(SETQ P14p (CAL "PLT(P1p,P4p,0.5)"))							; PUNTO MEDIO P1 P2  ; plt(p1,p2,t)
						(SETQ P13p (CAL "PLT(P1p,P3p,0.5)"))
						(SETQ P23p (CAL "PLT(P2p,P3p,0.5)"))
						(SETQ NcaraNș (STRCAT Ncara "-" ( ITOA Nș1)))
						(SETQ ALT 0.6 )

						(COMMAND "COLOR" 7 )
						(COMMAND "TEXTO" "MI" P14p ALT 0.0 NșIzq  )    ; 2D
						(COMMAND "TEXTO" "MC" P13p ALT 0.0 NcaraNș)    ; 2D
						(COMMAND "TEXTO" "MD" P23p ALT 0.0 NșDer  )    ; 2D
					)) ; if 
				(COMMAND "SCP" "U" )


				(COMMAND "SCP" "3P" KK1 KK2 "" )
					(COMMAND "COLOR" COLO  "3DCARA" P1p P2p P3p P4p "")   ; 2D 

					(IF (= (REM Nș1 10 ) 1 ) (PROGN
						(COMMAND "COLOR" 7 )
						(COMMAND "TEXTO" "MI" P14p ALT 0.0 NșIzq  )    ; 2D
						(COMMAND "TEXTO" "MC" P13p ALT 0.0 NcaraNș)    ; 2D
						(COMMAND "TEXTO" "MD" P23p ALT 0.0 NșDer  )    ; 2D
					)) ; if 

					(SETQ KK1 (TRANS P4p 1 0 ))
					(SETQ KK2 (TRANS P3p 1 0 ))
				(COMMAND "SCP" "U" )

			) ; repe

	) ; Defun PIN-3DCaras

	;																																													 




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

(DEFUN C:PIN-3DC3d2d-PROYECCION-Perfiles2DPOLI3D (/ )

	;========================================================================================================================================
	;	(00) ARRANCANDO																																							  
	(SETVAR "blipmode" 0) (SETVAR "cmdecho" 0) (GRAPHSCR) (COMMAND "-REFENT" "DES"  "SCP" "U"  "ORTO" "DES")
	(IF (= CAL nil)(COMMAND "ARX" "L" "GEOMCAL.ARX"))			; CARGA CALCULADORA

	;----------------------------------------------------------------------------------------------------------------------------------------
	; (01) DATOS EXTERNOS														   																							  
	(TERPRI)
	(SETQ No-NORTE-Izq (CAR (ENTSEL " ***************** MARCA POLILINEA-3D Perfil-2D (NORTE-Izq) **********"))) (TERPRI)	
	(SETQ No-NORTE-Der (CAR (ENTSEL " ***************** MARCA POLILINEA-3D Perfil-2D (NORTE-Der) **********"))) (TERPRI)	
	(SETQ No-OESTE-Aba (CAR (ENTSEL " ***************** MARCA POLILINEA-3D Perfil-2D (OESTE-Aba) **********"))) (TERPRI)	
	(SETQ No-OESTE-Arr (CAR (ENTSEL " ***************** MARCA POLILINEA-3D Perfil-2D (OESTE-Arr) **********"))) (TERPRI)	(TERPRI)

	;----------------------------------------------------------------------------------------------------------------------------------------
	; (02) LISTAS PUNTOS INTERSECCIONES de PROYECCIONES													   														  

	(SETQ NoPOL-3D-0  No-NORTE-Izq )  (LIS-PUN-POLI-3D)  (SETQ LIS-PUN-NORTE-Izq  LIS-PUNoPOL-3D )
	(SETQ NoPOL-3D-0  No-NORTE-Der )  (LIS-PUN-POLI-3D)  (SETQ LIS-PUN-NORTE-Der  LIS-PUNoPOL-3D )
	(SETQ NoPOL-3D-0  No-OESTE-Aba )  (LIS-PUN-POLI-3D)  (SETQ LIS-PUN-OESTE-Aba  LIS-PUNoPOL-3D )
	(SETQ NoPOL-3D-0  No-OESTE-Arr )  (LIS-PUN-POLI-3D)  (SETQ LIS-PUN-OESTE-Arr  LIS-PUNoPOL-3D )

	(SETQ NșNoIz (LENGTH LIS-PUN-NORTE-Izq ))
	(SETQ NșNoDe (LENGTH LIS-PUN-NORTE-Der ))
	(SETQ NșOeAb (LENGTH LIS-PUN-OESTE-Aba ))
	(SETQ NșOeAr (LENGTH LIS-PUN-OESTE-Arr ))

	;                                                                                                 
	;                                     PERFIL NORTE                                                
	;                      PuNoIz O---------------------------O  PuNoDe                               
	;                             |                           |                                       
	;                      QuNoIz O            |              O  QuNoDe                               
	;                             |            | VeNOR        |                                       
	;                             |            V              |                                       
	;                  QuOeAr     |                           |                                       
	;        PuOeAr O---O---------O---------------------------O                                       
	;               |   |         | InNO                 InNE |                                       
	;    PERFIL     |   |  --->   |                           |                                       
	;    OESTE      |   |  VeOES  |                           |                                       
	;               |   |         | InSO                 InSE |                                       
	;        PuOeAb O---O---------O---------------------------O                                       
	;                  QuOeAb                                                                         
	;                                                                                                 

	(IF (= NșNoIz  NșNoDe  NșOeAb  NșOeAr )

		(PROGN
			(PROMPT "   El Nșde Puntos Listas Perfiles IGUALES") (TERPRI)

			(SETQ LIS-INTERSEC-SO nil )
			(SETQ LIS-INTERSEC-SE nil )
			(SETQ LIS-INTERSEC-NE nil )
			(SETQ LIS-INTERSEC-NO nil )

			(SETQ Nș0 -1 )
			(REPEAT NșNoIz
				(SETQ Nș0 (+ Nș0 1 ))

				(SETQ PuNoIz (NTH Nș0  LIS-PUN-NORTE-Izq))
				(SETQ PuNoDe (NTH Nș0  LIS-PUN-NORTE-Der))
				(SETQ PuOeAb (NTH Nș0  LIS-PUN-OESTE-Aba))
				(SETQ PuOeAr (NTH Nș0  LIS-PUN-OESTE-Arr))

 				(SETQ ZeNoIz (CAL "rzof( PuNoIz )"))  ; Componente Z de un punto
 				(SETQ ZeNoDe (CAL "rzof( PuNoDe )"))
 				(SETQ ZeOeAb (CAL "rzof( PuOeAb )"))
 				(SETQ ZeOeAr (CAL "rzof( PuOeAr )"))

				(IF (AND (EQUAL ZeNoIz  ZeNoDe 0.0001) (EQUAL ZeNoIz  ZeOeAb 0.0001) (EQUAL ZeNoIz  ZeOeAr 0.0001))

					(PROGN
						(PROMPT "   Las Z de los Puntos  IGUALES") (TERPRI)

						(SETQ VeNOR (CAL "VEC( PuOeAr , PuOeAb )"))									; Calcula el vector desde el punto p1 al p2.						
						(SETQ VeOES (CAL "VEC( PuNoIz , PuNoDe )"))

  						(SETQ QuNoIz (CAL " PuNoIz + VeNOR "))       								; calcula el punto situado a [1,2,3] unidades del punto A.	
  						(SETQ QuNoDe (CAL " PuNoDe + VeNOR "))
  						(SETQ QuOeAr (CAL " PuOeAr + VeOES "))
  						(SETQ QuOeAb (CAL " PuOeAb + VeOES "))

						(SETQ InSO (CAL "ILL( PuOeAb , QuOeAb ,  PuNoIz , QuNoIz )"))			; intersección entre dos línea (p1,p2) y (p3,p4). 3D 			
						(SETQ InSE (CAL "ILL( PuOeAb , QuOeAb ,  PuNoDe , QuNoDe )"))
						(SETQ InNE (CAL "ILL( PuOeAr , QuOeAr ,  PuNoDe , QuNoDe )"))
						(SETQ InNO (CAL "ILL( PuOeAr , QuOeAr ,  PuNoIz , QuNoIz )"))


						(SETQ LIS-INTERSEC-SO (CONS InSO  LIS-INTERSEC-SO ))
						(SETQ LIS-INTERSEC-SE (CONS InSE  LIS-INTERSEC-SE ))
						(SETQ LIS-INTERSEC-NE (CONS InNE  LIS-INTERSEC-NE ))
						(SETQ LIS-INTERSEC-NO (CONS InNO  LIS-INTERSEC-NO ))

						;(IF (= (REM (+ Nș0 1 ) 5 ) 0 )	(SETQ COLOo 5 )	(SETQ COLOo (REM (+ Nș0 1 ) 5 ))) ; if 
						;(COMMAND "COLOR" COLOo  "3DCARA" InSO InSE InNE InNO "")   ; SECCION HORIZONTAL 

					) ; pro

					(PROGN
						(PROMPT "   Las Z de los Puntos  żżż NO IGUALES ???") (TERPRI)
					) ; pro
				) ; if
			) ; repe
		) ; pro

		(PROGN
			(PROMPT "   El Nșde Puntos Listas Perfiles NO IGUALES") (TERPRI)
		) ; pro
	) ; if

	(SETQ LIS-INTERSEC-SO (REVERSE  LIS-INTERSEC-SO ))
	(SETQ LIS-INTERSEC-SE (REVERSE  LIS-INTERSEC-SE ))
	(SETQ LIS-INTERSEC-NE (REVERSE  LIS-INTERSEC-NE ))
	(SETQ LIS-INTERSEC-NO (REVERSE  LIS-INTERSEC-NO ))

	;----------------------------------------------------------------------------------------------------------------------------------------
	; (03) PINTA 3DCARAS en 3D y 2D													   																					  

			;    pNO O---------O pNE      
			;        |4   N   3|          
  			;        |  O   E  |          
			;        |1   S   2|          
			;    pSO O---------O pSE      

			(SETQ KK1 (LIST 100 0 0 )) 														; INICIO  SUR  
			(SETQ KK2 (LIST 101 0 0 ))
			(SETQ LIS-PUNTOS-1  LIS-INTERSEC-SO )
			(SETQ LIS-PUNTOS-2  LIS-INTERSEC-SE )
			;(SETQ NșCARA " 1---SUR---2")

			(SETQ NșIzq "-- 1")
			(SETQ Ncara "SUR")
			(SETQ NșDer "2 --")
  			(PIN-3DCaras)

			(SETQ KK1 (LIST 200 0 0 )) 														; INICIO  ESTE 
			(SETQ KK2 (LIST 201 0 0 ))
			(SETQ LIS-PUNTOS-1  LIS-INTERSEC-SE )
			(SETQ LIS-PUNTOS-2  LIS-INTERSEC-NE )
			;(SETQ NșCARA " 2---ESTE---3")

			(SETQ NșIzq "-- 2")
			(SETQ Ncara "ESTE")
			(SETQ NșDer "3 --")
  			(PIN-3DCaras)

			(SETQ KK1 (LIST 300 0 0 )) 														; INICIO NORTE 
			(SETQ KK2 (LIST 301 0 0 ))
			(SETQ LIS-PUNTOS-1  LIS-INTERSEC-NE )
			(SETQ LIS-PUNTOS-2  LIS-INTERSEC-NO )
			;(SETQ NșCARA " 3---NORTE---4")

			(SETQ NșIzq "-- 3")
			(SETQ Ncara "NORTE")
			(SETQ NșDer "4 --")
  			(PIN-3DCaras)

			(SETQ KK1 (LIST 400 0 0 )) 														; INICIO OESTE 
			(SETQ KK2 (LIST 401 0 0 ))
			(SETQ LIS-PUNTOS-1  LIS-INTERSEC-NO )
			(SETQ LIS-PUNTOS-2  LIS-INTERSEC-SO )
			;(SETQ NșCARA " 4---OESTE---1")

			(SETQ NșIzq "-- 4")
			(SETQ Ncara "OESTE")
			(SETQ NșDer "1 --")
  			(PIN-3DCaras)


	;=========================================================================================================================================
	;	(16) PARANDO																																									
	(SETVAR "blipmode" 1) (SETVAR "cmdecho" 1)

	(TERPRI) (PROMPT " ============ FIN  ============================================================")   (TERPRI)
	         (PROMPT " ==============================================================================")   (TERPRI)

) ;CIERRE DEFUN  PIN-3DC3d2d-PROYECCION-Perfiles2DPOLI3D 
