;;;Código fuente del libro "Experto AutoCAD con Visual LISP"
;;; (c) 2012 Ediciones ARTUAL, S.L. Barcelona, España.
;;; (c) 2012-2020 Reinaldo Togores. Todos los derechos reservados
;;; Se permite su uso mencionando la obra y su autor.
;;;CapÃtulo 11. Seleccionar Entidades
(defun similar  (lista-ent / )
  (ssget "X"
         (list (assoc 0 lista-ent)
               (assoc 8 lista-ent)
               (if (assoc 67 lista-ent)
                 (assoc 67 lista-ent)
                 '(67 . 0))
               (if (assoc 62 lista-ent)
                 (assoc 62 lista-ent)
                 '(62 . 256))
               (if (assoc 6 lista-ent)
                 (assoc 6 lista-ent)
                 '(6 . "BYLAYER"))
               (assoc 410 lista-ent))))
;;;Listado 11.1. Selección de entidades con propiedades similares.
(defun C:BORRA-SIMILAR  ()
  (vl-cmdf
    "._erase"
    (similar
      (entget
        (car (entsel "\nDesigne objeto para borrar los similares: "))))
    "")
  (princ))
;;;Listado 11.2. Comando para borrar todos los objetos similares al designado.
(defun sel-area  (obj clave eiz esd)
  (ssget "X"
         (list (cons 0 obj)
               (cons 410 (getvar "ctab"))
               '(-4 . ">,>,*")
               (cons clave eiz)
               '(-4 . "<,<,*")
               (cons clave esd))))
;;;Listado 11.3. Selección por área rectangular.
(defun sel-area-multiclave  (obj capa lista-clave eiz esd)
  (ssgetÂ
    "X"
    (append
      (list (cons 0 obj) (cons 8 capa) (cons 410 (getvar "ctab")))
           (append '((-4 . "<OR"))
                   (apply 'append
                          (mapcar '(lambda (x)
                                     (list '(-4 . "<AND")
                                           '(-4 . ">,>,*")
                                           (cons x eiz)
                                           '(-4 . "<,<,*")
                                           (cons x esd)
                                           '(-4 . "AND>")))
                                  lista-clave))
                   '((-4 . "OR>"))))))
;;;Listado 11.4. Selección por área usando claves múltiples.
(defun sel-fuera  (obj clave eiz esd)
  (ssget "X"
         (list (cons 0 obj)
               (cons 410 (getvar "ctab"))
               '(-4 . "<OR")
               '(-4 . "<XOR") ;_ condición para la coord x
               '(-4 . ">,*,*")
               (cons clave eiz)
               '(-4 . "<,*,*")
               (cons clave esd)
               '(-4 . "XOR>")
               '(-4 . "<XOR") ;_ condición para la coord y
               '(-4 . "*,>,*")
               (cons clave eiz)
               '(-4 . "*,<,*")
               (cons clave esd)
               '(-4 . "XOR>")
               '(-4 . "OR>"))))
;;;Listado 11.5. Selección de todos los objetos fuera de un área rectangular.
(defun C:DEMO-SEL-AREA  (/ *error* ant-color dentro sel eiz esd)
  (vl-cmdf "._UNDO" "_Begin")
  (cmd-entrar)
  (setq ant-color (getvar "CECOLOR"))
  (initget 1 "Dentro Fuera")
  (if (= (getkword "\nSeleccionar [Dentro/Fuera]: ") "Dentro")
    (setq dentro t))
  (setvar "cecolor" "5")
  (vl-cmdf "._zoom" "_w" '(0.0 0.0) '(297.0 210.0))
  (vl-cmdf "._circle" '(10.0 10.0) 2.5)
  (vl-cmdf "._array" (entlast) "" "_r" 20 25 10.0 10.0)
  (prompt "\nDesigne zona para la selección: ")
  (setq eiz (getpoint "\nEsquina inferior izquierda: ")
        esd (getcorner eiz "\nEsquina superior derecha: "))
  (if (apply 'and (mapcar '<= eiz esd))
    (progn
      (getstring
        "\nPresione una tecla para dejar un sólo cÃrculo visible: ")
      (vl-cmdf "._zoom" "_w" '(5.0 5.0) '(15.0 15.0))
      (alert "Seleccionando cÃrculos no visibles y cambiando color...")
      (setq sel (if dentro
                  (sel-area "CIRCLE" 10 eiz esd)
                  (sel-fuera "CIRCLE" 10 eiz esd)))
      (vl-cmdf "._change" sel "" "_p" "_c" 1 "")
      (getstring
        "\nPresione una tecla para regresar a la vista anterior: ")
      (vl-cmdf "._zoom" "_p")
      (alert (strcat (itoa (sslength sel))
                     " cÃrculos seleccionados cambiados a rojo"))
      (cmd-salir)
      (setvar "CECOLOR" ant-color)
      (vl-cmdf "._UNDO" "_End"))
    (progn (vl-cmdf "._UNDO" "_Back")
           (prompt "\nError en tiempo de ejecución!")))
  (princ))
;;;Listado 11.6. Demostración de las funciones de selección por un área rectangular.
(defun ss+  (/ conj-sel tmp)
  (setvar "grips" 2)                    ; 2010 o anterior:(setvar "grips" 1)
  (setq conj-sel (ssadd))
  (while (setq tmp (entsel "\nSeleccione entidad a añadir: "))
    (ssadd (car tmp) conj-sel)
    (sssetfirst nil conj-sel))
  conj-sel)
;;;Listado 11.7. Demostración de SSADD.
(defun ss++  (/ conj-sel tmp agregar)
  (cmd-entrar)
  (setvar "grips" 2)
  (setq conj-sel (ssadd)
        agregar  t)
  (initget "Quitar")
  (while (setq tmp (getpoint (strcat "\nSelect entity to "
                                     (if agregar
                                       "agregar[Quitar]: "
                                       "quitar[Agregar]: "))))
    (cond ((listp tmp)
           (if (setq tmp (ssget tmp))
             (progn (apply (if agregar
                             'ssadd
                             'ssdel)
                           (list (ssname tmp 0) conj-sel))
             (sssetfirst nil conj-sel))))
          ((= tmp "Quitar") (setq agregar nil))
          (t (setq agregar t)))
    (initget (if agregar
               "Quitar"
               "Agregar")))
  (cmd-salir)
  (cdr (sssetfirst nil conj-sel)))
;;;Listado 11.8. Construcción de un conjunto de selección agregando y quitando entidades.
(defun ss->ax-ss  (conj-sel sel-nombre sel-coll / sel)
  (if (vl-catch-all-error-p
        (setq sel
               (vl-catch-all-apply 'vla-add (list sel-coll sel-nombre))))
    (vla-clear (setq sel (vla-item sel-coll sel-nombre))))
  (vla-additems sel (ss->matriz conj-sel))
  (vla-item sel-coll sel-nombre))
;;;Listado 11.9. Transformación de un PICKSET en SelectionSet.
(defun ss->matriz  (conj-sel / indice matriz)
  (setq indice 0
        matriz (vlax-make-safearray
                 vlax-vbObject
                 (cons 0 (1- (sslength conj-sel)))))
  (repeat (sslength conj-sel)
    (vlax-safearray-put-element
      matriz
      indice
      (vlax-ename->vla-object (ssname conj-sel indice)))
    (setq indice (1+ indice)))
  (vlax-make-variant matriz))
;;;Listado 11.10. Agregar objetos de un PICKSET a una matriz.
(defun VxSsetFilter  (Filtro)
  (mapcar '(lambda (Tipo Dato) (VxListToArray Tipo Dato))
          (list vlax-vbInteger vlax-vbVariant)
          (list (mapcar 'car Filtro) (mapcar 'cdr Filtro))))
;;;Listado 11.11. Creación automática de filtros de selección ActiveX (Jürg Menzi).
;;; ©2002 MENZI ENGINEERING GmbH, Switzerland. <http://www.menziengineering.ch/>
(defun VxListToArray  (Tipo Lista)
  (vlax-make-variant
    (vlax-safearray-fill
      (vlax-make-safearray Tipo (cons 0 (1- (length Lista))))
      Lista)))
;;;Listado 11.12. Función VxListToArray (Jürg Menzi).
;;; ©2002 MENZI ENGINEERING GmbH, Switzerland. <http://www.menziengineering.ch/>
(defun ax-sel-borde  (conj-sel point-list lista-filtro)
  (apply 'vla-SelectByPolygon
         (append (list conj-sel
                       acSelectionSetFence
                       (ax-lista->matriz (apply 'append point-list)))
                 (VxSsetFilter lista-filtro))))
;;;Listado 11.13. Selección del tipo BORDE con ActiveX.
(defun ax-lista->variant  (lista)
  (vlax-make-variant
    (vlax-safearray-fill
      (vlax-make-safearray
        vlax-vbObject
        (cons 0 (1- (length lista))))
      lista)))
;;;Listado 11.14. Conversión de la lista en matriz.
(defun ax-no-grupo  (lista-obj obj-grupo / tmp)
  (vlax-for obj  obj-grupo
    (setq tmp (cons (vla-get-handle obj) tmp)))
  (foreach obj  lista-obj
    (if (member (vla-get-handle obj) tmp)
      (setq lista-obj (vl-remove obj lista-obj))))
  lista-obj)
;;;Listado 11.15. Función para detectar y eliminar objetos pertenecientes a un Grupo.
(defun ax-suma-grupo  (nombre lista-obj / col-grupos grupo)
  (setq col-grupos (vla-get-Groups *aevl:dibujo*)
        grupo      (vl-catch-all-apply 'vla-Item (list col-grupos nombre)))
  (cond ((vl-catch-all-error-p grupo)
         (setq grupo (vla-Add col-grupos nombre))
         (vla-AppendItems grupo (ax-lista->variant lista-obj))
         grupo)
        (t
         (if (setq objetos (ax-no-grupo lista-obj grupo))
           (vla-AppendItems grupo (ax-lista->variant objetos)))
         grupo)))
;;;Listado 11.16. Función para añadir objetos a un Grupo.
(defun ax-si-grupo  (lista-obj obj-grupo / tmp)
  (vlax-for obj  obj-grupo
    (setq tmp (cons (vla-get-handle obj) tmp)))
  (foreach obj  lista-obj
    (if (not (member (vla-get-handle obj) tmp))
      (setq lista-obj (vl-remove obj lista-obj))))
  lista-obj)
;;;Listado 11.17. Función que elimina de la lista los objetos que no forman parte del Grupo.
(defun ax-resta-grupo  (nombre lista-obj / col-grupos grupo)
  (setq col-grupos (vla-get-Groups *aevl:dibujo*)
        grupo      (vl-catch-all-apply 'vla-Item (list col-grupos nombre)))
  (cond ((vl-catch-all-error-p grupo) nil)
        (t
         (if (setq objetos (ax-si-grupo lista-obj grupo))
           (vla-RemoveItems grupo (ax-lista->variant objetos)))
         (if (= (vla-get-Count grupo) 0)
           (vla-Delete grupo)
           grupo))))
;;;Listado 11.18. Función quita entidades de un Group.
