Calendario

Hola a Todos

Alguien tendra el codigo del CALEN.LSP que me pueda compartir por favor????








Saludos

No se si sea éste el que necesitas, tampoco si funciona... lo tenía arrumbado. Se llama calendario.
Saludos

Código:


;CADENCE
;modified for international versions of AutoCAD - (^v^) CAD Studio sro
;www.cadstudio.cz

(defun CALENDAR (/ mn dy cd cel ar crx cry qu
                     d c y m ox oy xcl ycl am nd cc loc m0 y0)
;  Initial settings and definition of constants.
   (setvar "CMDECHO" 0)
   (setvar "BLIPMODE" 0)
   (setvar "OSMODE" 0)
   (setq mn '("ENERO" "FEBRERO" "MARZO" "ABRIL" "MAYO" "JUNIO" "JULIO"
              "AGOSTO" "SEPTIEMBRE" "OCTUBRE" "NOVIEMBRE" "DICIEMBRE")
         dy '(31 28 31 30 31 30 31 31 30 31 30 31)
         cd '(1 4 4 0 2 5 0 3 6 1 4 6))
   (setq cel 1.5                    ; Cell size
         ar  0.8333                 ; Aspect Ratio [to fit into A-size sheet]
         crx 0.0                    ; lower-left hand Corner Reference
         cry 0.0
         qu  1)                     ; QUadrant [0=centered, 1=LOWER right]
   (command "_.Style" "TXA" "romant" "" "0.75" "" "" "" "")  ; for characters
   (command "_.Style" "TXB" "romans" "" "0.75" "" "" "" "")  ; for numbers
   (setq d (rtos (getvar "CDATE") 2 0)                ; get system date,
         c (atoi (substr d 1 2))                      ; century,
         y (atoi (substr d 3 2))                      ; year and
         m (atoi (substr d 5 2))                      ; month
         xcl cel                                      ; Cell size - X
         ycl (* ar xcl)                               ; Cell size - Y
         am (strcat (nth (1- m) mn) "  " (substr d 1 4))  ; set month string,
         nd (nth (1- m) dy)                               ; number of days &
         cc (+ (nth (1- m) cd) (- 19 c)))                 ; month code.
   (princ "Se Generara Calendario para el Mes de " )  (princ   am)
   (princ ", Por favor espere! . .")
;  CALDRAW returns the day-of-the-week and location of the last date.
   (setq loc (caldraw qu 0 crx cry xcl ycl m y am nd cc))
;  To generate mini calendars for the previous and next months.
   (if (or (zerop (car loc)) (> (car loc) 2))
      (if (< (cadr loc) (+ crx (* xcl 5.0)))
         (setq ox (+ crx (* xcl 5.0))
               oy (+ cry (* ycl 0.05)))
         (setq ox crx
               oy (+ cry (* ycl 4.05))))
      (if (< (caddr loc) (+ cry ycl))
         (setq ox (+ crx (* xcl 5.0))
               oy (+ cry (* ycl 0.05)))
         (setq ox (+ crx (* xcl (+ (car loc) 1)))
               oy (+ cry (* ycl 4.05)))))
   (setq xcl (/ xcl 7.0)                     ; Cell size - X
         ycl (* ar xcl))                     ; Cell size - Y
;  For the previous month:
   (if (= m 1)                               ; wrap around if January
      (setq m0 12 y0 (1- y))
      (setq m0 (1- m) y0 y))
   (setq am (nth (1- m0) mn)                 ; set month string,
         nd (nth (1- m0) dy)                 ; number of days and
         cc (+ (- 19 c) (nth (1- m0) cd)))   ; month code.
   (if (minusp y0) (setq y0 99 cc (1+ cc)))  ; change of century
   (CALDRAW 0 1 ox oy xcl ycl m0 y0 am nd cc)
;  For the next month:
   (setq ox (+ ox (* xcl 7.0)))
   (if (= m 12)                              ; wrap around if December
      (setq m0 1 y0 (1+ y))
      (setq m0 (1+ m) y0 y))
   (setq am (nth (1- m0) mn)                 ; set month string,
         nd (nth (1- m0) dy)                 ; number of days and
         cc (+ (nth (1- m0) cd) (- 19 c)))   ; month code.
   (if (> y0 99) (setq y0 0 cc (1- cc)))     ; change of century
   (CALDRAW 0 1 ox oy xcl ycl m0 y0 am nd cc)
   (command "_.Zoom" "_E")
   (princ " . complete.\n  .\n")
   (princ "\n          ¡  L i s t o  !\n")
   (princ)
)
;  This function actually generates the calendar.
(defun CALDRAW (qflg dflg xo yo xcl ycl mn yr am nd cc
                / WK dw cfx cfy ta re te x y ht i)
   (setq WK '("Dom" "Lun" "Mar" "Mier" "Jue" "Vier" "Sab"))
   (if (and (= mn 2) (zerop (rem yr 4))) (setq nd 29))  ; leap year corrections
   (if (and (zerop (rem yr 4)) (or (= mn 1) (= mn 2)))
         (setq cc (1- cc)))
;  Compute the day of the week for the 1st; 1=Sun, 0,7=Sat.
   (setq dw (rem (+ yr (/ yr 4) 1 cc) 7))
   (if (zerop dw) (setq dw 7))
   (if (zerop qflg)
       (setq cfx 0.0 cfy 0.0 ta "_M")
       (setq cfx (* 0.45 xcl) cfy (* 0.45 ycl) ta "R"))
   (setq re (+ xo (* 7.0 xcl))               ; define right edge and
         te (+ yo (* 5.5 ycl))               ; top edge of frames
         x (+ xo (* 3.5 xcl)))               ; To write month,
   (command "_.Text" "_S" "TXA") (command)      ; reset Text .Style.
   (command "_.Text" "_C" (list x (* te 1.01)) (* xcl 0.3333) "0" am)
;  Draw the calender frames.
   (if (zerop dflg)(progn                    ; only for the main calendar
         (setq x xo y yo)
         (repeat 8                           ; draw verticals
            (command "_.Line" (list x yo) (list x te) "")
            (setq x (+ x xcl)))
         (repeat 6                           ; draw horizontals
            (command "_.Line" (list xo y) (list re y) "")
            (setq y (+ y ycl)))
         (command "_.Line" (list xo te) (list re te) "")   ; draw top edge
         (setq x (+ xo (* 0.5 xcl))          ; set values for writing
               y (- te (* 0.25 ycl))         ; the days of the week
               ht (* ycl 0.25)
               i 0)
         (repeat 7                           ; write days
            (command "_.Text" "_M" (list x y) ht "0" (nth i WK))
            (setq x (+ x xcl)
                  i (1+ i))))); IF ZEROP DFLG
   (command "_.Text" "_S" "TXB") (command)      ; set Text .Style and
   (setq x (+ xo (* (- dw 1.5) xcl) cfx)     ; starting point - X
         y (- (+ yo (* 4.5 ycl)) cfy)        ; starting point - Y
         ht (* ycl 0.5)                      ; text height and
         i 0)                                ; date
   (repeat nd                                ; To write the dates
      (setq x (+ x xcl)
            i (1+ i))
      (if (> x re)                           ; To go to next row
         (setq x (+ xo (* 0.5 xcl) cfx)
               y (- y ycl)))
      (if (< y yo)                           ; To go to top row
         (setq y (- (+ yo (* 4.5 ycl)) cfy)))
      (command "_.Text" ta (list x y) ht "0" (itoa i)))
;  Return the day-of-the-week and the location of the last date.
   (setq dw (rem (+ (1- dw) nd) 7))
   (list dw x y))
;  Execute the program automatically, upon loading.
(CALENDAR)



eliasp, gracias por tu pronta respuesta...
pero no es exactamente el que necesito....

Este seria el codigo:

Código:

;cal.lsp
;James Tunstall
;Autodesk Australia
;28-08-91

;draws calenders of any year
;in several arrangements
;at any scale

;AutoCAD Release 11 or greater is required


;Adaptación al español por Mario de la Cruz Ortíz.
;mejoras v1.0:
; encabezado mes con año.
; nombre del dia completo.
; números del domingo en color rojo.
; texto de los dias festivos 2015 en México.
; texto de los cumpleaños.
; se corrige la posición de los dias finales del mes.
; numeros de cumpleaños en color verde.
; v1.1 se agrega el cuadro de diálogo.

;AutoCAD Release 2016

;Ajustes de tipo de litografia Juan Pablo Molina Ramirez
;mejoras v1.2:
;Tipos de Litografias al momento de insertar calendarios



(defun *error* (errmsg)
 (princ "\n       Se ha cancelado el programa... ")
 (terpri)
 (prompt errmsg)
   ;restore system variables
   (setvar "CMDECHO" echo)
   (setvar "ORTHOMODE" ortho)
   (setvar "osmode" osact)
   (setvar "cecolor" coloractual)
   (setvar "textstyle" styleactual)
 (princ)  
 (princ)
)

;Z direction of the current UCS.
(defun zdir
   (
      / xdir ydir
      a1 a2 a3
      b1 b2 b3
   )
   (setq xdir (getvar "UCSXDIR"))    ;X direction of the current UCS
   (setq ydir (getvar "UCSYDIR"))    ;Y direction of the current UCS

   (setq a1 (car xdir) a2 (cadr xdir) a3 (caddr xdir))
   (setq b1 (car ydir) b2 (cadr ydir) b3 (caddr ydir))

   ;return UCS Z axis direction

   (list
      (- (* a2 b3) (* a3 b2))
      (- (* a3 b1) (* a1 b3))
      (- (* a1 b2) (* a2 b1))
   )
)

;xdir of ECS
;requires (zdir)
(defun xdir
   (
   / normal factor b1 b2 b3 a1 a2 a3
   )

   (setq normal (zdir))
   (setq factor (/ 1.0 64.0))
   (setq b1 (car normal))
   (setq b2 (cadr normal))
   (setq b3 (caddr normal))

   (if
      (and
         (< (abs b1) factor)
         (< (abs b2) factor)
      )
      (progn
         (setq a1 0.0 a2 1.0 a3 0.0)
      )
      (progn
         (setq a1 0.0 a2 0.0 a3 1.0)
      )
   )

   ;return ECS X axis direction

   (list
      (- (* a2 b3) (* a3 b2))
      (- (* a3 b1) (* a1 b3))
      (- (* a1 b2) (* a2 b1))
   )
)

;base angle of UCS in terms of ECS
;requires (xdir) & (zdir)
(defun ucs_base_angle ( / ecs_xdir )

   (setq ecs_xdir
      (mapcar
         (quote +)
         (trans (xdir) 0 1)
         (trans (getvar "UCSORG") 0 1 T)
      )
   )

   (-
      0.0
      (atan (cadr ecs_xdir) (car ecs_xdir))
   )
)


;Modulo division
(defun % (x y)
   (- (fix x) (* (/ (fix x) (fix y)) (fix y)))
)

;Returns T if year is a leap year  - BISISESTO
(defun LeapYear ( year )
   (cond
      ((/= (% year 4) 0) nil)
      ((and
            (= (% year 100) 0)
            (/= (% year 400) 0)) nil)
      (T T)
   )
)

;returns day of week for 1st January for year
(defun JanOne
   ( year
     / LastYear LotsOf400 LotsOf100 LotsOfOne LeapYears DaysAhead
   )
   (if (> year 0)
      (progn
         (setq LastYear (- (fix year) 1))
         (setq LotsOf400 (/ LastYear 400))
         (setq LotsOf100 (/ (% LastYear 400) 100))
         (setq LotsOfOne (% LastYear 100))
         (setq LeapYears
            (+
               (* LotsOf400 97)
               (* LotsOf100 24)
               (/ LotsOfOne 4)
            )
         )
         (setq DaysAhead (+ (fix year) LeapYears))
         ;return day of week for 1st January
         ;0 Sunday 6 Saturday
         (% DaysAhead 7)
      )
      nil
   )
)

;returns a list of 12 calender months
;each month is made up of 5 weeks
;each week is made up of 7 days
;the value of the day indicates the date
;a value of zero(0) indicates a blank
(defun 12cal
   (
      year
      / week month StartOfMonth DaysInMonth date day calender
   )

   (setq StartOfMonth (JanOne year))

   (setq DaysInMonth
      (if (LeapYear year)
         (list 31 29 31 30 31 30 31 31 30 31 30 31)
         (list 31 28 31 30 31 30 31 31 30 31 30 31)
      )
   )

   (setq calender nil)
   (foreach NoOfDays DaysInMonth
      (setq month nil)
      (setq week nil)
      (cond
         (
            (and (= StartOfMonth 5) (= NoOfDays 31))
            (progn
               (setq week (list 0 0 0 0 0 1 2))
               (setq date 3)
               (setq StartOfMonth 1)
            )
         )
         (
            (and (= StartOfMonth 6) (= NoOfDays 31))
            (progn
               (setq week (list 0 0 0 0 0 0 1))
               (setq date 2)
               (setq StartOfMonth 2)
            )
         )
         (
            (and (= StartOfMonth 6) (= NoOfDays 30))
            (progn
               (setq week (list 0 0 0 0 0 0 1))
               (setq date 2)
               (setq StartOfMonth 1)
            )
         )
         (
            T
            (progn
               (setq day 0)
               (while (< day StartOfMonth)
                  (setq week (append week (list 0)))
                  (setq day (1+ day))
               )
               (setq date 1)
               (while (< day 7)
                  (setq week (append week (list date)))
                  (setq date (1+ date))
                  (setq day (1+ day))
               )
            )
         )
      )

      (setq month (append month (list week)))
      (repeat 5
         (setq week nil)
         (setq day 0)
         (while (< day 7)
            (if (= date NoOfDays)
               (setq StartOfMonth (% (1+ day) 7))
            )
            (if (<= date NoOfDays)
               (setq week (append week (list date)))
               (setq week (append week (list 0)))
            )
            (setq date (1+ date))
            (setq day (1+ day))
         )
         (setq month (append month (list week)))
      )
      (setq calender (append calender (list month)))
   )
)

;draws a box
(defun box (pt0 pt1)
  (setvar "osmode" 0)
  (setq %ecabezado (* ydist 0.1225)
 %nombredia (* ydist 0.0539)
        %numdia (/ (- ydist (+ %ecabezado %nombredia))6)
 posnumdia (- ydist (* ydist 0.245025))
 x1dia (/ xdist 7)
 )
   (command
      ".PLINE"
      (list (car pt0) (cadr pt0))
      "w" 0.040 0.040
      (list (car pt1) (cadr pt0))
      (list (car pt1) (cadr pt1))
      (list (car pt0) (cadr pt1))
      "C"
   )
  (setq marcor (entlast))
  (setq radio (* (- (car pt1) (car pt0))0.02))
  (command "fillet" "r" radio "fillet" "p" marcor)
 
  (command ".PLINE"
   (list (car pt0) (- (cadr pt1) %ecabezado))"w" 0.020 0.020
   (list (car pt1) (- (cadr pt1) %ecabezado)) "")

    (command ".PLINE"
   (list (car pt0) (- (cadr pt1) (+ %ecabezado %nombredia)))
   (list (car pt1) (- (cadr pt1) (+ %ecabezado %nombredia))) "")
    (command "_.copy" "l" "" pt0 "a" 6 (list (car pt0) (- (cadr pt0) %numdia)))

    (command ".PLINE"
   (list (+ (car pt0) x1dia) (cadr pt0))
   (list (+ (car pt0) x1dia) (+ (- ydist %ecabezado) (cadr pt0))) "")
    (command "_.copy" "l" "" pt0 "a" 6 (list (+ (car pt0) x1dia) (cadr pt0)))

  )

;draws text
(defun text (string pt height xscale / extdir base_angle)

   ;current extrusion direction
   (setq extdir (zdir))

   ;base angle of UCS in terms of ECS
   (setq base_angle (ucs_base_angle))

   (entmake
      (list
         (cons 0 "TEXT")
         (cons 1 string)
         (cons 7 (getvar "TEXTSTYLE"))
 (cons 8 (getvar "clayer"))
         (append (list 10) (trans pt 1 extdir))
 (cons 11 (trans pt 1 extdir))
         (cons 40 height)
         (cons 41 xscale)
         (cons 50 base_angle)
         (cons 51 0.0)
         (cons 71 0)
         (cons 72 1)
         (cons 73 2)
 (append (list 210) extdir)
      )
   )
)

;draws a calender month
;given corner points,which month,a list of dates
(defun draw_month
   (
      pt0 pt1 month dates
      / months days xdist ydist m n height width_factor
   )

   (setq months
      (list
         "ENERO"
         "FEBRERO"
         "MARZO"
         "ABRIL"
         "MAYO"
         "JUNIO"
         "JULIO"
         "AGOSTO"
         "SEPTIEMBRE"
         "OCTUBRE"
         "NOVIEMBRE"
         "DICIEMBRE"
      )
   )

   (setq days
      (list
         "Domingo"
         "Lunes"
         "Martes"
         "Miércoles"
         "Jueves"
         "Viernes"
         "Sábado"
      )
   )

   (setq xdist (- (car pt1) (car pt0)))
   (setq ydist (- (cadr pt1) (cadr pt0)))

   (setq height (/ ydist 12.0))
   (setq width_factor (/ xdist ydist 2.0))
  

  (command "-color" 7);negro
  (box pt0 pt1); dibuja marco negro
  
  (command "-color" 3) ; verde
  (command "-Style" "N" "Lithograph" height (* width_factor 1.5) 0 "N" "N")  ; estilo para mes

   (text  ; texto mes
     (strcat (nth month months)" " (itoa year))
      (list
         (+
            (car pt0)
            (/ xdist 2.0)
            (* (strlen (nth month months)) 0 height width_factor)
         )
         (+
            (cadr pt0)
            (- ydist (* ydist (* 0.1225 0.5 )))
         )
      )
      height
      (* width_factor 1.5)
   )
   (setq mes (nth month months))
  
  (command "-Style" "N" "Segoe Print" (* height 0.33) (* width_factor 1.3) 0 "N" "N")  ; estilo para DIA

   (setq m 2.0)
   (foreach day days
     (if (= day "Domingo")
         (command "-color" 1)
         (command "-color" 7)
       )
    
  
      (text
         day
         (list
            (+
               (car pt0)
               (* m (/ xdist 28.0))
            )
            (+
               (cadr pt0)
               (- ydist (* ydist 0.146))
            )
         )
         (* height 0.33)
         (* width_factor 1.3)
      )
      (setq m (+ m 4.0))
      (setq dia day)
   ); termina nombre del dia
  
   (setq n 5.65);posición
   (foreach week dates
     (setq m 2.0 numdates dates)
      (foreach date week
        (setq numdia date)
 (setq diaescrito (strcat mes (itoa numdia)))

 (if (or (= (vl-position date week) 0)(member diaescrito festivos))(command "-color" 1)(command "-color" 7))

 (if (member diaescrito festivos)
    (if (and (= txtcumples "S")(= "C" (nth  (+ (vl-position diaescrito festivos) 2)festivos)))
     (command "-color" 104)
      )
  )
          
 (if (member diaescrito festivos)
    (if (and (= txtcumples "N")(= "C" (nth  (+ (vl-position diaescrito festivos) 2)festivos)))
    (command "-color" 7))
   )

  (command "-Style" "NUM" "arial" height (* width_factor 1.5) 0 "N" "N"); estilo para NUMEROS

 (if (/= date 0) ; escribir #
            (text
               (itoa date)
              (list
                  (+
                     (car pt0)
                     (* m (/ xdist 28.0))
                  )
                  (+
                     (cadr pt0)
                     (* n (/ posnumdia 5.5))
                  )
               )
               height
               (* width_factor 1.5)
            ))
       ; escribir texto del dia festivo
 (if (member diaescrito festivos)
  (progn
            (command "-Style" "FESTIVO" "arial" (* height 0.3) width_factor 0 "N" "N" )  ; estilo para texto festivos
            (command "-color" 3)
    (setq dato (nth  (1+ (vl-position diaescrito festivos)) festivos))
        (setq wf (* (/ 17.0 (strlen dato))(* width_factor 0.9)))
 (if (> wf (* width_factor 0.9))
    (setq wf (* width_factor 0.9)))

    
 (if (or
      (and (= txtcumples "S")(= "C" (nth  (+ (vl-position diaescrito festivos) 2)festivos)))
      (and (= txtcumples "S")(= "F" (nth  (+ (vl-position diaescrito festivos) 2)festivos)))
      (and (= txtcumples "N")(= "F" (nth  (+ (vl-position diaescrito festivos) 2)festivos))))
 (if (/= date 0)
            (text
               dato
              (list
                  (+
                     (car pt0)
                     (* m (/ xdist 28.0))
                  )
                  (-(+ (cadr pt0)
                     (* n (/ posnumdia 5.5)))
     (* %numdia 0.5)
                  )
               )
               (* height 0.3)
               wf
            ))
  )
         );fin de progn
 ); fin texto del dia festivo
    
          (setq m (+ m 4.0))
       )
      (setq n (1- n))
   )
)

(defun faño ()
    (set_tile "dyear" $value)
    (setq year1 (atoi $value))
  )

(defun fyear ()
    (set_tile "año" $value)
    (setq year1 (atoi $value))
  )

(defun fcumples ()
    
  (if (= txtcumples1 "1")(setq txtcumples "S")(setq txtcumples "N"))
)

(defun fpuntos()

   ;get points for lower left month position
   (initget "Anterior")
   (if ptoa
      (progn
 (setq pta (getpoint "\n        Punto Inferior Izquierdo para Marco del Mes   : <[Anterior]"))
        (if (or (= pta "Anterior")(not pta))(setq pta ptoa))
 )
      (progn
 (setq pta (getpoint "\n        Punto Inferior Izquierdo para Marco del Mes  : "))
 (setq ptoa pta)
 )
     )
   (initget "Anterior")
   (if ptob
      (progn
 (setq ptb (getpoint "\n        Punto Superior Derecho para Marco del Mes : <[Anterior]"))
        (if (or (= ptb "Anterior")(not ptb))(setq ptb ptob))
 )
      (progn
 (setq ptb (getpoint "\n        Punto Superior Derecho para Marco del Mes : "))
 (setq ptob ptb)
 )
     )
   (setq pt0
      (list
         (apply (quote min) (list (car pta) (car ptb)))
         (apply (quote min) (list (cadr pta) (cadr ptb)))
      )
   )

   (setq pt1
      (list
         (apply (quote max) (list (car pta) (car ptb)))
         (apply (quote max) (list (cadr pta) (cadr ptb)))
      )
   )

   (setq xdist (- (car pt1) (car pt0)))
   (setq ydist (- (cadr pt1) (cadr pt0)))
   (if year1 (setq year year1))
(princ)
  )

(defun fcolumnas ()
  (setq columns (nth (atoi columns) listacolumnas))
  (set_tile "acomodo" (strcat (itoa columns)"x"(itoa (/ 12 columns )) " Meses."))
  )

(defun fok ()
  (setq año year
 opcion option
 pto0 pt0
 pto1 pt1
 columnas columns
 cumples txtcumples
 )
  )

(defun f0 ()
  (set_tile "acomodo" (strcat (itoa columns)"x"(itoa (/ 12 columns )) " Meses."))
  (set_tile "columnas" (itoa columns))
  (mode_tile "columnas" 0)
  )

(defun fmeses ()
  (set_tile "columnas" "0")
  (set_tile "acomodo" "1 Mes Individual.")
  (mode_tile "columnas" 1)
  )

;función principal
(defun C:calen
   (
      / echo ortho calender  pta ptb
       month i j m n x y gencal
   )
  (vl-load-com)
   ;store system variables
   (setq osact (getvar "osmode"))
   (setq echo (getvar "CMDECHO"))
   (setq ortho (getvar "ORTHOMODE"))
   (setq coloractual (getvar "cecolor"))
   (setq styleactual (getvar "textstyle"))
  
   (if (not year)(setq year (atoi (substr(rtos (getvar "cdate") 2 6) 1 4))))
   (if year1 (setq year year1))
   (if (not option) (setq option 0))
   (setq listacolumnas '(1 2 3 4 6 12))
   (if (not columns)(setq columns 3))

(setq festivos
       ; mes+dia    texto    F=feriado ó C=cumpleaños
 (list "ENERO1" "Año Nuevo" "F"
       "ENERO5" "Mi Cumpleaños" "C"
       "ENERO6" "Reyes" "F"
  
      "FEBRERO2"  "Constitución Mexicana(5)" "F"
      "FEBRERO5"  "Constitución Mexicana" "F"
      "FEBRERO10" "Fuerza Aérea" "F"
      "FEBRERO18" "Miércoles de Ceniza" "F"
      "FEBRERO19" "Ejército Mexicano" "F"
      "FEBRERO24" "Bandera Mexicana" "F"
 
      "MARZO1"    "Familia" "F"
      "MARZO8"    "Intern. de la Mujer" "F"
      "MARZO16"   "Nat. de Benito Juárez(21)" "F"
      "MARZO18"   "Expropiación Petrolera" "F"
      "MARZO21"   "Nat. de Benito Juárez" "F"
      "MARZO29"   "Domingo de Ramos" "F"
  
      "ABRIL2"    "Jueves Santo" "F"
      "ABRIL3"    "Viernes Santo" "F"
      "ABRIL4"    "Sábado de Gloria" "F"
      "ABRIL5"    "Domingo de Resurrección" "F"
      "ABRIL21"   "Def. de Veracruz" "F"
      "ABRIL25"   "San Marcos" "F"
      "ABRIL30"   "Niño" "F"
  
      "MAYO1"     "Trabajo" "F"
      "MAYO5"     "Batalla Puebla" "F"
      "MAYO8"     "Nat. de Miguel Hidalgo" "F"
      "MAYO10"    "Madre" "F"
      "MAYO15"    "Maestro" "F"
      "MAYO23"    "Estudiante" "F"
  
      "JUNIO1"    "Marina" "F"
      "JUNIO21"   "Padre" "F"
  
      "JULIO13"   "Policía Federal" "F"
  
      "AGOSTO15"  "N. Sra. de la Asunción" "F"
  
      "SEPTIEMBRE13" "Niños Héroes" "F"
      "SEPTIEMBRE15" "Grito de Dolores" "F"
      "SEPTIEMBRE16" "Indep. México" "F"
      "SEPTIEMBRE27" "Consumación Indep." "F"
      "SEPTIEMBRE30" "Nat. Morelos y Pavón" "F"
  
      "OCTUBRE2" "Matanza Tlatelolco" "F"
      "OCTUBRE12" " Raza" "F"
 
      "NOVIEMBRE1" "Todos Santos" "F"
      "NOVIEMBRE2" "Fieles Difuntos" "F"
  "NOVIEMBRE13" "Cumpleaños de Rafa" "C"
      "NOVIEMBRE16" "Rev. Mexicana (20)" "F"
      "NOVIEMBRE20" "Rev. Mexicana" "F"
  "NOVIEMBRE21" "Brigido" "F"
  "NOVIEMBRE22" "Gerardo Miranda" "F"
      "NOVIEMBRE23" "Armada de México" "C"
  "NOVIEMBRE29" "Ernesto Flores" "F"
  
      "DICIEMBRE12" "V. Guadalupe" "C"
      "DICIEMBRE16" "Inicio Posadas" "F"
      "DICIEMBRE24" "Noche Buena" "F"
      "DICIEMBRE25" "Navidad" "F"
  "DICIEMBRE28" "Santos Inocentes" "F"
  "DICIEMBRE31" "ASUETO" "F"
      )
   )

   ;set system variables
   (setvar "CMDECHO" 0)
   (setvar "ORTHOMODE" 1)
  
   (command)
   (command ".UNDO" "GROUP")
  (create_dialogcalen)
  (setq dcl_id (load_dialog fname))
  (setq what_next 2 cnt 1)
  (while (>= what_next 2)
    (if (null (new_dialog "calen" dcl_id))
    (exit)
    )

  (set_tile "dyear" (itoa year))
  (set_tile "año" (itoa year))
  (if option (mode_tile (itoa option) 2))
    
  (if (= txtcumples "S")(set_tile "cumples" "1")(progn(set_tile "cumples" "0")(setq txtcumples "N")))
;;;  (if columns (set_tile "columnas" (itoa (vl-position columns listacolumnas)))(set_tile "columnas" "3"))

  (setq w (dimx_tile "puntos")  ;get image tile width
        h (dimy_tile "puntos")  ;get image tile height
  );setq
  (start_image "puntos")  ;start the image
  (fill_image 0 0 w h 7)  ;fill the image with blue
  (vector_image 25 4 17 12 2)  ;draw vector
  (vector_image 25 4 19 4 2)  ;draw vector
  (vector_image 25 4 25 11 2)  ;draw vector
  (vector_image 4 28 12 18 2)  ;draw vector
  (vector_image 4 28 11 28 2)  ;draw vector
  (vector_image 4 28 4 22 2)  ;draw vector
  (end_image)  ;end image
  (if xdist (set_tile "medidax" (rtos xdist 2 4)))
  (if ydist (set_tile "mediday" (rtos ydist 2 4)))
  (start_list "columnas")
  (mapcar 'add_list '("1\n" "2\n" "3\n" "4\n" "6\n" "12\n"))
  (end_list)
    
  (if (= option 0)(f0)(fmeses))
;;;  (if (/= option 0)(if columns (set_tile "columnas" (itoa (vl-position columns listacolumnas)))(set_tile "columnas" "3"))
  (set_tile "acomodo" (strcat (itoa columns)"x"(itoa (/ 12 columns )) "Meses."))
  
  (action_tile "dyear" "(fyear))")
  (action_tile "año" "(faño)")
    
  (action_tile "1" "(setq option 1)(fmeses)")
  (action_tile "2" "(setq option 2)(fmeses)")
  (action_tile "3" "(setq option 3)(fmeses)")
  (action_tile "4" "(setq option 4)(fmeses)")
  (action_tile "5" "(setq option 5)(fmeses)")
  (action_tile "6" "(setq option 6)(fmeses)")
  (action_tile "7" "(setq option 7)(fmeses)")
  (action_tile "8" "(setq option 8)(fmeses)")
  (action_tile "9" "(setq option 9)(fmeses)")
  (action_tile "10" "(setq option 10)(fmeses)")
  (action_tile "11" "(setq option 11)(fmeses)")
  (action_tile "12" "(setq option 12)(fmeses)")
  (action_tile "0"  "(setq option 0)(f0)")
  (action_tile "columnas"  "(progn(setq columns $value)(fcolumnas))")
  (action_tile "cumples" "(progn (setq txtcumples1 $value)(fcumples))")
  (action_tile "puntos" "(done_dialog 4)")
  (action_tile "accept" "(if (not (and pt0 pt1))
   (progn
     (dos_msgbox \"NO HAS SELECCIONADO EL PUNTO\n    PARA INSERTAR EL CALENDARIO\" \"Alerta\" 1 1)
 (mode_tile \"puntos\" 4)
 )
     (progn
     (setq gencal T)
     (fok)
     (done_dialog)
     )
                           )"
    )
  (action_tile "cancel" "(done_dialog)")
  (setq what_next (start_dialog))
      (cond
      ((= what_next 4) ;Prompt user to
         (fpuntos)
       )
     )
)
  
(unload_dialog dcl_id)
(princ)

  (if gencal
   (progn
  
   ;calculate calender for year
   (setq calender (12cal year))


   (if (= option 0);columns
      (progn
         ;determine calender layout
         (setq rows (/ 12 columns))


         (setq x 0.0)
         (if (/= columns 1)
            (while (< (abs x) xdist)
               (setq x (getdist pt0 "\n        Distancia entre Columnas |<->|<->| : "))
               (if (< (abs x) xdist)
                  (prompt "\n        La Distancia debe ser > el ancho del Marco.")
               )
            )
         )

         (setq y 0.0)
         (if (/= rows 1)
            (while (< (abs y) ydist)
               (setq y (getdist pt0 "\n        Distancia entre Filas   === :"))
               (if (< (abs y) ydist)
                  (prompt "\n        La Distancia debe ser > la Altura del Marco.")
               )
            )
         )

 
         ;draw calender
         (setq month 0)
         (setq j (1- rows))
         (while (>= j 0)
            (setq n (+ (cadr pt0) (* j y)))
            (setq i 0)
            (while (< i columns)
               (setq m (+ (car pt0) (* i x)))
               (draw_month
                  (list m n)
                  (list
                     (+ m xdist)
                     (+ n ydist)
                  )
                  month
                  (nth month calender)
               )
               (setq i (1+ i))
               (setq month (1+ month))
            )
            (setq j (1- j))
         )
      )
      (progn
         (setq month (1- option))
         (draw_month
            pt0
            pt1
            month
            (nth month calender)
         )
      )
   )
  )
 )

   (command ".UNDO" "END")

   ;restore system variables
   (setvar "CMDECHO" echo)
   (setvar "ORTHOMODE" ortho)
   (setvar "osmode" osact)
   (setvar "cecolor" coloractual)
   (setvar "textstyle" styleactual)
   (princ)
  )

(defun create_dialogcalen ()
(setq fname (vl-filename-mktemp "dcl.dcl"))
(setq fn (open fname "w"))
(write-line "calen:dialog {label=\"CALEN v1.1  ** C E M E X  **  JPMR '15\";
spacer;:boxed_row{:paragraph{:text_part {label= \"Seleccione el Año :\";
alignment=centered;}:text_part {label= \"---------------->\";alignment=centered;}
}: edit_box {mnemonic=\"A\";key=\"dyear\";alignment=left;
edit_limit=4;edit_width=4;value=2000;}: slider {
layout=vertical;key=\"año\";max_value=9999;min_value=1;
value=\"2015\";small_increment=1;}:paragraph{:text_part {label= \"\";alignment=centered;}
:text_part {label= \"\";alignment=centered;}}spacer;}: boxed_column {label=\"Mes Individual ó Todo el Año\";
:row{: button {label=\"Ene\"; key=\"1\"; alignment=centered; width=3;}
: button {label=\"Feb\"; key=\"2\";alignment=centered; width=3;}
: button {label=\"Mar\"; key=\"3\"; alignment=centered; width=3;}
: button {label=\"Abr\"; key=\"4\";alignment=centered; width=3;}}
: row {: button {label=\"May\"; key=\"5\"; alignment=centered; width=3;}
: button {label=\"Jun\"; key=\"6\";alignment=centered; width=3;}
: button {label=\"Jul\"; key=\"7\"; alignment=centered; width=3;}
: button {label=\"Ago\"; key=\"8\";alignment=centered; width=3;}}
: row {: button {label=\"Sep\"; key=\"9\"; alignment=centered; width=3;}
: button {label=\"Oct\"; key=\"10\";alignment=centered; width=3;}
: button {label=\"Nov\"; key=\"11\"; alignment=centered; width=3;}
: button {label=\"Dic\"; key=\"12\";alignment=centered; width=3;}}
: row {spacer;: button {label=\"Todo el Año\"; key=\"0\"
;alignment=centered; fixed_width=true;}spacer;}
}:boxed_row {label=\"Layout\";:paragraph{:text_part {label= \"Cantidad \";alignment=right;}
:text_part {label= \"de Columnas:\";alignment=right;}}: list_box {key=\"columnas\";
height=3;fixed_height=true;allow_accept=true;value=2;width=6;}
:paragraph{:text_part {label= \"Acomodo:\";}:text_part {label= \"3x4 Meses\";key=\"acomodo\";}
}}:boxed_row{label=\"Dimensiones del Mes\";spacer;: paragraph { //define paragraph
: text_part {label=\"X=\";alignment=right;}: text_part {label=\"Y=\";alignment=right; //some more text
}}:paragraph{:text_part {label= \"no existe\";key=\"medidax\";}:text_part{label= \"no existe\"
;key=\"mediday\";}}: image_button {key=\"puntos\";
height=2.45;width=5.0;fixed_width=true;fixed_height=true;}spacer;}:boxed_column{
: toggle {label=\"Incluir Textos de Cumpleaños\";key=\"cumples\";value=1;}spacer;}
:  row   {label=\"Juan Pablo Molina Ramirez    CEMEX  2015\";}
:row{ok_cancel;}
}" fn)
(close fn)
)

el problema que tengo con este es que no lo puedo hacer que funcione.

haber si me pueden ayudar por favor...


Gracias

y saludos

A ver, le he quitado una llamad Dos-msgbox que me imagino que sería de las doslib que no debes tener, he puesto el guión bajo en todos los command y he sustituido la letra  Lithograph (que no tengo)  por bold.

A mi me funciona, prueba

Código:

;cal.lsp
;James Tunstall
;Autodesk Australia
;28-08-91

;draws calenders of any year
;in several arrangements
;at any scale

;AutoCAD Release 11 or greater is required


;Adaptación al español por Mario de la Cruz Ortíz.
;mejoras v1.0:
; encabezado mes con año.
; nombre del dia completo.
; números del domingo en color rojo.
; texto de los dias festivos 2015 en México.
; texto de los cumpleaños.
; se corrige la posición de los dias finales del mes.
; numeros de cumpleaños en color verde.
; v1.1 se agrega el cuadro de diálogo.

;AutoCAD Release 2016

;Ajustes de tipo de litografia Juan Pablo Molina Ramirez
;mejoras v1.2:
;Tipos de Litografias al momento de insertar calendarios



(defun *error* (errmsg)
 (princ "\n       Se ha cancelado el programa... ")
 (terpri)
 (prompt errmsg)
   ;restore system variables
   (setvar "CMDECHO" echo)
   (setvar "ORTHOMODE" ortho)
   (setvar "osmode" osact)
   (setvar "cecolor" coloractual)
   (setvar "textstyle" styleactual)
 (princ)  
 (princ)
)

;Z direction of the current UCS.
(defun zdir
   (
      / xdir ydir
      a1 a2 a3
      b1 b2 b3
   )
   (setq xdir (getvar "UCSXDIR"))    ;X direction of the current UCS
   (setq ydir (getvar "UCSYDIR"))    ;Y direction of the current UCS

   (setq a1 (car xdir) a2 (cadr xdir) a3 (caddr xdir))
   (setq b1 (car ydir) b2 (cadr ydir) b3 (caddr ydir))

   ;return UCS Z axis direction

   (list
      (- (* a2 b3) (* a3 b2))
      (- (* a3 b1) (* a1 b3))
      (- (* a1 b2) (* a2 b1))
   )
)

;xdir of ECS
;requires (zdir)
(defun xdir
   (
   / normal factor b1 b2 b3 a1 a2 a3
   )

   (setq normal (zdir))
   (setq factor (/ 1.0 64.0))
   (setq b1 (car normal))
   (setq b2 (cadr normal))
   (setq b3 (caddr normal))

   (if
      (and
         (< (abs b1) factor)
         (< (abs b2) factor)
      )
      (progn
         (setq a1 0.0 a2 1.0 a3 0.0)
      )
      (progn
         (setq a1 0.0 a2 0.0 a3 1.0)
      )
   )

   ;return ECS X axis direction

   (list
      (- (* a2 b3) (* a3 b2))
      (- (* a3 b1) (* a1 b3))
      (- (* a1 b2) (* a2 b1))
   )
)

;base angle of UCS in terms of ECS
;requires (xdir) & (zdir)
(defun ucs_base_angle ( / ecs_xdir )

   (setq ecs_xdir
      (mapcar
         (quote +)
         (trans (xdir) 0 1)
         (trans (getvar "UCSORG") 0 1 T)
      )
   )

   (-
      0.0
      (atan (cadr ecs_xdir) (car ecs_xdir))
   )
)


;Modulo division
(defun % (x y)
   (- (fix x) (* (/ (fix x) (fix y)) (fix y)))
)

;Returns T if year is a leap year  - BISISESTO
(defun LeapYear ( year )
   (cond
      ((/= (% year 4) 0) nil)
      ((and
            (= (% year 100) 0)
            (/= (% year 400) 0)) nil)
      (T T)
   )
)

;returns day of week for 1st January for year
(defun JanOne
   ( year
     / LastYear LotsOf400 LotsOf100 LotsOfOne LeapYears DaysAhead
   )
   (if (> year 0)
      (progn
         (setq LastYear (- (fix year) 1))
         (setq LotsOf400 (/ LastYear 400))
         (setq LotsOf100 (/ (% LastYear 400) 100))
         (setq LotsOfOne (% LastYear 100))
         (setq LeapYears
            (+
               (* LotsOf400 97)
               (* LotsOf100 24)
               (/ LotsOfOne 4)
            )
         )
         (setq DaysAhead (+ (fix year) LeapYears))
         ;return day of week for 1st January
         ;0 Sunday 6 Saturday
         (% DaysAhead 7)
      )
      nil
   )
)

;returns a list of 12 calender months
;each month is made up of 5 weeks
;each week is made up of 7 days
;the value of the day indicates the date
;a value of zero(0) indicates a blank
(defun 12cal
   (
      year
      / week month StartOfMonth DaysInMonth date day calender
   )

   (setq StartOfMonth (JanOne year))

   (setq DaysInMonth
      (if (LeapYear year)
         (list 31 29 31 30 31 30 31 31 30 31 30 31)
         (list 31 28 31 30 31 30 31 31 30 31 30 31)
      )
   )

   (setq calender nil)
   (foreach NoOfDays DaysInMonth
      (setq month nil)
      (setq week nil)
      (cond
         (
            (and (= StartOfMonth 5) (= NoOfDays 31))
            (progn
               (setq week (list 0 0 0 0 0 1 2))
               (setq date 3)
               (setq StartOfMonth 1)
            )
         )
         (
            (and (= StartOfMonth 6) (= NoOfDays 31))
            (progn
               (setq week (list 0 0 0 0 0 0 1))
               (setq date 2)
               (setq StartOfMonth 2)
            )
         )
         (
            (and (= StartOfMonth 6) (= NoOfDays 30))
            (progn
               (setq week (list 0 0 0 0 0 0 1))
               (setq date 2)
               (setq StartOfMonth 1)
            )
         )
         (
            T
            (progn
               (setq day 0)
               (while (< day StartOfMonth)
                  (setq week (append week (list 0)))
                  (setq day (1+ day))
               )
               (setq date 1)
               (while (< day 7)
                  (setq week (append week (list date)))
                  (setq date (1+ date))
                  (setq day (1+ day))
               )
            )
         )
      )

      (setq month (append month (list week)))
      (repeat 5
         (setq week nil)
         (setq day 0)
         (while (< day 7)
            (if (= date NoOfDays)
               (setq StartOfMonth (% (1+ day) 7))
            )
            (if (<= date NoOfDays)
               (setq week (append week (list date)))
               (setq week (append week (list 0)))
            )
            (setq date (1+ date))
            (setq day (1+ day))
         )
         (setq month (append month (list week)))
      )
      (setq calender (append calender (list month)))
   )
)

;draws a box
(defun box (pt0 pt1)
  (setvar "osmode" 0)
  (setq %ecabezado (* ydist 0.1225)
 %nombredia (* ydist 0.0539)
        %numdia (/ (- ydist (+ %ecabezado %nombredia))6)
 posnumdia (- ydist (* ydist 0.245025))
 x1dia (/ xdist 7)
 )
   (command
      "_.PLINE"
      (list (car pt0) (cadr pt0))
      "_w" 0.040 0.040
      (list (car pt1) (cadr pt0))
      (list (car pt1) (cadr pt1))
      (list (car pt0) (cadr pt1))
      "_C"
   )
  (setq marcor (entlast))
  (setq radio (* (- (car pt1) (car pt0))0.02))
  (command "_fillet" "_r" radio "_fillet" "_p" marcor)
 
  (command "_.PLINE"
   (list (car pt0) (- (cadr pt1) %ecabezado))"_w" 0.020 0.020
   (list (car pt1) (- (cadr pt1) %ecabezado)) "")

    (command "_.PLINE"
   (list (car pt0) (- (cadr pt1) (+ %ecabezado %nombredia)))
   (list (car pt1) (- (cadr pt1) (+ %ecabezado %nombredia))) "")
    (command "_.copy" "_l" "" pt0 "_a" 6 (list (car pt0) (- (cadr pt0) %numdia)))

    (command "_.PLINE"
   (list (+ (car pt0) x1dia) (cadr pt0))
   (list (+ (car pt0) x1dia) (+ (- ydist %ecabezado) (cadr pt0))) "")
    (command "_.copy" "_l" "" pt0 "_a" 6 (list (+ (car pt0) x1dia) (cadr pt0)))

  )

;draws text
(defun text (string pt height xscale / extdir base_angle)

   ;current extrusion direction
   (setq extdir (zdir))

   ;base angle of UCS in terms of ECS
   (setq base_angle (ucs_base_angle))

   (entmake
      (list
         (cons 0 "TEXT")
         (cons 1 string)
         (cons 7 (getvar "TEXTSTYLE"))
 (cons 8 (getvar "clayer"))
         (append (list 10) (trans pt 1 extdir))
 (cons 11 (trans pt 1 extdir))
         (cons 40 height)
         (cons 41 xscale)
         (cons 50 base_angle)
         (cons 51 0.0)
         (cons 71 0)
         (cons 72 1)
         (cons 73 2)
 (append (list 210) extdir)
      )
   )
)

;draws a calender month
;given corner points,which month,a list of dates
(defun draw_month
   (
      pt0 pt1 month dates
      / months days xdist ydist m n height width_factor
   )

   (setq months
      (list
         "ENERO"
         "FEBRERO"
         "MARZO"
         "ABRIL"
         "MAYO"
         "JUNIO"
         "JULIO"
         "AGOSTO"
         "SEPTIEMBRE"
         "OCTUBRE"
         "NOVIEMBRE"
         "DICIEMBRE"
      )
   )

   (setq days
      (list
         "Domingo"
         "Lunes"
         "Martes"
         "Miércoles"
         "Jueves"
         "Viernes"
         "Sábado"
      )
   )

   (setq xdist (- (car pt1) (car pt0)))
   (setq ydist (- (cadr pt1) (cadr pt0)))

   (setq height (/ ydist 12.0))
   (setq width_factor (/ xdist ydist 2.0))
  

  (command "-color" 7);negro
  (box pt0 pt1); dibuja marco negro
  
  (command "-color" 3) ; verde
  (command "_-Style" "_N" "Bold" height (* width_factor 1.5) 0 "_N" "_N")  ; estilo para mes Lithograph

   (text  ; texto mes
     (strcat (nth month months)" " (itoa year))
      (list
         (+
            (car pt0)
            (/ xdist 2.0)
            (* (strlen (nth month months)) 0 height width_factor)
         )
         (+
            (cadr pt0)
            (- ydist (* ydist (* 0.1225 0.5 )))
         )
      )
      height
      (* width_factor 1.5)
   )
   (setq mes (nth month months))
  
  (command "_-Style" "_N" "Segoe Print" (* height 0.33) (* width_factor 1.3) 0 "_N" "_N")  ; estilo para DIA

   (setq m 2.0)
   (foreach day days
     (if (= day "Domingo")
         (command "-color" 1)
         (command "-color" 7)
       )
    
  
      (text
         day
         (list
            (+
               (car pt0)
               (* m (/ xdist 28.0))
            )
            (+
               (cadr pt0)
               (- ydist (* ydist 0.146))
            )
         )
         (* height 0.33)
         (* width_factor 1.3)
      )
      (setq m (+ m 4.0))
      (setq dia day)
   ); termina nombre del dia
  
   (setq n 5.65);posición
   (foreach week dates
     (setq m 2.0 numdates dates)
      (foreach date week
        (setq numdia date)
 (setq diaescrito (strcat mes (itoa numdia)))

 (if (or (= (vl-position date week) 0)(member diaescrito festivos))(command "-color" 1)(command "-color" 7))

 (if (member diaescrito festivos)
    (if (and (= txtcumples "S")(= "C" (nth  (+ (vl-position diaescrito festivos) 2)festivos)))
     (command "-color" 104)
      )
  )
          
 (if (member diaescrito festivos)
    (if (and (= txtcumples "N")(= "C" (nth  (+ (vl-position diaescrito festivos) 2)festivos)))
    (command "-color" 7))
   )

  (command "_-Style" "NUM" "arial" height (* width_factor 1.5) 0 "_N" "_N"); estilo para NUMEROS NUM

 (if (/= date 0) ; escribir #
            (text
               (itoa date)
              (list
                  (+
                     (car pt0)
                     (* m (/ xdist 28.0))
                  )
                  (+
                     (cadr pt0)
                     (* n (/ posnumdia 5.5))
                  )
               )
               height
               (* width_factor 1.5)
            ))
       ; escribir texto del dia festivo
 (if (member diaescrito festivos)
  (progn
            (command "_-Style" "FESTIVO" "arial" (* height 0.3) width_factor 0 "_N" "_N" )  ; estilo para texto festivos
            (command "-color" 3)
    (setq dato (nth  (1+ (vl-position diaescrito festivos)) festivos))
        (setq wf (* (/ 17.0 (strlen dato))(* width_factor 0.9)))
 (if (> wf (* width_factor 0.9))
    (setq wf (* width_factor 0.9)))

    
 (if (or
      (and (= txtcumples "S")(= "C" (nth  (+ (vl-position diaescrito festivos) 2)festivos)))
      (and (= txtcumples "S")(= "F" (nth  (+ (vl-position diaescrito festivos) 2)festivos)))
      (and (= txtcumples "N")(= "F" (nth  (+ (vl-position diaescrito festivos) 2)festivos))))
 (if (/= date 0)
            (text
               dato
              (list
                  (+
                     (car pt0)
                     (* m (/ xdist 28.0))
                  )
                  (-(+ (cadr pt0)
                     (* n (/ posnumdia 5.5)))
     (* %numdia 0.5)
                  )
               )
               (* height 0.3)
               wf
            ))
  )
         );fin de progn
 ); fin texto del dia festivo
    
          (setq m (+ m 4.0))
       )
      (setq n (1- n))
   )
)

(defun faño ()
    (set_tile "dyear" $value)
    (setq year1 (atoi $value))
  )

(defun fyear ()
    (set_tile "año" $value)
    (setq year1 (atoi $value))
  )

(defun fcumples ()
    
  (if (= txtcumples1 "1")(setq txtcumples "S")(setq txtcumples "N"))
)

(defun fpuntos()

   ;get points for lower left month position
   (initget "Anterior")
   (if ptoa
      (progn
 (setq pta (getpoint "\n        Punto Inferior Izquierdo para Marco del Mes   : <[Anterior]"))
        (if (or (= pta "Anterior")(not pta))(setq pta ptoa))
 )
      (progn
 (setq pta (getpoint "\n        Punto Inferior Izquierdo para Marco del Mes  : "))
 (setq ptoa pta)
 )
     )
   (initget "Anterior")
   (if ptob
      (progn
 (setq ptb (getpoint "\n        Punto Superior Derecho para Marco del Mes : <[Anterior]"))
        (if (or (= ptb "Anterior")(not ptb))(setq ptb ptob))
 )
      (progn
 (setq ptb (getpoint "\n        Punto Superior Derecho para Marco del Mes : "))
 (setq ptob ptb)
 )
     )
   (setq pt0
      (list
         (apply (quote min) (list (car pta) (car ptb)))
         (apply (quote min) (list (cadr pta) (cadr ptb)))
      )
   )

   (setq pt1
      (list
         (apply (quote max) (list (car pta) (car ptb)))
         (apply (quote max) (list (cadr pta) (cadr ptb)))
      )
   )

   (setq xdist (- (car pt1) (car pt0)))
   (setq ydist (- (cadr pt1) (cadr pt0)))
   (if year1 (setq year year1))
(princ)
  )

(defun fcolumnas ()
  (setq columns (nth (atoi columns) listacolumnas))
  (set_tile "acomodo" (strcat (itoa columns)"x"(itoa (/ 12 columns )) " Meses."))
  )

(defun fok ()
  (setq año year
 opcion option
 pto0 pt0
 pto1 pt1
 columnas columns
 cumples txtcumples
 )
  )

(defun f0 ()
  (set_tile "acomodo" (strcat (itoa columns)"x"(itoa (/ 12 columns )) " Meses."))
  (set_tile "columnas" (itoa columns))
  (mode_tile "columnas" 0)
  )

(defun fmeses ()
  (set_tile "columnas" "0")
  (set_tile "acomodo" "1 Mes Individual.")
  (mode_tile "columnas" 1)
  )

;función principal
(defun C:calen
   (
      / echo ortho calender  pta ptb
       month i j m n x y gencal
   )
  (vl-load-com)
   ;store system variables
   (setq osact (getvar "osmode"))
   (setq echo (getvar "CMDECHO"))
   (setq ortho (getvar "ORTHOMODE"))
   (setq coloractual (getvar "cecolor"))
   (setq styleactual (getvar "textstyle"))
  
   (if (not year)(setq year (atoi (substr(rtos (getvar "cdate") 2 6) 1 4))))
   (if year1 (setq year year1))
   (if (not option) (setq option 0))
   (setq listacolumnas '(1 2 3 4 6 12))
   (if (not columns)(setq columns 3))

(setq festivos
       ; mes+dia    texto    F=feriado ó C=cumpleaños
 (list "ENERO1" "Año Nuevo" "F"
       "ENERO5" "Mi Cumpleaños" "C"
       "ENERO6" "Reyes" "F"
  
      "FEBRERO2"  "Constitución Mexicana(5)" "F"
      "FEBRERO5"  "Constitución Mexicana" "F"
      "FEBRERO10" "Fuerza Aérea" "F"
      "FEBRERO18" "Miércoles de Ceniza" "F"
      "FEBRERO19" "Ejército Mexicano" "F"
      "FEBRERO24" "Bandera Mexicana" "F"
 
      "MARZO1"    "Familia" "F"
      "MARZO8"    "Intern. de la Mujer" "F"
      "MARZO16"   "Nat. de Benito Juárez(21)" "F"
      "MARZO18"   "Expropiación Petrolera" "F"
      "MARZO21"   "Nat. de Benito Juárez" "F"
      "MARZO29"   "Domingo de Ramos" "F"
  
      "ABRIL2"    "Jueves Santo" "F"
      "ABRIL3"    "Viernes Santo" "F"
      "ABRIL4"    "Sábado de Gloria" "F"
      "ABRIL5"    "Domingo de Resurrección" "F"
      "ABRIL21"   "Def. de Veracruz" "F"
      "ABRIL25"   "San Marcos" "F"
      "ABRIL30"   "Niño" "F"
  
      "MAYO1"     "Trabajo" "F"
      "MAYO5"     "Batalla Puebla" "F"
      "MAYO8"     "Nat. de Miguel Hidalgo" "F"
      "MAYO10"    "Madre" "F"
      "MAYO15"    "Maestro" "F"
      "MAYO23"    "Estudiante" "F"
  
      "JUNIO1"    "Marina" "F"
      "JUNIO21"   "Padre" "F"
  
      "JULIO13"   "Policía Federal" "F"
  
      "AGOSTO15"  "N. Sra. de la Asunción" "F"
  
      "SEPTIEMBRE13" "Niños Héroes" "F"
      "SEPTIEMBRE15" "Grito de Dolores" "F"
      "SEPTIEMBRE16" "Indep. México" "F"
      "SEPTIEMBRE27" "Consumación Indep." "F"
      "SEPTIEMBRE30" "Nat. Morelos y Pavón" "F"
  
      "OCTUBRE2" "Matanza Tlatelolco" "F"
      "OCTUBRE12" " Raza" "F"
 
      "NOVIEMBRE1" "Todos Santos" "F"
      "NOVIEMBRE2" "Fieles Difuntos" "F"
  "NOVIEMBRE13" "Cumpleaños de Rafa" "C"
      "NOVIEMBRE16" "Rev. Mexicana (20)" "F"
      "NOVIEMBRE20" "Rev. Mexicana" "F"
  "NOVIEMBRE21" "Brigido" "F"
  "NOVIEMBRE22" "Gerardo Miranda" "F"
      "NOVIEMBRE23" "Armada de México" "C"
  "NOVIEMBRE29" "Ernesto Flores" "F"
  
      "DICIEMBRE12" "V. Guadalupe" "C"
      "DICIEMBRE16" "Inicio Posadas" "F"
      "DICIEMBRE24" "Noche Buena" "F"
      "DICIEMBRE25" "Navidad" "F"
  "DICIEMBRE28" "Santos Inocentes" "F"
  "DICIEMBRE31" "ASUETO" "F"
      )
   )

   ;set system variables
   (setvar "CMDECHO" 0)
   (setvar "ORTHOMODE" 1)
  
   (command)
   (command "_.UNDO" "_GROUP")
  (create_dialogcalen)
  (setq dcl_id (load_dialog fname))
  (setq what_next 2 cnt 1)
  (while (>= what_next 2)
    (if (null (new_dialog "calen" dcl_id))
    (exit)
    )

  (set_tile "dyear" (itoa year))
  (set_tile "año" (itoa year))
  (if option (mode_tile (itoa option) 2))
    
  (if (= txtcumples "S")(set_tile "cumples" "1")(progn(set_tile "cumples" "0")(setq txtcumples "N")))
;;;  (if columns (set_tile "columnas" (itoa (vl-position columns listacolumnas)))(set_tile "columnas" "3"))

  (setq w (dimx_tile "puntos")  ;get image tile width
        h (dimy_tile "puntos")  ;get image tile height
  );setq
  (start_image "puntos")  ;start the image
  (fill_image 0 0 w h 7)  ;fill the image with blue
  (vector_image 25 4 17 12 2)  ;draw vector
  (vector_image 25 4 19 4 2)  ;draw vector
  (vector_image 25 4 25 11 2)  ;draw vector
  (vector_image 4 28 12 18 2)  ;draw vector
  (vector_image 4 28 11 28 2)  ;draw vector
  (vector_image 4 28 4 22 2)  ;draw vector
  (end_image)  ;end image
  (if xdist (set_tile "medidax" (rtos xdist 2 4)))
  (if ydist (set_tile "mediday" (rtos ydist 2 4)))
  (start_list "columnas")
  (mapcar 'add_list '("1\n" "2\n" "3\n" "4\n" "6\n" "12\n"))
  (end_list)
    
  (if (= option 0)(f0)(fmeses))
;;;  (if (/= option 0)(if columns (set_tile "columnas" (itoa (vl-position columns listacolumnas)))(set_tile "columnas" "3"))
  (set_tile "acomodo" (strcat (itoa columns)"x"(itoa (/ 12 columns )) "Meses."))
  
  (action_tile "dyear" "(fyear))")
  (action_tile "año" "(faño)")
    
  (action_tile "1" "(setq option 1)(fmeses)")
  (action_tile "2" "(setq option 2)(fmeses)")
  (action_tile "3" "(setq option 3)(fmeses)")
  (action_tile "4" "(setq option 4)(fmeses)")
  (action_tile "5" "(setq option 5)(fmeses)")
  (action_tile "6" "(setq option 6)(fmeses)")
  (action_tile "7" "(setq option 7)(fmeses)")
  (action_tile "8" "(setq option 8)(fmeses)")
  (action_tile "9" "(setq option 9)(fmeses)")
  (action_tile "10" "(setq option 10)(fmeses)")
  (action_tile "11" "(setq option 11)(fmeses)")
  (action_tile "12" "(setq option 12)(fmeses)")
  (action_tile "0"  "(setq option 0)(f0)")
  (action_tile "columnas"  "(progn(setq columns $value)(fcolumnas))")
  (action_tile "cumples" "(progn (setq txtcumples1 $value)(fcumples))")
  (action_tile "puntos" "(done_dialog 4)")
  (action_tile "accept"
 "(if (not (and pt0 pt1))
 (progn
 (alert \"NO HAS SELECCIONADO EL PUNTO\n    PARA INSERTAR EL CALENDARIO\")
 (mode_tile \"puntos\" 4)
 )
 (progn
 (setq gencal T)
 (fok)
 (done_dialog)
 )
 )"
 ;;(dos_msgbox \"NO HAS SELECCIONADO EL PUNTO\n    PARA INSERTAR EL CALENDARIO\" \"Alerta\" 1 1)
    )
  (action_tile "cancel" "(done_dialog)")

  (setq what_next (start_dialog))
      (cond
      ((= what_next 4) ;Prompt user to
         (fpuntos)
       )
     )
)
  (PRINT (fpuntos))
(unload_dialog dcl_id)
(princ)

  (if gencal
   (progn
  
   ;calculate calender for year
   (setq calender (12cal year))


   (if (= option 0);columns
      (progn
         ;determine calender layout
         (setq rows (/ 12 columns))


         (setq x 0.0)
         (if (/= columns 1)
            (while (< (abs x) xdist)
               (setq x (getdist pt0 "\n        Distancia entre Columnas |<->|<->| : "))
               (if (< (abs x) xdist)
                  (prompt "\n        La Distancia debe ser > el ancho del Marco.")
               )
            )
         )

         (setq y 0.0)
         (if (/= rows 1)
            (while (< (abs y) ydist)
               (setq y (getdist pt0 "\n        Distancia entre Filas   === :"))
               (if (< (abs y) ydist)
                  (prompt "\n        La Distancia debe ser > la Altura del Marco.")
               )
            )
         )

 
         ;draw calender
         (setq month 0)
         (setq j (1- rows))
         (while (>= j 0)
            (setq n (+ (cadr pt0) (* j y)))
            (setq i 0)
            (while (< i columns)
               (setq m (+ (car pt0) (* i x)))
               (draw_month
                  (list m n)
                  (list
                     (+ m xdist)
                     (+ n ydist)
                  )
                  month
                  (nth month calender)
               )
               (setq i (1+ i))
               (setq month (1+ month))
            )
            (setq j (1- j))
         )
      )
      (progn
         (setq month (1- option))
         (draw_month
            pt0
            pt1
            month
            (nth month calender)
         )
      )
   )
  )
 )

   (command "_.UNDO" "_END")

   ;restore system variables
   (setvar "CMDECHO" echo)
   (setvar "ORTHOMODE" ortho)
   (setvar "osmode" osact)
   (setvar "cecolor" coloractual)
   (setvar "textstyle" styleactual)
   (princ)
  )

(defun create_dialogcalen ()
(setq fname (vl-filename-mktemp "dcl.dcl"))
(setq fn (open fname "w"))
(write-line "calen:dialog {label=\"CALEN v1.1  ** C E M E X  **  JPMR '15\";
spacer;:boxed_row{:paragraph{:text_part {label= \"Seleccione el Año :\";
alignment=centered;}:text_part {label= \"---------------->\";alignment=centered;}
}: edit_box {mnemonic=\"A\";key=\"dyear\";alignment=left;
edit_limit=4;edit_width=4;value=2000;}: slider {
layout=vertical;key=\"año\";max_value=9999;min_value=1;
value=\"2015\";small_increment=1;}:paragraph{:text_part {label= \"\";alignment=centered;}
:text_part {label= \"\";alignment=centered;}}spacer;}: boxed_column {label=\"Mes Individual ó Todo el Año\";
:row{: button {label=\"Ene\"; key=\"1\"; alignment=centered; width=3;}
: button {label=\"Feb\"; key=\"2\";alignment=centered; width=3;}
: button {label=\"Mar\"; key=\"3\"; alignment=centered; width=3;}
: button {label=\"Abr\"; key=\"4\";alignment=centered; width=3;}}
: row {: button {label=\"May\"; key=\"5\"; alignment=centered; width=3;}
: button {label=\"Jun\"; key=\"6\";alignment=centered; width=3;}
: button {label=\"Jul\"; key=\"7\"; alignment=centered; width=3;}
: button {label=\"Ago\"; key=\"8\";alignment=centered; width=3;}}
: row {: button {label=\"Sep\"; key=\"9\"; alignment=centered; width=3;}
: button {label=\"Oct\"; key=\"10\";alignment=centered; width=3;}
: button {label=\"Nov\"; key=\"11\"; alignment=centered; width=3;}
: button {label=\"Dic\"; key=\"12\";alignment=centered; width=3;}}
: row {spacer;: button {label=\"Todo el Año\"; key=\"0\"
;alignment=centered; fixed_width=true;}spacer;}
}:boxed_row {label=\"Layout\";:paragraph{:text_part {label= \"Cantidad \";alignment=right;}
:text_part {label= \"de Columnas:\";alignment=right;}}: list_box {key=\"columnas\";
height=3;fixed_height=true;allow_accept=true;value=2;width=6;}
:paragraph{:text_part {label= \"Acomodo:\";}:text_part {label= \"3x4 Meses\";key=\"acomodo\";}
}}:boxed_row{label=\"Dimensiones del Mes\";spacer;: paragraph { //define paragraph
: text_part {label=\"X=\";alignment=right;}: text_part {label=\"Y=\";alignment=right; //some more text
}}:paragraph{:text_part {label= \"no existe\";key=\"medidax\";}:text_part{label= \"no existe\"
;key=\"mediday\";}}: image_button {key=\"puntos\";
height=2.45;width=5.0;fixed_width=true;fixed_height=true;}spacer;}:boxed_column{
: toggle {label=\"Incluir Textos de Cumpleaños\";key=\"cumples\";value=1;}spacer;}
:  row   {label=\"Juan Pablo Molina Ramirez    CEMEX  2015\";}
:row{ok_cancel;}
}" fn)
(close fn)
)

UN saludo

hey nolo, fijate que todavia se me cancela por alguna extraña razon.....

Que mensaje te pone a interrumpirse ???
Un saludo

Perdon apenas estoy viendo tu pregunta...
pero resulta que ....... cuando invoco el comando CALEN.......como que quiere abrir el DCL y lo cierra inmediatamente y en la linea de comando me muestra esto



Saludos

Buscando por esa pista, veo que para el dcl pone:

Código:

(action_tile "dyear" "(fyear))")

y le sobra un paréntesis porque lo correcto es :

Código:

(action_tile "dyear" "(fyear)")

El caso es que eso, a mi no me da error (me funciona todo bien) , pero prueba a quitar el paréntesis de más, a ver que pasa ..
Tengo 2014 en Español

Un saludo

Ya le eliminé el parentesis y como quiera sigue mostrandome el mismo error....
estoy pensando que pudiera ser el AutoCAD pues yo tengo la version 2017....




en fin....


de todas formas te agradezco maestro....


Saludos

O como todas las variables son globales, algo que cargues desde otro lisp.
Lástima, si consigo probarlo en un 2017 te cuento aquí el resultado
Mirate también el temporal porque el lisp no borra los dcl que crea y el mío estaba plagadito.

Un saludo

Excelente idea....