; Rutina que dibuja un muro indicando su altura y sentido o cota fondo de zapata y sentido

; Desarrollado por Mario Torres Pejerrey
; Mayo 2009
; http://www.construcgeek.com/

;|Este es un lisp en formato original, se puede ver el código fuente, la intención, es de que el código fuente
; pueda ser modificado y adaptado a la necesidad de cada usuario, lo único que siempre se solicita en estos
; casos es de que siempre se haga referencia al autor del mismo (es decir que no se modifique la autoría del lisp),
; salvo que este se modifique ampliamente.
; Si se construye un nuevo programa tomando como partes un lisp publicado,  se debería de hacer el comentario
; de que parte del nuevo programa esta basado en el autor original.|;

; Programa descargado desde http://www.construcgeek.com
; ConstrucGeek 2009

; Cargar las funciones ActiveX (Visual Lisp)
(vl-load-com)

(defun c:mus()
  (setvar "cmdecho" 0)
  (setq CapaActual (getvar "clayer"))
  
  ;Datos del muro
  (setq AnchoCorona 0.3)
  (setq AltoCorona 0.3)
  (setq AltoZapata 0.45)
  (setq TaludFijoInclinacionMuro 0.1); 1:10

   
  ;Solicitudes
  (setq PuntoBase (Getpoint "\nIndique el punto de ubicación del muro: "))
  
	(if (not (null PuntoBase))
		(progn
		
			  (setq XPuntoBase (car PuntoBase))
			  (setq YPuntoBase (cadr PuntoBase))
			  (setq CotaPuntoRef (cadr PuntoBase))
			  
			
			  (If (null SentidoDef)(setq SentidoDef "Derecha"))
			  (Initget "Derecha Izquierda")
			  (setq Sentido (getkword (strcat "\nIndique el sentido del muro [Derecha/Izquierda]<" SentidoDef ">: ")))
			  (if (null Sentido)(setq Sentido SentidoDef))
			  (setq SentidoDef Sentido)
			
			  (if (= Sentido "Derecha")
			    	 (setq Lado 1)
			    	 (setq Lado -1)
			  )
			
			  (If (null ComoDefinirAlturaDef)(setq ComoDefinirAlturaDef "Altura"))
			  (Initget "Altura Cota")
			  (setq ComoDefinirAltura (getkword (strcat "\nLa altura del muro se definirá por: [Altura(h)/Cota fondo de zapata]<" ComoDefinirAlturaDef ">: ")))
			  (if (null ComoDefinirAltura)(setq ComoDefinirAltura ComoDefinirAlturaDef))
			  (setq ComoDefinirAlturaDef ComoDefinirAltura)
			  
			  (if (= ComoDefinirAltura "Altura")
			  		(progn
			  			(If (null AlturaMuroDef)(setq AlturaMuroDef 2.0))
			  			(initget (+ 2 4))
			  			(setq AlturaMuro (getreal (strcat "\nIngrese la altura del muro <" (rtos AlturaMuroDef 2 3) ">: ")))
			  			(if (null AlturaMuro)(setq AlturaMuro AlturaMuroDef))
			  			(setq AlturaMuroDef AlturaMuro)
			  		)
			  		
			  		;Si ComoDefinirAltura = "Cota", se pide que se indique un punto para obtener la cota o se ingrese la misma.
			  		(progn
			  			(initget "Ingresar")
			  			(setq PuntoCotaFondoZapata (getpoint "\nIndique un punto en la cota del fondo de la zapata del muro o [Ingresar la cota]<Enter=Ingresar>: "))
						(Cond
							;Se indicó un punto en pantalla
							((EQ (type PuntoCotaFondoZapata) 'LIST)
								(setq CotaFondo (cadr PuntoCotaFondoZapata))
							)
							;Si se indico la opcion "Ingresar"
				    		((or (= PuntoCotaFondoZapata "Ingresar")(null PuntoCotaFondoZapata))
					  			(If (null CotaFondoDef)(setq CotaFondoDef 1))
					  			(setq CotaFondo (getreal (strcat "\nIngrese la cota del fondo de la zapata del muro <" (rtos CotaFondoDef 2 3) ">: ")))
					  			(if (null CotaFondo)(setq CotaFondo CotaFondoDef))
					  			(setq CotaFondoDef CotaFondo)
							)
						)
						(setq AlturaMuro (+ (- CotaPuntoRef CotaFondo) AltoCorona 0.00001))
			  		)
			  )
			  
				;Datos del muro  
				(setq AnchoInternoZapata (* 0.45 (- AlturaMuro AltoZapata)))
				(setq AnchoTalonInteriorZapata 0.30)
			  
			  	(cond
			  		((<= AlturaMuro 1.85)
						(setq AnchoInternoZapata 0.58)
						(setq AnchoTalonExteriorZapata 0.3)
					)
					((and (> AlturaMuro 1.85)(< AlturaMuro 3))
						(setq AnchoTalonExteriorZapata 0.3)
					)
					((and (>= AlturaMuro 3)(< AlturaMuro 3.5))
						(setq AnchoTalonExteriorZapata 0.35)
					)
					((and (>= AlturaMuro 3.5)(< AlturaMuro 4))
						(setq AnchoTalonExteriorZapata 0.40)
					)
					((and (>= AlturaMuro 4)(< AlturaMuro 5))
						(setq AnchoTalonExteriorZapata 0.45)
					)
					((and (>= AlturaMuro 5)(< AlturaMuro 6))
						(setq AnchoTalonExteriorZapata 0.50)
					)
					((and (>= AlturaMuro 6)(< AlturaMuro 7))
						(setq AnchoTalonExteriorZapata 0.60)
					)
					((>= AlturaMuro 7)
						(setq AnchoTalonExteriorZapata 0.65)
					)
				)
			  
			  ;Operaciones (creación de cada punto de la polilinea que dibujará el muro.
			  (setq p1 PuntoBase)
			
				;Si se desea personalizar las medidas del muro se deberán de modificar las siguientes líneas.
				(setq p2 (list (+ XPuntoBase (* (* AltoCorona TaludFijoInclinacionMuro) Lado)) (+ YPuntoBase AltoCorona)))
				(setq XPuntoP2 (car p2))  (setq YPuntoP2 (cadr p2))
				
				(setq p3 (list (+ XPuntoP2 (* AnchoCorona lado)) YPuntoP2))
				(setq XPuntoP3 (car p3))  (setq YPuntoP3 (cadr p3))
				
				(setq p4 (list (+ XPuntoP3 (* TaludFijoInclinacionMuro (- AlturaMuro AltoZapata) Lado)) 	(- YPuntoP3 (- AlturaMuro AltoZapata))))
				(setq XPuntoP4 (car p4))  (setq YPuntoP4 (cadr p4))
				
				(setq p5 (list (+ XPuntoP4 (* AnchoTalonExteriorZapata lado)) YPuntoP4))
				(setq XPuntoP5 (car p5))  (setq YPuntoP5 (cadr p5))
				
				(setq p6 (list XPuntoP5 (- YPuntoP5 AltoZapata)))
				(setq XPuntoP6 (car p6))  (setq YPuntoP6 (cadr p6))
				
				(setq p7 (list (- XPuntoP6 (* (+ AnchoTalonExteriorZapata AnchoInternoZapata AnchoTalonInteriorZapata) Lado)) YPuntoP6))
				(setq XPuntoP7 (car p7))  (setq YPuntoP7 (cadr p7))
			 
				(setq p8 (list XPuntoP7 (+ YPuntoP7 AltoZapata)))
				(setq XPuntoP8 (car p8))  (setq YPuntoP8 (cadr p8))
				
				(setq p9 (list (+ XPuntoP8 (* AnchoTalonInteriorZapata Lado)) YPuntoP8))
			  
				(setq p10 (list(- XPuntoBase (* (* 1.1 TaludFijoInclinacionMuro) Lado)) 	(- YPuntoBase 1.1)))
			
			
			  (CrearCapaMuro "Muro")
			
			  (command "_zoom" "100x")
			  (Command "_pline" p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p1 "")
			  (command "_zoom" "p")
			  
		) ;Progn
	) ;If

  (setvar "Clayer" CapaActual)
  (setvar "cmdecho" 1)
  (Princ)
)


(defun CrearCapaMuro(NombreCapa)
(setq NombreCapaObj
       (vl-catch-all-apply
           'vla-add
           (list
               (vla-get-layers
                   (vla-get-activedocument
                       (vlax-get-acad-object)
                   )
               )
               NombreCapa
           )
       )
   )

  (vla-put-color NombreCapaObj 5)
  (command "-layer" "_S" "Muro" "") 
)

(PRINC "\nPrograma Muro, Comando: MUS")
(PRINC "\nLisp Desarrollado por Mario Torres P.")
(PRINC "\nCrea una sección de muro indicando su altura y sentido.")
(setvar "modemacro" "http://www.construcgeek.com/")
(PRINC)