
;																																		
;	( SEC-HOMOL-TAG-03 )																				10/02/2012				
;																																		
;	CREA SECCION POLIGONAL de 5 Lados por TANGENTES a SECCION CURVA (ELIPSE)en PLANO (B) 					
;	HOMOLOGA a TANGENTES (PENTAGONO DE ARRANQUE) de SECCION CUERVA DADA EN (A) 								
;	PLANOS (A) Y (B) NO TIENEN QUE SER PARALELOS																			
;																																		
;  UTILIZA TODAS LAS SECCIONES (ELIPSES)                                                              
;																																		
;  PINTA PATRONES 3D 2D ??                                                                            

;																																		



;======================================================================================================
; (FIJA-TANGENTES) 	A SECCION-B (ELIPSES)               															 

	(DEFUN FIJA-TANGENTES ( / )

	;	PUNTOS TRAZA PLANOS "A" "B"  ( TRAZ-1 TRAZ-2 )																	

	(SETQ A0 A2   AX A1   AY A3)

	(COMMAND "SCP" "U")
	(COMMAND "SCP" "B" N-ELIPSE)

	(SETQ B1U (TRANS (LIST  20  20 0 ) 1 0 ))           ; PUNTOS PLANO "B" en CORDENADAS UNIVERSALES 
	(SETQ B2U (TRANS (LIST 100  20 0 ) 1 0 ))
	(SETQ B3U (TRANS (LIST  20 100 0 ) 1 0 ))

	(COMMAND "SCP" "U")
	(COMMAND "SCP" "3P" A0 AX AY)

	(SETQ B1UA (TRANS B1U 0 1 ))                        ; PUNTOS PLANO B en CORDENADAS PLANO "A" 
	(SETQ B2UA (TRANS B2U 0 1 ))
	(SETQ B3UA (TRANS B3U 0 1 ))

	(SETQ B1UA0 (LIST (CAR B1UA) (CADR B1UA) 0 ))       ; PUNTOS PLANO B en CORDENADAS PLANO "A"  "Z-CERO"
	(SETQ B2UA0 (LIST (CAR B2UA) (CADR B2UA) 0 ))
	(SETQ B3UA0 (LIST (CAR B3UA) (CADR B3UA) 0 ))

	(SETQ B1UA0U (TRANS B1UA0 1 0 ))                    ; PUNTOS PLANO B en PLANO "A"  "Z-CERO" en CORDENADAS UNIVERSALES 
	(SETQ B2UA0U (TRANS B2UA0 1 0 ))
	(SETQ B3UA0U (TRANS B3UA0 1 0 ))

	(COMMAND "SCP" "U")
	(SETQ TRAZ-1 (INTERS B1U B2U B1UA0U B2UA0U nil))    ; TRAZA PLANO "A" con "B" 
	(SETQ TRAZ-2 (INTERS B1U B3U B1UA0U B3UA0U nil))

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

	;	PUNTOS HOMOLOGIA EN TRAZA ( AB12 AB23 AB34 AB45 AB51)															

	(SETQ AB12 (INTERS TRAZ-1 TRAZ-2 A1 A2 nil))
	(SETQ AB23 (INTERS TRAZ-1 TRAZ-2 A2 A3 nil))
	(SETQ AB34 (INTERS TRAZ-1 TRAZ-2 A3 A4 nil))
	(SETQ AB45 (INTERS TRAZ-1 TRAZ-2 A4 A5 nil))
	(SETQ AB51 (INTERS TRAZ-1 TRAZ-2 A5 A1 nil))

	;	PUNTOS HOMOLOGOS EN PLANO-B DE PUNTOS PLANO-A ( BB1 BB2 BB3 BB4 BB5)										

	(COMMAND "SCP" "B" N-ELIPSE)
	(SETQ AB12B (TRANS AB12 0 1))
	(SETQ AB23B (TRANS AB23 0 1))
	(SETQ AB34B (TRANS AB34 0 1))
	(SETQ AB45B (TRANS AB45 0 1))
	(SETQ AB51B (TRANS AB51 0 1))

	(COMMAND "_PLAN" "A") ; NšELIP 
	(PROMPT "-----------   ELIPSE- ") (PRIN1 (+ Nš1 1 )) (PROMPT " / ") (PRIN1 NšELIP)   (SETQ B51B (GETPOINT AB51B "    PUNTO-TANG-ROJA " )) (TERPRI)
	(PROMPT "-----------   ELIPSE- ") (PRIN1 (+ Nš1 1 )) (PROMPT " / ") (PRIN1 NšELIP)   (SETQ B12B (GETPOINT AB12B "    PUNTO-TANG-AMARI" )) (TERPRI)
	(PROMPT "-----------   ELIPSE- ") (PRIN1 (+ Nš1 1 )) (PROMPT " / ") (PRIN1 NšELIP)   (SETQ B23B (GETPOINT AB23B "    PUNTO-TANG-VERDE" )) (TERPRI)
	(PROMPT "-----------   ELIPSE- ") (PRIN1 (+ Nš1 1 )) (PROMPT " / ") (PRIN1 NšELIP)   (SETQ B34B (GETPOINT AB34B "    PUNTO-TANG-CIAN " )) (TERPRI)
	(PROMPT "-----------   ELIPSE- ") (PRIN1 (+ Nš1 1 )) (PROMPT " / ") (PRIN1 NšELIP)   (SETQ B45B (GETPOINT AB45B "    PUNTO-TANG-AZUL " )) (TERPRI)

	(COMMAND "_U")
	(SETQ B12 (TRANS B12B 1 0))
	(SETQ B23 (TRANS B23B 1 0))
	(SETQ B34 (TRANS B34B 1 0))
	(SETQ B45 (TRANS B45B 1 0))
	(SETQ B51 (TRANS B51B 1 0))

	(COMMAND "SCP" "U")
	(SETQ BB1 (INTERS AB51 B51 AB12 B12 nil))
	(SETQ BB2 (INTERS AB12 B12 AB23 B23 nil))
	(SETQ BB3 (INTERS AB23 B23 AB34 B34 nil))
	(SETQ BB4 (INTERS AB34 B34 AB45 B45 nil))
	(SETQ BB5 (INTERS AB45 B45 AB51 B51 nil))

	(COMMAND "COLOR" 1) (COMMAND "LINEA" BB1 BB5 "") ;(COMMAND "PUNTO" BB1)  
	(COMMAND "COLOR" 2) (COMMAND "LINEA" BB2 BB1 "") ;(COMMAND "PUNTO" BB2)  
	(COMMAND "COLOR" 3) (COMMAND "LINEA" BB3 BB2 "") ;(COMMAND "PUNTO" BB3)  
	(COMMAND "COLOR" 4) (COMMAND "LINEA" BB4 BB3 "") ;(COMMAND "PUNTO" BB4)  
	(COMMAND "COLOR" 5) (COMMAND "LINEA" BB5 BB4 "") ;(COMMAND "PUNTO" BB5)  

	) ; Defun FIJA-TANGENTES

