MENSAJES PERSONALES EN DIBUJOS

Esta aplicacion no es completamente mia, la atrape de no se donde, pero yo la he adaptado a español, y alguna otra mejora, sirve para introducir mensajes personales dentro de un dibujo, para recordar algun episodio u otro menester, que queramos guardar para recordar,
y cuando se abra el dibujo recordara que hay mensajes, para si los queremos leer o no.
hay que introducir la orden de cargar el programa DDmensajes, en Acad.lsp o AcadIso.lsp para que ejecute la orden de visualizar mensajes.
Yo la he usado cuando trabajaba antes de jubilarme, sobre todo en dibujos que manejan varios usuarios y cada uno puede poner un mensaje de alguna modificacion, para saber que dia y hora de dicha modificacion.
Espero que os sea de interes.

DDmensajes.lsp

Código:

; Creacion y manipulacion de mensajes personales.
;;;================================================================================================
(defun storemessage (msg-msg / msg-message msg-xname msg-scrt msg-ampm)
  (set_tile "error" "")
  (setq msg-message 1)
  (setq msg-scrt (rtos (getvar "cdate") 2 6))
  (if (or (= msg-msg " ") (= msg-msg ""))
    (set_tile "error" "¡MENSAJE VACIO, NO GUARDADO!")
    (progn (while (/= (dictsearch (namedobjdict) (strcat "message" (rtos msg-message 2 0))) nil)
             (setq msg-message (1+ msg-message))
           )
           (setq msg-xname (entmakex (append (list '(0 . "XRECORD") '(100 . "AcDbXrecord"))
                                             (list (cons 1 msg-msg))
                                             (list (cons 2 (strcase (getvar "loginname"))))
                                             (list (cons 3
                                                         (strcat (strcase sem)
                                                                 " "
                                                                 diax
                                                                 " "
                                                                 (strcase mesx)
                                                                 " "
                                                                 year
                                                                 "  "
                                                                 tmp
                                                                 " horas"
                                                         )
                                                   )
                                             )
                                     )
                           )
           )
           (dictadd (namedobjdict) (strcat "message" (rtos msg-message 2 0)) msg-xname)
           (set_tile "nuevo" "")
           (set_tile "autor" (strcase (getvar "loginname")))
           (set_tile "fechador"
                     (strcat (strcase sem) " " diax " " (strcase mesx) " " year "  " tmp " horas")
           )
    )
  )
  (show_list "mensajes")
)
;;;================================================================================================
(defun delmessage (msg-lineno / msg-test)
  (if (= msg-lineno "")
    (set_tile "error" "¡Por favor, SELECCIONE MENSAJE a BORRAR!")
    (progn (setq msg-test (read msg-lineno))
           (set_tile "error" "BORRANDO MENSAJE...")
           (dictremove (namedobjdict) (strcat "message" (rtos (1+ (read msg-lineno)) 2 0)))
           (while (dictrename (namedobjdict)
                              (strcat "message" (rtos (+ msg-test 2) 2 0))
                              (strcat "message" (rtos (+ msg-test 1) 2 0))
                  )
             (setq msg-test (1+ msg-test))
           )
    )
  )
  (set_tile "error" "")
  (set_tile "autor" "")
  (set_tile "fechador" "")
  (show_list "mensajes")
)
;;;================================================================================================
(defun show_list (msg-tile / msg-item msg-message)
  (start_list msg-tile)
  (setq msg-message 1)
  (while (setq msg-item (dictsearch (namedobjdict) (strcat "message" (rtos msg-message 2 0))))
    (add_list (cdr (assoc 1 msg-item)))
    (setq msg-message (1+ msg-message))
  )
  (end_list)
)
;;;================================================================================================
(defun show_info (msg-info / msg-record)
  (setq msg-record (dictsearch (namedobjdict) (strcat "message" (rtos (1+ (read msg-info)) 2 0))))
  (if (cdr (assoc 2 msg-record))
    (set_tile "autor" (cdr (assoc 2 msg-record)))
    (set_tile "autor" "---")
  )
  (if (cdr (assoc 3 msg-record))
    (set_tile "fechador" (cdr (assoc 3 msg-record)))
    (set_tile "fechador" "---")
  )
)
;;;================================================================================================
(defun yesno ()
  (if (not (= (get_tile "nuevo") ""))
    (progn (new_dialog "yes_no" ind)
           (action_tile "si" "(done_dialog 1)")
           (action_tile "no" "(exit)")
           (start_dialog)
    )
  )
)
;;;================================================================================================
(if (dictsearch (namedobjdict) "message1")
  (progn (setq ind (load_dialog "ddmensajes.dcl"))
         (new_dialog "yes_no" ind)
         (action_tile "si" "(done_dialog)")
         (action_tile "no" "(term_dialog)(exit)")
         (start_dialog)
  )
)
;;;================================================================================================
(defun c:ddmensajes (/ ind fecha year mes diax tmp n dia sem mesx)
  (setq fecha (rtos (getvar "cdate") 2 6))
  (setq year (rtos (atof (substr fecha 1 4)) 2 0))
  (setq mes (atof (substr fecha 5 2)))
  (setq diax (itoa (fix (atof (substr fecha 7 2)))))
  (setq tmp (strcat (substr fecha 10 2) "." (substr fecha 12 2)))
  (setq
    n (if (<= mes 2)
        (+ (fix (* (+ mes 13) 30.6)) (fix (* (- (atof (substr fecha 1 4)) 1) 365.25)) (atof diax))
        (+ (fix (* (+ mes 1) 30.6)) (fix (* (atof (substr fecha 1 4)) 365.25)) (atof diax))
      )
  )
  (setq dia (rtos (rem (- n 2) 7) 2 0))
  (setq sem
         (cdr (assoc dia
                     (mapcar 'cons
                             (list "0" "1" "2" "3" "4" "5" "6")
                             (list "Domingo" "Lunes" "Martes" "Miercoles" "Jueves" "Viernes" "Sabado")
                     )
              )
         )
  )
  (setq mesx (cdr (assoc mes
                         (mapcar 'cons
                                 (list 01 02 03 04 05 06 07 08 09 10 11 12)
                                 (list "Enero" "Febrero" "Marzo" "Abril" "Mayo" "Junio" "Julio"
                                       "Agosto" "Septiembre" "Octubre" "Noviembre" "Diciembre"
                                      )
                         )
                  )
             )
  )
  (setq fecha (strcat sem " " diax " " mesx " " year "  " tmp " horas"))
  (if (< (setq ind (load_dialog "DDmensajes.dcl")) 0)
    (progn (princ "\nNo se encuentra el fichero DDmensajes.dcl") (exit))
  )
  (new_dialog "ddmensajes" ind)
  (show_list "mensajes")
  (set_tile "fecha" fecha)
  (set_tile "rotulo" (strcat " SERVICIO de MENSAJERIA   :copyright:" (substr (rtos (getvar 'cdate) 2 4) 1 4)))
  (action_tile "mensajes" "(show_info $value)")
  (action_tile "borrar" "(delmessage(get_tile "mensajes"))")
  (action_tile "guardar" "(storemessage(get_tile "nuevo"))")
  (start_dialog)
  (prin1)
)
;;;================================================================================================


DDmensajes.DCL

Código:

//#################################################################################################
ddmensajes:dialog{key="rotulo";
   :boxed_column{label=" MENSAJES GUARDADOS ";
      :list_box{key="mensajes";width=120;value="1";}
      :row{
         :concatenation{
            :text_part{label="GUARDADO POR:";}
            :text{key="autor";width=20;fixed_width_font=true;}
            :text{key="fechador";width=50;fixed_width_font=true;}
         }
         :button{label="Borrar";key="borrar";fixed_width=true;allow_accept=true;}
      }
   }
   :boxed_row{label=" NUEVO MENSAJE ";
      :edit_box{key="nuevo";edit_limit=100;}
      :button{label="Guardar";key="guardar";fixed_width=true;}
   }
   :boxed_column{label="Indicaciones";
      :errtile{alignment=centered;fixed_width_font=true;}
   }  
   :row{fixed_width=true;alignment=centered;
     :boxed_column{label=" Luis Dominguez Gómez :copyright: 2005 ";
         :text{key="fecha";alignment=centered;}
      }
      :spacer{width=10;}
      ok_cancel;
   }  
}
//#################################################################################################
yes_no:dialog{label=" Aviso  de  Mensajes";width=35;
   :spacer{height=1;}
   :text_part{label="ESTE DIBUJO TIENE MENSAJES";fixed_width_font=true;}
   :spacer{height=1;}
   :text_part{label="QUIERES VERLOS AHORA";fixed_width_font=true;}
   :spacer{height=1;}
   :row{
      spacer;
      :button{label="Si";key="si";}
      :button{label="No";key="no";is_cancel=true;}
      spacer;
   }
 }
//#################################################################################################


Ejemplo de ACAD.LSP

Código:

; fichero para autoejecuciones al cargar un dibujo.
;;;================================================================================================
(defun-q
  s::startup
  nil
  (setvar 'cmdecho 0)
  (setvar 'acadlspasdoc 1) ; carga acad.lsp en todos los dibujos
  (vl-cmdf "_menu" "acad")
  ;;   (vl-cmdf "arx" "_L" "doslib17")
  (vl-cmdf "_regenall")
  (foreach p (list "point" "ddmensajes" "inf_novis" "Entorno_ldg" "remember" "Cumple_any") (load p))
  (vl-cmdf
    "_modemacro"
    " ($(edtime, 0,DDDD DD MONTH YYYY   H:MM)h)  (Capa···$(getvar,clayer))  (Altura texto···$(getvar,textsize))"
  )
  (prin1)
)
;;;================================================================================================


Saludos

Uhhhmmm. Qué buena pinta. La probaremos!!!!!