


;																									
;	( NIVEL-110 )			PINTA PUNTOS EN PLANO (SCP) DE UN CONJUNTO DE 3DCARA											
;																									


(DEFUN C:NIVEL-110 ( / CONJ XX COTA N PU1 PU2 PU3 PU4 LIST-E TIPO P1 X1 Y1 Z1 P2 X2 Y2 Z2 P3 X3 Y3 Z3 Pc Xc Yc)

	(SETVAR "blipmode" 0) (SETVAR "cmdecho" 0) (COMMAND "-REFENT" "DES")

	;																								

	(TERPRI) (PRIN1 " FIJAR (SCP) DE CORTE y MARCAR TODAS LAS 3D-CARAS: ") (TERPRI)

	(SETQ CONJ (SSGET))	;introducir conjunto

	(COMMAND "COLOR" 7)

	(SETQ XX 0.0001)	;margen equal
	(SETQ COTA 0.0)
	(SETQ N (- 1))
	(SETQ COND1 T)

	(WHILE COND1
		(SETQ N (+ N 1))
		(SETQ LIST-E (ENTGET (SSNAME CONJ N)))
		(SETQ TIPO (CDR (ASSOC 0 LIST-E)))

		(IF (= TIPO "3DFACE")
			(PROGN
				(SETQ PU1 (CDR (ASSOC 10 LIST-E)))
				(SETQ PU2 (CDR (ASSOC 11 LIST-E)))
				(SETQ PU3 (CDR (ASSOC 12 LIST-E)))
				(SETQ PU4 (CDR (ASSOC 13 LIST-E)))

				(SETQ P1 (TRANS PU1 0 1))
				(SETQ P2 (TRANS PU2 0 1))
				(SETQ P3 (TRANS PU3 0 1))
				(SETQ P4 (TRANS PU4 0 1))

				(SETQ X1 (CAR P1) Y1 (CADR P1) Z1 (CADDR P1))
				(SETQ X2 (CAR P2) Y2 (CADR P2) Z2 (CADDR P2))
				(SETQ X3 (CAR P3) Y3 (CADR P3) Z3 (CADDR P3))
				(SETQ X4 (CAR P4) Y4 (CADR P4) Z4 (CADDR P4))

	  
				(IF (AND (NOT (EQUAL P1 P2 XX)) (OR (AND (> Z1 COTA) (< Z2 COTA)) (AND (< Z1 COTA) (> Z2 COTA))))
					(PROGN
						(IF (> Z1 Z2)
							(PROGN
								(SETQ Xc (+ X2 (* (- X1 X2)(/ (- COTA Z2) (- Z1 Z2)))))
								(SETQ Yc (+ Y2 (* (- Y1 Y2)(/ (- COTA Z2) (- Z1 Z2)))))
								(SETQ Pc (LIST Xc Yc COTA))
								(COMMAND "PUNTO" Pc)
							) ; progn
						) ;cierre IF(z1>z2)

						(IF (< Z1 Z2)
							(PROGN
								(SETQ Xc (+ X1 (* (- X2 X1)(/ (- COTA Z1) (- Z2 Z1)))))
								(SETQ Yc (+ Y1 (* (- Y2 Y1)(/ (- COTA Z1) (- Z2 Z1)))))
								(SETQ Pc (LIST Xc Yc COTA))
								(COMMAND "PUNTO" Pc)
							) ; progn
						) ;cierre IF(z1<z2)
					) ; progn
				) ; cierre IF (NOT EQUAL P1 P2)


				(IF (AND (NOT (EQUAL P2 P3 XX)) (OR (AND (> Z2 COTA) (< Z3 COTA)) (AND (< Z2 COTA) (> Z3 COTA))))
					(PROGN
						(IF (> Z2 Z3)
							(PROGN
								(SETQ Xc (+ X3 (* (- X2 X3)(/ (- COTA Z3) (- Z2 Z3)))))
								(SETQ Yc (+ Y3 (* (- Y2 Y3)(/ (- COTA Z3) (- Z2 Z3)))))
								(SETQ Pc (LIST Xc Yc COTA))
								(COMMAND "PUNTO" Pc)
							) ; progn
						) ;cierre IF(z2>z3)

						(IF (< Z2 Z3)
							(PROGN
								(SETQ Xc (+ X2 (* (- X3 X2)(/ (- COTA Z2) (- Z3 Z2)))))
								(SETQ Yc (+ Y2 (* (- Y3 Y2)(/ (- COTA Z2) (- Z3 Z2)))))
								(SETQ Pc (LIST Xc Yc COTA))
								(COMMAND "PUNTO" Pc)
							) ; progn
						) ;cierre IF(z2<z3)
					) ; progn
				) ; cierre IF (NOT EQUAL P2 P3)


				(IF (AND (NOT (EQUAL P3 P4 XX)) (OR (AND (> Z3 COTA) (< Z4 COTA)) (AND (< Z3 COTA) (> Z4 COTA))))
					(PROGN
						(IF (> Z3 Z4)
							(PROGN
								(SETQ Xc (+ X4 (* (- X3 X4)(/ (- COTA Z4) (- Z3 Z4)))))
								(SETQ Yc (+ Y4 (* (- Y3 Y4)(/ (- COTA Z4) (- Z3 Z4)))))
								(SETQ Pc (LIST Xc Yc COTA))
								(COMMAND "PUNTO" Pc)
							) ; progn
						) ;cierre IF(z3>z4)

						(IF (< Z3 Z4)
							(PROGN
								(SETQ Xc (+ X3 (* (- X4 X3)(/ (- COTA Z3) (- Z4 Z3)))))
								(SETQ Yc (+ Y3 (* (- Y4 Y3)(/ (- COTA Z3) (- Z4 Z3)))))
								(SETQ Pc (LIST Xc Yc COTA))
								(COMMAND "PUNTO" Pc)
							) ; progn
						) ;cierre IF(z3<z4)
					) ; progn
				) ; cierre IF (NOT EQUAL P3 P4)


				(IF (AND (NOT (EQUAL P4 P1 XX)) (OR (AND (> Z4 COTA) (< Z1 COTA)) (AND (< Z4 COTA) (> Z1 COTA))))
					(PROGN
						(IF (> Z4 Z1)
							(PROGN
								(SETQ Xc (+ X1 (* (- X4 X1)(/ (- COTA Z1) (- Z4 Z1)))))
								(SETQ Yc (+ Y1 (* (- Y4 Y1)(/ (- COTA Z1) (- Z4 Z1)))))
								(SETQ Pc (LIST Xc Yc COTA))
								(COMMAND "PUNTO" Pc)
							) ; progn
						) ;cierre IF(z4>z1)

						(IF (< Z4 Z1)
							(PROGN
								(SETQ Xc (+ X4 (* (- X1 X4)(/ (- COTA Z4) (- Z1 Z4)))))
								(SETQ Yc (+ Y4 (* (- Y1 Y4)(/ (- COTA Z4) (- Z1 Z4)))))
								(SETQ Pc (LIST Xc Yc COTA))
								(COMMAND "PUNTO" Pc)
							) ; progn
						) ;cierre IF(z4<z1)
					) ; progn
				) ; cierre IF (NOT EQUAL P4 P1)


			) ; progn
		) ; cierre IF (3DFACE)

		(IF (= (SSNAME CONJ (+ N 1)) nil) (SETQ COND1 nil))

	) ; cierre WHILE COND1

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

) ; cierre DEFUN NIVEL-110

;																									
