


;																									
;	( SEC-HOMOL-TAG-02 )																					
;																									
;	CREA SECCION POLIGONAL de ( Nx ) Lados por TANGENTES a SECCION CUERVA (SPLINE) en PLANO (B) 									
;	HOMOLOGA a TANGENTES de SECCION CUERVA (SPLINE) DADA EN (A) 														
;	PLANOS (A) Y (B) 	*** NO TIENEN QUE SER PARALELOS	***															
;																									



;	*******************************************
;	************** EN EGECUCION ***************
;	*******************************************



;																									
;       *** PROGRAMA *** PROGRAMA *** PROGRAMA *** PROGRAMA *** PROGRAMA*** PROGRAMA*** 											
;																									
;	ENTRADAS: 																							
;	SALIDAS : 																							
;	INTERNAS: A1 A2 A3 SEC-B N-SEC-B A0 AX AY T1 T2 T3 B1U B2U B3U														
;																									

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

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

	;	TOMA DE DATOS  =>  FIJA PLANO-A (TIANGULO 3 PUNTOS A1 A2 A3) Y PLANO-B (SPLINE)		

	;(COMMAND "-REFENT" "PUNTO")
	;(SETQ A1 (GETPOINT    "  PUNTO TRIANGULO (A1) EJE-X  Plano-A  ROJO: ? "    )) 	(TERPRI)
	;(SETQ A2 (GETPOINT A1 "  PUNTO TRIANGULO (A2) ORIGEN Plano-A  AMARILLO: ? ")) 	(TERPRI)
	;(SETQ A3 (GETPOINT A1 "  PUNTO TRIANGULO (A3) EJE-Y  Plano-A  VERDE: ? "   )) 	(TERPRI)
	;(COMMAND "-REFENT" "DES")




	;	PUNTOS VERTICES 1ª SECCION  => ( LIS-PUN )																

	(SETQ LIS-PUN nil)

	(COMMAND "-REFENT" "FIN")

	(SETQ Wx T)
	(WHILE Wx
		(SETQ Ax (GETPOINT "  VERTICE SECCION POLIGONAL (ENTER para SALIR=> Continua Prog) : ? " )) (TERPRI)
		(IF (= Ax nil)   (SETQ Wx nil)   (SETQ LIS-PUN (CONS Ax LIS-PUN))  ) ; if
	) ; whi
  
	(COMMAND "-REFENT" "DES")

	(SETQ LIS-PUN (REVERSE LIS-PUN))






	(SETQ N-SEC-A (CAR (ENTSEL " Designar SECCION PLANO-A (SPLINE-A): ? ")))

	(SETQ N-SEC-B (CAR (ENTSEL " Designar SECCION PLANO-B (SPLINE-B): ? ")))
	(SETQ LIS-SEC-B (ENTGET N-SEC-B))											; LISTA ENTIDAD
	(SETQ N-COL (ASSOC 62 LIS-SEC-B))											; 62 . Nº COLOR ENTIDAD
	(SETQ LIS-SEC-B (SUBST (CONS 62 255)  N-COL  LIS-SEC-B))							; CAMBIA COLOR al (BLANCO) 255
	(ENTMOD LIS-SEC-B)													; ACTUALIZAR LISTA

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

	(SETQ A0 A2 AX A1 AY A3)

	(COMMAND "SCP" "B" N-SEC-B)			; PLANO-B (SPLINE)
	(SETQ T1 (LIST  0 0 0))
	(SETQ T2 (LIST  1 1 0))
	(SETQ T3 (LIST -1 1 0))
	(SETQ B1U (TRANS T1 1 0))
	(SETQ B2U (TRANS T2 1 0))
	(SETQ B3U (TRANS T3 1 0))
	(COMMAND "SCP" "U")

	(COMMAND "SCP" "B" N-SEC-A)			; PLANO-A (SPLINE)
	(SETQ B1UA (TRANS B1U 0 1))
	(SETQ B2UA (TRANS B2U 0 1))
	(SETQ B3UA (TRANS B3U 0 1))
	(SETQ B1UA0 (LIST (CAR B1UA) (CADR B1UA) 0))
	(SETQ B2UA0 (LIST (CAR B2UA) (CADR B2UA) 0))
	(SETQ B3UA0 (LIST (CAR B3UA) (CADR B3UA) 0))
	(SETQ B1UA0U (TRANS B1UA0 1 0))
	(SETQ B2UA0U (TRANS B2UA0 1 0))
	(SETQ B3UA0U (TRANS B3UA0 1 0))
	(COMMAND "SCP" "U")

	(SETQ TRAZ-1 (INTERS B1U B2U B1UA0U B2UA0U nil))
	(SETQ TRAZ-2 (INTERS B1U B3U B1UA0U B3UA0U nil))

	(IF (OR (= TRAZ-1 nil) (= TRAZ-2 nil)) (PROMPT " ******  TRAZ-1 o TRAZ-2 = nil ****** ") )

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










	;	PUNTOS HOMOLOGIA EN TRAZA DE PLANO-A ( AB12 AB23 AB31)								

	(SETQ AB12 (INTERS TRAZ-1 TRAZ-2 A1 A2 nil))
	(SETQ AB23 (INTERS TRAZ-1 TRAZ-2 A2 A3 nil))
	(SETQ AB31 (INTERS TRAZ-1 TRAZ-2 A3 A1 nil))

	;	PUNTOS HOMOLOGOS (TAG.CIRCULO) EN PLANO-B DE PUNTOS HOMOLOGIA EN TRAZA DE PLANO-A ( BB1 BB2 BB3 )		

	(COMMAND "SCP" "B" N-SEC-B)
	(SETQ AB12B (TRANS AB12 0 1))
	(SETQ AB23B (TRANS AB23 0 1))
	(SETQ AB31B (TRANS AB31 0 1))

	;(COMMAND "_PLAN" "A")	; VISTA ACTUAL

	(COMMAND "-REFENT" "FIN")
	(SETQ B31B (GETPOINT AB31B "  LINEA-PUNTO (B31) TANGENTE SECCION (B)  ROJO "    )) 	(TERPRI)
	(SETQ B12B (GETPOINT AB12B "  LINEA-PUNTO (B12) TANGENTE SECCION (B)  AMARILLO ")) 	(TERPRI)
	(COMMAND "-REFENT" "DES")

	(COMMAND "-REFENT" "CEN")
	(SETQ B23B (GETPOINT AB23B "  LINEA-PUNTO (B23) TANGENTE SECCION (B)  VERDE "   )) 	(TERPRI)
	(COMMAND "-REFENT" "DES")

	;(COMMAND "_PLAN" "U")	; VISTA UNIBERSAL

	(SETQ B12 (TRANS B12B 1 0))
	(SETQ B23 (TRANS B23B 1 0))
	(SETQ B31 (TRANS B31B 1 0))
	(COMMAND "SCP" "U")

	(SETQ BB1 (INTERS AB31 B31 AB12 B12 nil))			; PUNTOS NUEVO TRIANGULO HOMOLOGO
	(SETQ BB2 (INTERS AB12 B12 AB23 B23 nil))
	(SETQ BB3 (INTERS AB23 B23 AB31 B31 nil))

	(SETQ LIS-SEC-B (SUBST  N-COL  (CONS 62 255) LIS-SEC-B))	; ENTIDAD CAMBIA COLOR AL QUE TENIA
	(ENTMOD LIS-SEC-B)							; ACTUALIZAR LISTA

	(COMMAND "COLOR" 1)		; ROJO
		(COMMAND "PUNTO" BB1)
		(COMMAND "LINEA" BB1 BB3 "")
	(COMMAND "COLOR" 2)		; AMARILLO
		(COMMAND "PUNTO" BB2)
		(COMMAND "LINEA" BB2 BB1 "")
	(COMMAND "COLOR" 3)		; VERDE
		(COMMAND "PUNTO" BB3)
		(COMMAND "LINEA" BB3 BB2 "")

	;																								


	;	REPETISION																						

	(SETQ W1 T)
	(WHILE W1
		(SETQ A1 BB1 A2 BB2 A3 BB3)

		(SETQ N-SEC-B (CAR (ENTSEL " DESIGNAR SIGUIENTE SECCION PLANO-B (SPLINE) (ENTER PARA SALIR): ? ")))

		(IF (= N-SEC-B nil) (SETQ W1 nil)

			(PROGN

			(SETQ LIS-SEC-B (ENTGET N-SEC-B))							; LISTA ENTIDAD
			(SETQ N-COL (ASSOC 62 LIS-SEC-B))							; 62 . Nº COLOR ENTIDAD
			(SETQ LIS-SEC-B (SUBST (CONS 62 255)  N-COL  LIS-SEC-B))			; CAMBIA COLOR al (BLANCO) 255
			(ENTMOD LIS-SEC-B)									; ACTUALIZAR LISTA
 
			;	PUNTOS TRAZA PLANOS "A" "B"  ( TRAZ-1 TRAZ-2 )							

			(SETQ A0 A2 AX A1 AY A3)

			(COMMAND "SCP" "B" N-SEC-B)			; PLANO-B (SPLINE)
			(SETQ T1 (LIST  20  20   0))
			(SETQ T2 (LIST 100  20   0))
			(SETQ T3 (LIST  20 100   0))
			(SETQ B1U (TRANS T1 1 0))
			(SETQ B2U (TRANS T2 1 0))
			(SETQ B3U (TRANS T3 1 0))
			(COMMAND "SCP" "U")

			(COMMAND "SCP" "3P" A0 AX AY)			; PLANO-A (TRIANGULO)
			(SETQ B1UA (TRANS B1U 0 1))
			(SETQ B2UA (TRANS B2U 0 1))
			(SETQ B3UA (TRANS B3U 0 1))
			(SETQ B1UA0 (LIST (CAR B1UA) (CADR B1UA) 0))
			(SETQ B2UA0 (LIST (CAR B2UA) (CADR B2UA) 0))
			(SETQ B3UA0 (LIST (CAR B3UA) (CADR B3UA) 0))
			(SETQ B1UA0U (TRANS B1UA0 1 0))
			(SETQ B2UA0U (TRANS B2UA0 1 0))
			(SETQ B3UA0U (TRANS B3UA0 1 0))
			(COMMAND "SCP" "U")

			(SETQ TRAZ-1 (INTERS B1U B2U B1UA0U B2UA0U nil))
			(SETQ TRAZ-2 (INTERS B1U B3U B1UA0U B3UA0U nil))

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

			;	PUNTOS HOMOLOGIA EN TRAZA DE PLANO-A ( AB12 AB23 AB31)							

			(SETQ AB12 (INTERS TRAZ-1 TRAZ-2 A1 A2 nil))
			(SETQ AB23 (INTERS TRAZ-1 TRAZ-2 A2 A3 nil))
			(SETQ AB31 (INTERS TRAZ-1 TRAZ-2 A3 A1 nil))

			;	PUNTOS HOMOLOGOS (TAG.CIRCULO) EN PLANO-B DE PUNTOS HOMOLOGIA EN TRAZA DE PLANO-A ( BB1 BB2 BB3 )	

			(COMMAND "SCP" "B" N-SEC-B)
			(SETQ AB12B (TRANS AB12 0 1))
			(SETQ AB23B (TRANS AB23 0 1))
			(SETQ AB31B (TRANS AB31 0 1))

			;(COMMAND "_PLAN" "A")	; VISTA ACTUAL

			(COMMAND "-REFENT" "FIN")
			(SETQ B31B (GETPOINT AB31B "  LINEA-PUNTO (B51) TANGENTE SECCION (B)  ROJO "    )) 	(TERPRI)
			(SETQ B12B (GETPOINT AB12B "  LINEA-PUNTO (B12) TANGENTE SECCION (B)  AMARILLO ")) 	(TERPRI)
			(COMMAND "-REFENT" "DES")

			(COMMAND "-REFENT" "CEN")
			(SETQ B23B (GETPOINT AB23B "  LINEA-PUNTO (B23) TANGENTE SECCION (B)  VERDE "   )) 	(TERPRI)
			(COMMAND "-REFENT" "DES")

			;(COMMAND "_PLAN" "U")	; VISTA UNIBERSAL

			(SETQ B12 (TRANS B12B 1 0))
			(SETQ B23 (TRANS B23B 1 0))
			(SETQ B31 (TRANS B31B 1 0))
			(COMMAND "SCP" "U")

			(SETQ BB1 (INTERS AB31 B31 AB12 B12 nil))				; PUNTOS NUEVO TRIANGULO HOMOLOGO
			(SETQ BB2 (INTERS AB12 B12 AB23 B23 nil))
			(SETQ BB3 (INTERS AB23 B23 AB31 B31 nil))

			(SETQ LIS-SEC-B (SUBST  N-COL  (CONS 62 255) LIS-SEC-B))	; ENTIDAD CAMBIA COLOR AL QUE TENIA
			(ENTMOD LIS-SEC-B)							; ACTUALIZAR LISTA

			(COMMAND "COLOR" 1)		; ROJO
				(COMMAND "PUNTO" BB1)
				(COMMAND "LINEA" BB1 BB3 "")
			(COMMAND "COLOR" 2)		; AMARILLO
				(COMMAND "PUNTO" BB2)
				(COMMAND "LINEA" BB2 BB1 "")
			(COMMAND "COLOR" 3)		; VERDE
				(COMMAND "PUNTO" BB3)
				(COMMAND "LINEA" BB3 BB2 "")

			;														

			) ; PROGN
		) ; IF

	) ; WHILE

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