;																																		




;																																		
;       *** PROGRAMA *** PROGRAMA *** PROGRAMA *** PROGRAMA *** PROGRAMA*** PROGRAMA*** 					
;																																		

(DEFUN C:SEC-HOMOL-TAG-03 (/  )

	;==================================================================================================
	;	(01) ARRANCA							    																				

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

	;==================================================================================================
	;	(02) TOMA DE DATOS  =>  FIJA PLANO (A) Y (B) CON =>															
	;	     PUNTOS DEL (PENTAGONO DE ARRANQUE)en ORDEN (A1 A2 A3 A4 A5) y SECCIONES-B (ELIPSES)			

	(COMMAND "-REFENT" "PUNTO")
	(SETQ A1 (GETPOINT    " Plano-A PUNTO PENTAGONO (A1)   ROJO "    )) 	(TERPRI)	  ; Eje-X     
	(SETQ A2 (GETPOINT A1 " Plano-A PUNTO PENTAGONO (A2)   AMARILLO ")) 	(TERPRI)	  ; Origen    
	(SETQ A3 (GETPOINT A2 " Plano-A PUNTO PENTAGONO (A3)   VERDE "   )) 	(TERPRI)	  ; Eje-Y     
	(SETQ A4 (GETPOINT A3 " Plano-A PUNTO PENTAGONO (A4)   CIANO "   )) 	(TERPRI)	  ; Siguiente 
	(SETQ A5 (GETPOINT A4 " Plano-A PUNTO PENTAGONO (A5)   AZUL "    )) 	(TERPRI)	  ; Siguiente 
	(COMMAND "-REFENT" "DES")

	(TERPRI)
	(PROMPT "############################################################################")   (TERPRI)
	(PRIN1  "----- SELECCIONA TODAS las SECCIONES-B (ELIPSES) en ORDEN => (ENTER)")
	(SETQ   CONJ-ELIPSE (SSGET))

	;==================================================================================================
	;	(03) OPERA DATOS (PLANOS A y B )    																				

	(SETQ LIS-Lis-5P-SECCIONES nil )

	(SETQ LIS-Lis-5P-SECCIONES (CONS (LIST  A1 A2 A3 A4 A5 A1 ) LIS-Lis-5P-SECCIONES ))

	(SETQ NšELIP (SSLENGTH CONJ-ELIPSE ))


	(SETQ Nš1 -1 )
	(REPEAT NšELIP												; (SSLENGTH CONJ-ELIPSE )       
		(SETQ Nš1 (+ Nš1  1 ))

		(SETQ N-ELIPSE   (SSNAME CONJ-ELIPSE  Nš1 ))  						; Nombre elipse 

		;																																

		(COMMAND "SCP" "B" N-ELIPSE )
			(COMMAND "_OFFSET" 1.8  N-ELIPSE (LIST 10000 10000) "")    					; TRASPONE ELIPSE  OFFSET 
			(SETQ N-ELI-OFFS (ENTLAST))
		(COMMAND "SCP" "U")

		(SETQ LIS-ELIPSE (ENTGET N-ELIPSE ))  													; lista  elipse 
		(SETQ LIS-COL (ASSOC 62 LIS-ELIPSE ))   												; (62 . 1) 
		(SETQ LIS-NEGRO (SUBST (CONS 62 7) LIS-COL  LIS-ELIPSE ))      				; ELIPSE A COLOR NEGRO 
		(ENTMOD LIS-NEGRO )

		(SETQ LIS-ELIPSE-OFF (ENTGET N-ELI-OFFS ))  											; lista  elipse OFFSET
		(SETQ LIS-COL-OFF (ASSOC 62 LIS-ELIPSE-OFF ))   									; (62 . 1) 
		(SETQ LIS-NEGRO-OFF (SUBST (CONS 62 7) LIS-COL-OFF  LIS-ELIPSE-OFF ))      ; ELIPSE OFFSET A COLOR NEGRO 
		(ENTMOD LIS-NEGRO-OFF )

		;																																

		(FIJA-TANGENTES)

		(SETQ A1 BB1   A2 BB2   A3 BB3   A4 BB4   A5 BB5 )
		(SETQ LIS-Lis-5P-SECCIONES (CONS (LIST  A1 A2 A3 A4 A5 A1 ) LIS-Lis-5P-SECCIONES ))

		;																																

		(COMMAND "_ERASE" N-ELI-OFFS "")															; BORRA ELIPSE OFFSET 

		(SETQ LIS-NEGRO (SUBST LIS-COL (CONS 62 7)  LIS-ELIPSE ))     					; ELIPSE A COLOR ORIGINAL 
		(ENTMOD LIS-NEGRO )

		;																																


	) ; repe Nš1

	(SETQ LIS-Lis-5P-SECCIONES (REVERSE LIS-Lis-5P-SECCIONES ))


	;==================================================================================================
	;  (05) PINTA 3DC  LISTA PUNTOS TIRAS LONGITUDINALES																

	(SETQ NšVER  -1 )
	(REPEAT (- (LENGTH (NTH 0  LIS-Lis-5P-SECCIONES )) 1 )  ; (LIST  A1 A2 A3 A4 A5 A1 )
		(SETQ NšVER (+ NšVER  1 ))


		(SETQ KK1 (LIST (* 200 (+ NšVER 1 )) 0 0 ))
		(SETQ KK2 (LIST (* 201 (+ NšVER 1 )) 0 0 ))


		(SETQ NšSEC  -1 )
		(REPEAT (- (LENGTH LIS-Lis-5P-SECCIONES ) 1 )
			(SETQ NšSEC (+ NšSEC  1 ))

			(SETQ VA1  (NTH (+ NšVER 0) (NTH (+ NšSEC 0) LIS-Lis-5P-SECCIONES )))
			(SETQ VA2  (NTH (+ NšVER 1) (NTH (+ NšSEC 0) LIS-Lis-5P-SECCIONES )))
			(SETQ VB1  (NTH (+ NšVER 0) (NTH (+ NšSEC 1) LIS-Lis-5P-SECCIONES )))
			(SETQ VB2  (NTH (+ NšVER 1) (NTH (+ NšSEC 1) LIS-Lis-5P-SECCIONES )))

			;(COMMAND "COLOR" 2  "3DCARA" VA1 VA2 VB2 VB1 "")


		;	                                                 KK1             KK2                                                            
		;	                                              VB1 O---------------O VB2             (COMMAND "SCP" "3P" VA1 VA2 VB1 )           
		;	                                                  |               |                                                             
		;	                                                  | Y             |                                                             
		;	                                                  | |   "SCP"     |                 (COMMAND "SCP" "3P" KK1 KK2 "" )            
		;	                                                  | |             |                                                             
		;	                                                  | |             |                                                             
		;	                                                  | o---------X   |                                                             
		;                                                VA1 O---------------O VA2                                                         
		;	                                                                                                                                

		;(IF (= (REM Nš0 2 ) 0 ) (SETQ CO 255 ) (SETQ CO 2 ))

		(COMMAND "SCP" "3P" VA1 VA2 VB1 )

			(SETQ VA1p (TRANS VA1 0 1 ))
			(SETQ VA2p (TRANS VA2 0 1 ))
			(SETQ VB1p (TRANS VB1 0 1 ))
			(SETQ VB2p (TRANS VB2 0 1 ))

			(COMMAND "COLOR" 2  "3DCARA" VA1p VA2p VB2p VB1p "")																	; 3DCARA-3D ; ("SCP" "3P" B4 B1 B3)

			(SETQ Htxt 4.0 )																													; ALTURA TEXTO 
			(SETQ Ptxt (LIST (+ (CAR VA1p) (* 4 Htxt)) (+ (CADR VA1p) (* 2 Htxt) ) 0))										; PUNTO  TEXTO  B4p -> B3p 

			(COMMAND "COLOR" 2  "TEXTO" Ptxt  Htxt 90 (STRCAT "#" (ITOA (+ NšVER 1 )) "-" (ITOA (+ NšSEC 1 )))) 	; TEXTO-3D 

		(COMMAND "SCP" "U" )

		(COMMAND "SCP" "3P" KK1 KK2 "" )																									; PLANO-3DC ( 2D ) PATRONES
	
			(COMMAND "COLOR" 5  "3DCARA" VA1p VA2p VB2p VB1p "")																	; 3DCARA-2D ; ("SCP" "3P" KK1 KK2 "")
			(COMMAND "COLOR" 5  "TEXTO" Ptxt  Htxt 90 (STRCAT "#" (ITOA (+ NšVER 1 )) "-" (ITOA (+ NšSEC 1 )))) 	; TEXTO-2D ; 

			(SETQ KK1 (TRANS VB1p 1 0 ))
			(SETQ KK2 (TRANS VB2p 1 0 ))

   	(COMMAND "SCP" "U")

		) ; repe NšSEC

	) ; repe NšVER


;	PARANDO																															
	(SETVAR "blipmode" 1) (SETVAR "cmdecho" 1)
) ;cierre DEFUN SEC-HOMOL-TAG-03

;																																		