aprender a usar manejo de error y while

Hola , hoy me toca a mi preguntar , tengo una defun que me permite copiar y poner en un nuevo punto la entidad elegida

Particularmente nunca me he manejado ni con error ni con la interacción con el usuario.

Ahora necesito aprender sobre este tema.

Que se pueda ir eligiendo de una en una las entidades y mover al nuevo punto , hasta que el usuario decida terminar

Adjunto el LISP y un ZIP que contiene el DWG
;************************************************************************************************************
(defun copio-y-muevo (/
AD
AI
CENTRO
ENTIDAD
ENTIDAD-COPIADA
ENTIDAD-NOMBRE
ENTIDAD-OBJ
NUEVO-PUNTO
PT1
PT2
)
(VL-LOAD-COM)
(prompt "\nSelecccione la entidad a copiar ")
(setq entidad (ssname (ssget "_:S+." (list (cons 0 "*") (cons 8 "*"))) 0))
(setq entidad-nombre (cdr (assoc 0 (entget entidad))))
(setq entidad-obj (VLAX-ENAME->VLA-OBJECT entidad))
(vla-GetBoundingBox entidad-obj 'ai 'ad)
(setq pt1 (VLAX-SAFEARRAY->LIST ai))
(setq pt2 (VLAX-SAFEARRAY->LIST ad))
(setq centro (MAPCAR '* '(0.5 0.5 0.5) (MAPCAR '+ Pt1 pt2)))
(setq nuevo-punto
(getpoint (strcat "\n Pique en el punto donde quiere copiar < " entidad-nombre " >"))
) ;_ setq
(setq entidad-copiada (vla-copy entidad-obj))
(vla-move entidad-copiada (VLAX-3D-POINT centro) (VLAX-3D-POINT nuevo-punto))
) ;_ defun
;;*//*/*/*/*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*



(defun C:cym ()
(copio-y-muevo)
)

Hola maestro.

La verdad es todo un honor poder colaborarte con "un poco" de lo mucho que me han ayudado en el foro.

Tu solicitud es relativamente sencilla, no es mas que agregarle una condicion while.... y listo.
Espero te sea de utilidad como todo con lo que me has ayudado.

Saludos y gracias.

Código:


;************************************************************************************************************
(defun copio-y-muevo (/
                      AD
                      AI
                      CENTRO
                      ENTIDAD
                      ENTIDAD-COPIADA
                      ENTIDAD-NOMBRE
                      ENTIDAD-OBJ
                      NUEVO-PUNTO
                      PT1
                      PT2
                      )
  (VL-LOAD-COM)
  (prompt "\nSelecccione la entidad a copiar {click derecho para terminar}  ")
  ;(setq entidad (ssname (ssget "_:S+." (list (cons 0 "*") (cons 8 "*"))) 0))
  (while
    (/=(setq obj(ssget "_:S+." (list(cons 0 "*")(cons 8 "*"))))
    (setq entidad(ssname obj 0))
    (setq entidad-nombre (cdr (assoc 0 (entget entidad))))
    (setq entidad-obj (VLAX-ENAME->VLA-OBJECT entidad))
    (vla-GetBoundingBox entidad-obj 'ai 'ad)
    (setq pt1 (VLAX-SAFEARRAY->LIST ai))
    (setq pt2 (VLAX-SAFEARRAY->LIST ad))
    (setq centro (MAPCAR '* '(0.5 0.5 0.5) (MAPCAR '+ Pt1 pt2)))
    (setq nuevo-punto
           (getpoint (strcat "\n Pique en el punto donde quiere copiar  < " entidad-nombre " >"))
          ) ;_  setq
       (setq entidad-copiada (vla-copy entidad-obj))
       (vla-move entidad-copiada (VLAX-3D-POINT centro) (VLAX-3D-POINT nuevo-punto))
       )
    )
  ) ;_  defun
;;*//*/*/*/*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*



(defun C:cym ()
 (copio-y-muevo)
  )

  
;|«Visual LISP:copyright: Format Options»
(100 2 1 2 T " " 100 6 0 0 1 nil T nil T)
;*** DO NOT add text below the comment! ***|;


Bueno, la parte del manejo de errores aún no la domino del todo.

Saludos

Hola Eliasp,
Perfecto , muchas gracias

Una disculpa, me faltó el "nil" ya está agregado en su lugar.

Código:


;************************************************************************************************************
(defun copio-y-muevo (/
                      AD
                      AI
                      CENTRO
                      ENTIDAD
                      ENTIDAD-COPIADA
                      ENTIDAD-NOMBRE
                      ENTIDAD-OBJ
                      NUEVO-PUNTO
                      PT1
                      PT2
                      )
  (VL-LOAD-COM)
  (prompt "\nSelecccione la entidad a copiar {click derecho para terminar}  ")
  ;(setq entidad (ssname (ssget "_:S+." (list (cons 0 "*") (cons 8 "*"))) 0))
  (while
    (/=(setq obj(ssget "_:S+." (list(cons 0 "*")(cons 8 "*"))))nil)
    (setq entidad(ssname obj 0))
    (setq entidad-nombre (cdr (assoc 0 (entget entidad))))
    (setq entidad-obj (VLAX-ENAME->VLA-OBJECT entidad))
    (vla-GetBoundingBox entidad-obj 'ai 'ad)
    (setq pt1 (VLAX-SAFEARRAY->LIST ai))
    (setq pt2 (VLAX-SAFEARRAY->LIST ad))
    (setq centro (MAPCAR '* '(0.5 0.5 0.5) (MAPCAR '+ Pt1 pt2)))
    (setq nuevo-punto
           (getpoint (strcat "\n Pique en el punto donde quiere copiar  < " entidad-nombre " >"))
          ) ;_  setq
       (setq entidad-copiada (vla-copy entidad-obj))
       (vla-move entidad-copiada (VLAX-3D-POINT centro) (VLAX-3D-POINT nuevo-punto))
       )
    
  ) ;_  defun
;;*//*/*/*/*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*



(defun C:cym ()
 (copio-y-muevo)
  )

  
;|«Visual LISP:copyright: Format Options»
(100 2 1 2 T " " 100 6 0 0 1 nil T nil T)
;*** DO NOT add text below the comment! ***|;


eliasp escribió:Una disculpa, me faltó el "nil" ya está agregado en su lugar.

Código:


;************************************************************************************************************
(defun copio-y-muevo (/
                      AD
                      AI
                      CENTRO
                      ENTIDAD
                      ENTIDAD-COPIADA
                      ENTIDAD-NOMBRE
                      ENTIDAD-OBJ
                      NUEVO-PUNTO
                      PT1
                      PT2
                      )
  (VL-LOAD-COM)
  (prompt "\nSelecccione la entidad a copiar {click derecho para terminar}  ")
  ;(setq entidad (ssname (ssget "_:S+." (list (cons 0 "*") (cons 8 "*"))) 0))
  (while
    (/=(setq obj(ssget "_:S+." (list(cons 0 "*")(cons 8 "*"))))nil)
    (setq entidad(ssname obj 0))
    (setq entidad-nombre (cdr (assoc 0 (entget entidad))))
    (setq entidad-obj (VLAX-ENAME->VLA-OBJECT entidad))
    (vla-GetBoundingBox entidad-obj 'ai 'ad)
    (setq pt1 (VLAX-SAFEARRAY->LIST ai))
    (setq pt2 (VLAX-SAFEARRAY->LIST ad))
    (setq centro (MAPCAR '* '(0.5 0.5 0.5) (MAPCAR '+ Pt1 pt2)))
    (setq nuevo-punto
           (getpoint (strcat "\n Pique en el punto donde quiere copiar  < " entidad-nombre " >"))
          ) ;_  setq
       (setq entidad-copiada (vla-copy entidad-obj))
       (vla-move entidad-copiada (VLAX-3D-POINT centro) (VLAX-3D-POINT nuevo-punto))
       )
    
  ) ;_  defun
;;*//*/*/*/*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*



(defun C:cym ()
 (copio-y-muevo)
  )

  
;|«Visual LISP:copyright: Format Options»
(100 2 1 2 T " " 100 6 0 0 1 nil T nil T)
;*** DO NOT add text below the comment! ***|;


GRACIAS

Aunque el hilo es viejo, me parece interesante como ejercicio...

Está un poco "a bote pronto" y se podrá mejorar seguro, pero como muestra del uso de VL-CATCH-ALL-APPLY para la gestión de errores y mostrar el funcionamiento de los bucles, creo que puede estar bien.

Código:


(defun C:TST (/ aux ctr err obj pt1 pt2 pta ptb ptn getfun tsterr)
  
  (vl-load-com)

;;---------------------------------------------------------------------------------------------------------------------------------
;;Función de error clásica, por si acaso, para "liberar" la entidad VLA. No creo que sea muy útil, pero...                        
;;---------------------------------------------------------------------------------------------------------------------------------

  (defun tsterr ()
    (if (vlax-object-released-p obj)
      (princ)
      (vlax-release-object obj)
      )
    (setq *error* err)
    (princ)
    )

;;---------------------------------------------------------------------------------------------------------------------------------
;;Función para conseguir los datos necesarios:                                                                                    
;;Primer bucle WHILE: la entidad                                                                                                  
;;Segundo bucle WHILE: el punto donde se quiere copiar la entidad                                                                  
;;Argumentos                                                                                                                      
;; a: el dato que se quiere conseguir, entidad o punto                                                                            
;; b: la variable donde se quiere alojar el dato                                                                                  
;; c: mensaje de texto en caso de que sea nula la designación                                                                      
;; Cuando se pulsa ESC, se produce un error y la función devuelve NIL para cortar el bucle                                        
;;---------------------------------------------------------------------------------------------------------------------------------
  
  (defun getfun (a b c / err)
    (cond
      ((vl-catch-all-error-p a) nil) ;Si hay un error o se pulsa ESC, devuelve "NIL" para cortar el bucle
      ((null a) (princ (strcat "\n" c)) T) ;Si no hay designación, devuelve "T" para mantener el bucle
      (T (set (eval (read b)) a) T) ;Mete la entidad designada en la variable aportada como argumento "b"
      )
    )

  (setq err *error*
 *error* tsterr
 )

  ;Variable auxiliar para controlar los bucles: si tiene contenido (siempre es "T"), se mantiene el bucle
    (setq aux T)
  
  ;Primer bucle: conseguir el objeto
  (while aux
    (setq aux (getfun (vl-catch-all-apply 'entsel '("\nDesigna objeto (ESC para salir): ")) "'obj" "Nada designado"))
    ;Si hay entidad en la variable OBJ, se procede
    (if obj
      (progn
 (setq obj (vlax-ename->vla-object (car obj)))
 (vla-GetBoundingBox obj 'pta 'ptb)
 (setq pt1 (vlax-safearray->list pta)
      pt2 (vlax-safearray->list ptb)
      ctr (mapcar '* '(0.5 0.5 0.5) (mapcar '+ pt1 pt2))
      )
 ;Segundo bucle: conseguir el punto. Mientras haya AUX (no se pulsa ESC), se mantiene el bucle para pedir más puntos
 (while aux
  (setq ptn nil ;hay que vaciar la variable que aloja el punto de copia
 aux
 (getfun
   (vl-catch-all-apply
     'getpoint
     (list (strcat "\nPique en el punto donde quiere copiar \"" (vla-get-objectname obj) "\" (ESC para salir): "))
     )
   "'ptn"
   "No se ha picado punto")
 )
  ;Si se ha picado un punto, copia la entidad.
  ;OJO: si el punto designado es nulo (botón derecho del ratón, por ejemplo), seguirá pidiendo puntos...
  (if ptn
    (vla-move (vla-copy obj) (vlax-3D-point ctr) (vlax-3d-point ptn))
    (vlax-release-object obj) ;Si se ha pulsado ESC, "libera" la entidad VLA alojada en OBJ
    )
  )
 )
      )
    )
  (setq *error* err)
  (gc)
  (princ)
  )


Gracias Kasperle .

Tres ejemplos de la misma rutina usando 2 opciones de error.
vl-catch-all-apply es una opción elegante y aunque en estos ejemplos se utiliza en funciones simples puede utilizarse llamando a funciones completas y gestionar sus errores dependiendo del mensaje utilizando VL-CATCH-ALL-ERROR-MESSAGE.

*error* es la opción por excelencia de autolisp de toda la vida. Se usa y seguirá usando. En el ejemplo "copio-y-muevo2a" se usa de modo sencillo, pero es común usarla para cerrar variables, eliminar objetos copiados al dar error, cerrar "UNDO" sin terminar, etc, etc..
¡OJO!: cerrar siempre *error* en el defun como si fuese una variable, si no se hace, puede reemplazar la rutina de *error* nativa de autocad.

Código:


;;************************************************************************************************************
(vl-load-com)

;;____________________________ copio-y-muevo1 ___________________________________
;; Copia una entidad multiple veces
;; Usando gestión de errores con vl-catch-all-apply
(defun copio-y-muevo1 (/ ad ai centro entidad entidad-copiada
         entidad-nombre entidad-obj nuevo-punto pt1 pt2)
 (prompt "\nSelecccione la entidad a copiar: ")
 (setq lstss (vl-catch-all-apply 'ssget (list "_:L:S+.")))
 (cond
  ;; error al seleccionar (ejemplo: pulsar ESCAPE)
  ((vl-catch-all-error-p lstss)) ;;se sale del programa sin hacer nada
  ;; no hay error pero se pincho en vacio o INTRO:
  ((not lstss)(prompt "\n¡No se selecciono ninguna entidad.!")) ;;se sale del programa
  ;;Se indico una entidad
  (T
   (setq entidad (ssname lstss 0))
   (setq entidad-nombre (cdr (assoc 0 (entget entidad))))
   (setq entidad-obj (vlax-ename->vla-object entidad))
   (vla-GetBoundingBox entidad-obj 'ai 'ad)
   (setq pt1 (vlax-safearray->list ai))
   (setq pt2 (vlax-safearray->list ad))
   (setq centro (mapcar '* '(0.5 0.5 0.5) (mapcar '+ pt1 pt2)))
   (setq nuevo-punto T)
  
   (while nuevo-punto
    (initget 32)
    (setq nuevo-punto (vl-catch-all-apply 'getpoint (list centro (strcat "\nIndique punto donde copiar [ " entidad-nombre " ]:"))))
    (cond
     ;; error al indicar punto (eje: ESCAPE), se sale de while y del programa
     ((vl-catch-all-error-p nuevo-punto)
      (setq nuevo-punto nil)
     )
     ;;¿INTRO?
     ((not nuevo-punto))
     ;;Todo correcto
     (T
      (setq entidad-copiada (vla-copy entidad-obj))
      (vla-move entidad-copiada (vlax-3d-point centro) (vlax-3d-point nuevo-punto))
     );c.T
    );c.cond
   );c.while
  );T
 );c.cond
 (princ)
) ;_ defun

;;____________________________ copio-y-muevo2 ___________________________________
;; Copia multiples entidades una vez cada una.
;; Usando gestión de errores con vl-catch-all-apply
(defun copio-y-muevo2 (/ ad ai centro entidad entidad-copiada
         entidad-nombre entidad-obj nuevo-punto pt1 pt2)
 (setq lstss T)
 (while lstss
  (prompt "\nSelecccione la entidad a copiar: ")
  (setq lstss (vl-catch-all-apply 'ssget (list "_:L:S+.")))
  (cond
   ;; error al seleccionar (ejemplo: pulsar ESCAPE)
   ((vl-catch-all-error-p lstss) ;;se sale del programa sin hacer nada
    (setq lstss nil)
   )
   ;; no hay error pero se pincho en vacio o INTRO:
   ((not lstss)
    (prompt "\n¡No se selecciono ninguna entidad.!")
    (setq lstss nil)
   )
   ;;Se indico una entidad
   (lstss
    (setq entidad (ssname lstss 0))
    (setq entidad-nombre (cdr (assoc 0 (entget entidad))))
    (setq entidad-obj (vlax-ename->vla-object entidad))
    (vla-GetBoundingBox entidad-obj 'ai 'ad)
    (setq pt1 (vlax-safearray->list ai))
    (setq pt2 (vlax-safearray->list ad))
    (setq centro (mapcar '* '(0.5 0.5 0.5) (mapcar '+ pt1 pt2)))
    (setq nuevo-punto T)
    (initget 32)
    (setq nuevo-punto (vl-catch-all-apply 'getpoint (list centro (strcat "\nIndique punto donde copiar [ " entidad-nombre " ]:"))))
    (cond
     ;; error al indicar punto (eje: ESCAPE), se sale de while y del programa
     ((vl-catch-all-error-p nuevo-punto)
      (setq lstss nil)
     )
     ;;¿INTRO?
     ((not nuevo-punto)
      (setq lstss nil)
     )
     ;;Todo correcto
     (T
      (setq entidad-copiada (vla-copy entidad-obj))
      (vla-move entidad-copiada (vlax-3d-point centro) (vlax-3d-point nuevo-punto))
     );c.T
    );c.cond
   );T
  );c.cond
 );c.while
 (princ)
);_ defun

;;____________________________ copio-y-muevo2a ___________________________________
;; Copia multiples entidades una vez cada una.
;; Usando gestión de errores (*error*)
(defun copio-y-muevo2a (/ ad ai centro entidad entidad-copiada
         entidad-nombre entidad-obj nuevo-punto pt1 pt2
 *error*)
 ;;---------------------------- *error* ----------------------------------
 ;; chequeo de *error*                                                    
 ;;-----------------------------------------------------------------------
 (defun *error* (msg / )
 ;;(if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*,interrup*")))
 (if msg
  (princ (strcat "\nError CYM: " msg))
 )
 (princ)
 );c.defun
 
 (setq lstss T)
 (while lstss
  (prompt "\nSelecccione la entidad a copiar: ")
  (setq lstss (ssget "_:L:S+."))
  (cond
   ;; no hay error pero se pincho en vacio o INTRO:
   ((not lstss)
    (prompt "\n¡No se selecciono ninguna entidad.!")
    (setq lstss nil)
   )
   ;;Se indico una entidad
   (lstss
    (setq entidad (ssname lstss 0))
    (setq entidad-nombre (cdr (assoc 0 (entget entidad))))
    (setq entidad-obj (vlax-ename->vla-object entidad))
    (vla-GetBoundingBox entidad-obj 'ai 'ad)
    (setq pt1 (vlax-safearray->list ai))
    (setq pt2 (vlax-safearray->list ad))
    (setq centro (mapcar '* '(0.5 0.5 0.5) (mapcar '+ pt1 pt2)))
    (setq nuevo-punto T)
    (initget 32)
    (setq nuevo-punto (getpoint centro (strcat "\nIndique punto donde copiar [ " entidad-nombre " ]:")))
    (cond
     ;;¿INTRO?
     ((not nuevo-punto)
      (setq lstss nil)
     )
     ;;Todo correcto
     (T
      (setq entidad-copiada (vla-copy entidad-obj))
      (vla-move entidad-copiada (vlax-3d-point centro) (vlax-3d-point nuevo-punto))
     );c.T
    );c.cond
   );T
  );c.cond
 );c.while
 (princ)
);_ defun

(defun C:cym1 () (copio-y-muevo1))
(defun C:cym2 () (copio-y-muevo2))
(defun C:cym2a () (copio-y-muevo2a))
(princ)