;;; PCNOSEL.LSP - nuages de points visibles mais exclus de la selection
;;; Commandes : PCOFF (activer) / PCON (desactiver) / FS (fenetre forcee)
(vl-load-com)

(defun pc-ss () (ssget "_X" '((0 . "*POINTCLOUD*"))))

;; retire les nuages de la selection a poignees courante
(defun pc-purge (/ ss new i en)
  (setq ss (cadr (ssgetfirst)))
  (if (and ss (> (sslength ss) 0))
    (progn
      (setq new (ssadd) i 0)
      (while (< i (sslength ss))
        (setq en (ssname ss i))
        (if (not (wcmatch (cdr (assoc 0 (entget en))) "*POINTCLOUD*"))
          (ssadd en new)
        )
        (setq i (1+ i))
      )
      (if (< (sslength new) (sslength ss))
        (sssetfirst nil (if (> (sslength new) 0) new nil))
      )
    )
  )
)

;; callback : garde anti-recursion + jamais pendant une commande active
(defun pc-cb (rea args)
  (if (and *pc-actif* (not *pc-busy*) (= "" (getvar "CMDNAMES")))
    (progn
      (setq *pc-busy* T)
      (vl-catch-all-apply 'pc-purge nil)
      (setq *pc-busy* nil)
    )
  )
  (princ)
)

(defun c:PCOFF (/ ss lay lays i)
  (if (setq ss (pc-ss))
    (progn
      ;; 1) nuage a l'arriere-plan : les lignes posees dessus se cliquent direct
      (setvar "SORTENTS" (logior 1 (getvar "SORTENTS")))
      (command "_.DRAWORDER" ss "" "_Back")
      ;; 2) verrouillage : les commandes ignorent le nuage
      (setq i 0)
      (while (< i (sslength ss))
        (setq lay (cdr (assoc 8 (entget (ssname ss i)))))
        (if (not (member lay lays)) (setq lays (cons lay lays)))
        (setq i (1+ i))
      )
      (foreach lay lays (command "_.-LAYER" "_LOck" lay ""))
      (setvar "LAYLOCKFADECTL" 0)
      ;; 3) reacteur : toute selection du nuage est annulee aussitot
      (if (not *pc-reactor*)
        (setq *pc-reactor*
          (vlr-miscellaneous-reactor nil '((:vlr-pickfirstModified . pc-cb)))
        )
      )
      (setq *pc-actif* T)
      (princ "\nNuages exclus de la selection. PCON pour retablir.")
    )
    (princ "\nAucun nuage de points dans le dessin.")
  )
  (princ)
)

(defun c:PCON (/ ss lay lays i)
  (setq *pc-actif* nil)
  (if (setq ss (pc-ss))
    (progn
      (setq i 0)
      (while (< i (sslength ss))
        (setq lay (cdr (assoc 8 (entget (ssname ss i)))))
        (if (not (member lay lays)) (setq lays (cons lay lays)))
        (setq i (1+ i))
      )
      (foreach lay lays (command "_.-LAYER" "_Unlock" lay ""))
    )
  )
  (princ "\nNuages de nouveau selectionnables.")
  (princ)
)

;; FS : fenetre de selection demarrable n'importe ou, meme en plein nuage
;; (gauche->droite = fenetre, droite->gauche = capture, comme en natif)
(defun c:FS (/ p1 p2 ss)
  (if (and (setq p1 (getpoint "\nPremier coin : "))
           (setq p2 (getcorner p1 "\nCoin oppose : ")))
    (progn
      (setq ss (ssget (if (< (car p1) (car p2)) "_W" "_C") p1 p2
                      '((0 . "~*POINTCLOUD*"))))
      (if ss
        (progn
          (sssetfirst nil ss)
          (princ (strcat "\n" (itoa (sslength ss)) " objet(s) selectionne(s)."))
        )
        (princ "\nAucun objet.")
      )
    )
  )
  (princ)
)

(princ "\nPCNOSEL charge : PCOFF / PCON / FS")
(princ)