;;LISTADO DE CARPI.LSP (v.12) 
;;FUNCIONES PARA EL DIBUJO EN PLANTA DE 
;;PUERTAS VENTANAS Y ARMARIOS EMPOTRADOS 
;;************************************************************** 
(DEFUN ger(a) 
        (* pi (/ a 180.0)) 
) 
(DEFUN reg(a) 
        (* (/ a pi) 180.0) 
) 
;;************************************************************** 
(DEFUN plact () 
   (setq plan (substr cl 1 2)) 
) 
;;funcion que lee planta actual 
;;************************************************************** 
(DEFUN lin () 
   (command "_layer" "_t" (strcat plan "X-SUPUTIL") 
                     "_m" (strcat plan "X-SUPUTIL") "" 
   ) 
   (COMMAND "_LINE" pt8 pt11 "") 
) 
;;************************************************************** 
(DEFUN svar () 
  (SETQ cl (GETVAR "CLAYER") 
        os (GETVAR "OSMODE") 
        ch (GETVAR "CMDECHO") 
        bp (GETVAR "BLIPMODE") 
        fz (GETVAR "SNAPMODE") 
        olderr *ERROR* 
  ) 
  (DEFUN *ERROR* (msg) 
     (PRINC " \n") (PRINC msg) 
     (SETVAR "OSMODE" os) 
     (SETVAR "BLIPMODE" bp) 
     (SETVAR "CMDECHO" ch) 
     (SETVAR "CLAYER" cl) 
     (SETVAR "SNAPMODE" fz) 
     (SETQ *ERROR* olderr) 
  ) 
  (SETVAR "CMDECHO" 0) 
  (SETVAR "BLIPMODE" 0) 
  (SETVAR "OSMODE" 0) 
  (SETVAR "SNAPMODE" 0) 
  (COMMAND "_undo" "_group" ) 
  (PRINC) 
) 
;;************************************************************** 
(DEFUN rvar () 
  (SETVAR "OSMODE" os) 
  (SETVAR "BLIPMODE" bp) 
  (SETVAR "CMDECHO" ch) 
  (SETVAR "CLAYER" cl) 
  (SETVAR "SNAPMODE" fz) 
  (SETQ *ERROR* olderr) 
  (COMMAND "_undo" "_end" ) 
  (PRINC) 
) 
;;************************************************************** 
(DEFUN inic () 
  (INITGET (+ 2 4 )) 
  (IF (= nu nil) 
        (WHILE (= nu nil) (SETQ nu (GETREAL "\nNumero de hojas 1/2: "))) 
        (SETQ nu (GETREAL 
           (STRCAT "\n Numero de hojas 1/2 <"(RTOS n1 2 0)">: ")) 
        ) 
  ) 
  (IF (= nu nil) (SETQ nu n1) (SETQ n1 nu)) 

  (INITGET (+ 2 4)) 
  (IF (= anc nil) 
   (PROGN 
     (WHILE (= anc nil) (SETQ anc (GETDIST "\nAncho de la hoja: "))) 
     (COND ((= NU 2) 
        (SETQ ancf (GETDIST 
                (STRCAT "\nAncho de segunda hoja <" (RTOS anc) ">:"))) 
        (IF (= ancf nil) (SETQ ancf anc)) 
     ) 
     ) 
   ) 
   (PROGN 
   (INITGET (+ 2 4)) 
      (SETQ anc (GETDIST (STRCAT "\nAncho de la hoja: <"(RTOS in) ">: "))) 
      (IF (= anc nil) (SETQ anc in)) 
      (COND ((= NU 2) 
         (SETQ ancf (GETDIST 
                (STRCAT "\nAncho de segunda hoja <"(RTOS anc)">: "))) 
      (IF (= ancf nil) (SETQ ancf anc)) 
      ) 
      ) 
   ) 
  ) 
  (IF (= anc nil) (SETQ anc in) (SETQ in anc)) 
  (IF (= ancf nil) (SETQ ancf anc)) 
) 
;;*************************************************************** 
(DEFUN dista ( / pta ptb ptc ptd ang dis dis1 dis2 ent nent) 
        (SETQ ent (ENTSEL "\nDesignar linea: ")) 
        (SETQ nent (CAR ent)) 
        (SETQ ptd (CADR ent)) 
        (SETQ pta (CDR (ASSOC 10 (ENTGET nent)))) 
        (SETQ ptb (CDR (ASSOC 11 (ENTGET nent)))) 
        (SETQ dis (GETDIST "\nDistancia: ")) 
        (SETQ dis1 (DISTANCE ptd pta)) 
        (SETQ dis2 (DISTANCE ptd ptb)) 
        (IF (> dis1 dis2) (SETQ ptc ptb)) 
        (IF (>= dis2 dis1) (SETQ ptc pta)) 
        (IF (> dis1 dis2) (SETQ ang (ANGLE ptb pta))) 
        (IF (>= dis2 dis1) (SETQ ang (ANGLE pta ptb))) 
        (SETQ pt1 (POLAR ptc ang dis)) 
        (SETQ pt11 pt1) 
) 
;;************************************************************** 
(DEFUN parcap () 
  (SETQ cm (SSGET pt11) cm (SSNAME cm 0) cm (ENTGET cm) 
        cm (CDR (ASSOC 8 cm)) ca (GETVAR "CLAYER")) 
  (COMMAND "_BREAK" pt11 pt8 "_BREAK" pt10 pt9) 
  (COMMAND "_LAYER" "_S" cm "" 
           "_LINE" pt8 pt9 "" 
           "_LINE" pt10 pt11 "" 
  ) 
  (COMMAND "_LAYER" "_t" (strcat plan "A-PLANTA") 
                    "_u" (strcat plan "A-PLANTA") 
                    "_m" (strcat plan "A-PLANTA") "" 
  ) 
) 
;;************************************************************** 
(DEFUN inte () 
  (SETVAR "OSMODE" 128) 
  (SETQ pt2 (GETPOINT"\nIndica la otra linea del muro: "pt1)) 
  (SETVAR "OSMODE" 0) 
  (SETQ ang (ANGLE pt2 pt1)) 
  (SETVAR "OSMODE" 512) 
  (SETQ an (GETANGLE pt1 "\nLado de la puerta: ")) 
  (SETVAR "OSMODE" 0) 
) 
;;************************************************************** 
(DEFUN tab15 () 
  (SETQ tab (DISTANCE pt1 pt2)) 
  (IF (> tab 0.15) (SETQ pt2 (POLAR pt1 (+ (ger 180) ang) 0.15) 
                         pt9 (POLAR pt2 an -0.07) 
                   ) 
  ) 
  (IF (= nu 1) (SETQ pt3 (POLAR pt2 an anc)) 
               (SETQ pt3 (POLAR pt2 an (+ ancf anc))) 
  ) 
  (SETQ pt10 (POLAR pt3 an 0.07)) 
) 
;;*************************************************************** 
(DEFUN dibu1 () 
  (inte) 
  (SETQ pt3 (POLAR pt2 an anc) 
        pt4 (POLAR pt1 an anc) 
        pt5 (POLAR pt1 an 0.03) 
        pt7 (POLAR pt1 ang anc) 
        pt6 (POLAR pt7 an 0.03) 
        pt8 (POLAR pt1 an -0.07) 
        pt9 (POLAR pt2 an -0.07) 
        pt10 (POLAR pt3 an 0.07) 
        pt11 (POLAR pt4 an 0.07) 
  ) 
  (parcap) 
  (tab15) 
  (COMMAND "_PLINE" pt6 pt5 pt8 pt9 pt2 pt7 "_A" 
          "_D" (reg an) pt4 "_L" pt3 pt10 pt11 pt4 "" 
  ) 
) 
;;************************************************************** 
(DEFUN dibu2 () 
  (inte) 
  (SETQ pt3 (POLAR pt2 an (+ ancf anc)) 
        pt4 (POLAR pt1 an (+ ancf anc)) 
        pt5 (POLAR pt1 an 0.03) 
        pt6 (POLAR pt5 ang anc) 
        pt7 (POLAR pt1 ang anc) 
        pt12 (POLAR pt4 ang ancf) 
        pt13 (POLAR pt4 an -0.03) 
        pt14 (POLAR pt13 ang ancf) 
        pt8 (POLAR pt1 an -0.07) 
        pt9 (POLAR pt2 an -0.07) 
        pt10 (POLAR pt3 an 0.07) 
        pt11 (POLAR pt4 an 0.07) 
        ctr (POLAR pt1 an anc) 
  ) 
  (parcap) 
  (tab15) 
  (COMMAND "_PLINE" pt6 pt5 pt8 pt9 pt2 pt7 "_A" 
           "_D" (reg an) ctr "_D" (reg ang) pt12 "_L" 
           pt3 pt10 pt11 pt13 pt14 "" 
  ) 
) 
;;************************************************************** 
(DEFUN dato () 
        (INITGET (+ 2 4)) 
        (IF (= en nil) (WHILE (= en nil) 
            (SETQ en (GETDIST "\nAncho de la ventana: ")) 
        ) 
            (SETQ en 
                (GETDIST (STRCAT "\nAncho de la ventana <"(RTOS ancv)">:")) 
            ) 
        ) 
        (IF (= en nil) (SETQ en ancv) (SETQ ancv en)) 
) 
;;************************************************************** 
(DEFUN dato2() 
        (INITGET (+ 2 4)) 
        (IF (= num nil) (WHILE (= num nil) 
            (SETQ num (GETREAL "\nNumero de hojas: ")) 
        ) 
            (SETQ num 
                (GETREAL (STRCAT "\nNumero de hojas <" (rtos nin) ">:")) 
            ) 
        ) 
        (IF (= num nil) (SETQ num nin) (SETQ nin num)) 
) 
;;************************************************************** 
(DEFUN dato3() 
        (INITGET "Si No") 
        (IF (= alf nil) (PROGN 
           (SETQ alf (GETKWORD "\nùCon alfeizar? Si/No <Si>: ")) 
           (IF (= alf NIL) (SETQ alf "Si")) 
           ) 
           (SETQ alf (GETKWORD (STRCAT "\nùCon alfeizar Si/No <"alf">: "))) 
        ) 
        (IF (= alf nil) (SETQ alf alf1) (SETQ alf1 alf)) 
) 
;;************************************************************** 
(DEFUN adato () 
        (INITGET (+ 2 4)) 
        (IF (= on nil) (WHILE (= on nil) 
            (SETQ on (GETDIST "\nAncho del armario: ")) 
        ) 
            (SETQ on 
                (GETDIST (STRCAT "\nAncho del armario <" (RTOS arma) ">:")) 
            ) 
        ) 
        ;Define los valores de an (ancho) segun valor actual 
        (IF (= on nil) (SETQ on arma) (SETQ arma on)) 
) 
;;************************************************************** 
(DEFUN C:P(/ pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 pt10 pt11 pt12 pt13 
                 pt14 ctr an ang cm ca os bp fz ch cl tab olderr) 
  (svar) 
  (plact) 
  (inic) 
  (INITGET 1 "Distancia") 
  (SETQ pt1 (GETPOINT "\nDistancia/<Punto de giro de la puerta>:")) 
  (COND 
        ((= pt1 "Distancia") (dista)) 
  ) 
  (COND ((= nu 1 ) (DIBU1)) 
        ((= nu 2 ) (DIBU2)) 
  ) 
  (lin) 
  (rvar) 
) 
;;************************************************************** 
(DEFUN C:VENT(/ p pt8 pt9 pt10 pt11 cm bp cl fz ch h a b esp olderr) 
        (svar) 
        (dato) 
        (dato2) 
        (dato3) 
        (plact) 
        (GRAPHSCR) 
        (SETVAR "OSMODE" 512) 
        (INITGET 1 "Distancia") 
        (SETQ pt11 (GETPOINT "\nDistancia/<Punto de linea interior>: ")) 
        (COND ((= pt11 "Distancia") (dista))) 
        (SETVAR "OSMODE" 128) 
        (SETQ pt10 (GETPOINT  pt11 "\nPunto de linea opuesta: ")) 
        (SETVAR "OSMODE" 0) 
        (SETQ esp (DISTANCE pt11 pt10)) 
        (SETQ a (ANGLE pt11 pt10)) 
        (SETVAR "OSMODE" 512) 
        (SETQ b (GETANGLE pt11 "\nLado de la ventana: ")) 
        (SETQ pt8 (POLAR pt11 b en)) 
        (SETQ pt9 (POLAR pt8 a esp)) 
        (SETVAR "OSMODE" 0) 
        (parcap) 
        (IF (= alf "Si") (COMMAND "_PLINE" pt10 (POLAR pt10 a 0.04) 
                                              (POLAR pt9 a 0.04) pt9 "") 
                         (COMMAND "_LINE" pt10 pt9 "") 
        ) 
        (COMMAND "_LINE" pt11 pt8 "" "_LINE" 
                  (POLAR pt11 a 0.10) (POLAR pt8 a 0.10) "" 
        ) 
        (SETQ num (FIX num)) 
        (SETQ p (POLAR pt11 b 0.035)) 
        (SETQ h (/ (- en 0.07) num)) 
        (REPEAT num 
                (COMMAND "_LINE" 
                        (POLAR (POLAR p b 0.035) a 0.042) 
                        (POLAR (POLAR (POLAR p b 0.035) a 0.042) 
                        b (- h 0.07)) "" 
                ) 
                (COMMAND "_LINE" 
                        (POLAR (POLAR p b 0.035) a 0.058) 
                        (POLAR (POLAR (POLAR p b 0.035) a 0.058) 
                        b (- h 0.07)) "" 
                ) 
                (COMMAND "_LINE" 
                        (POLAR p b 0.035) 
                        (POLAR (POLAR p b 0.035) a 0.10) "" 
                ) 
                (COMMAND "_LINE" 
                        (POLAR p b (- h 0.035)) 
                        (POLAR (POLAR p b (- h 0.035)) a 0.10) "" 
                ) 
                (SETQ p (POLAR p b h)) 
        ) 
        (SETQ p (POLAR pt11 b 0.035)) 
        (REPEAT (1- NUM) 
                (COMMAND "_LINE" (POLAR p b h) 
                (POLAR (POLAR p b h) a 0.10) "") 
                (SETQ p (POLAR p b h)) 
        ) 
        (lin) 
        (rvar) 
) 
;;************************************************************** 
(DEFUN C:ARM( / pt11 pt10 pt8 pt9 p5 p6 a b esp ch bp cl fz os olderr) 
        (svar) 
        (adato) 
        (dato2) 
        (plact) 
        (GRAPHSCR) 
        (SETVAR "OSMODE" 0) 
        (INITGET 1 "Distancia") 
        (SETQ pt11 (GETPOINT "\nDistancia/<Punto de linea exterior>: ")) 
        (COND ((= pt11 "Distancia") (dista))) 
        (SETVAR "OSMODE" 128) 
        (SETQ pt10 (GETPOINT  pt11 "\nPunto de linea opuesta: ")) 
        (SETVAR "OSMODE" 0) 
        (SETQ esp (DISTANCE pt11 pt10)) 
        (SETQ a (ANGLE pt10 pt11)) 
        (SETVAR "OSMODE" 512) 
        (SETQ b (GETANGLE pt11 "\nLado del armario: ")) 
        (SETQ pt8 (POLAR pt11 b on)) 
        (SETQ pt9 (POLAR pt10 b on)) 
        (SETVAR "OSMODE" 0) 
        (parcap) 
        (COMMAND "_PLINE" pt8 pt9 (POLAR pt9 (+ (ger 180) b) 0.05) 
                        (POLAR (POLAR pt9 (+ (ger 180) b) 0.05) a esp) 
                        pt8 "") 
        (SETQ num (FIX num)) 
        (SETQ hj (/ (- on 0.05) num)) 
        (SETQ p pt11) 
        (REPEAT num 
                (SETQ pt10 (POLAR p (+ (ger 180) a) esp)) 
                (SETQ pt8 (POLAR pt10 b 0.05)) 
                (SETQ pt9 (POLAR pt8 a (+ esp 0.03))) 
                (SETQ p5 (POLAR pt9 b (- hj 0.05))) 
                (SETQ p6 (POLAR p5 (+ (ger 180) a) 0.03)) 
                (COMMAND "_PLINE" p pt10 pt8 pt9 p5 p6 p "") 
                (SETQ p p6) 
        ) 
        (rvar) 
) 
;;************************************************************** 
(PROMPT "\nTeclear P para dibujar puertas, 
VENT para ventanas y ARM para armarios" ) 
(PRINC)