Lister les intersections d’objets d'un jeu de sélection

[VDH-Bruno]

Bonjour,

 

Ce sujet m’a inspiré pour écrire une routine qui permet de lister tous les points d’intersections d’objets contenu dans un jeu de sélection.

 

Je n’ai pas testé en profondeur mais ça à l’air de tenir la route, personnellement je vais m’en servir pour positionner rapidement des blocs sur une trame préalablement dessiner.

 

Voilà au cas où d’autres participants aux forums en auraient l’usage..

A+

 

Le code:

;; VDH-Bruno le 12/10/2011
;; -----------------------------------------------------------------------------
;; Liste toutes les intersections présentent dans le jeu de sélection
;; (Avec suppression des points en doublons)
;; -----------------------------------------------------------------------------
;; Argument: Un jeu de sélection du type <Selection set: 2a>
;; Retourne: Une liste de point du type ((x1 y1 z1) (x2 y2 z2) (x3 y3 z3) ...)

(defun bv:ListInters (ss)
 (remove_doubles
   (apply 'append
   (mapcar '(lambda (x)
	      (bv:xyz->Pt
		(vlax-invoke
		  (vlax-ename->vla-object (car x))
		  'IntersectWith
		  (vlax-ename->vla-object (cadr x))
		  0
		)
	      )
	    )
	   (bv:matches
	     (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
	   )
   )
   )
 )
)

 

Codes des routines associées:

;; Transforme une liste de coordonnées en liste de point
;; Argument: Une liste du type (x1 y1 z1 x2 y2 z2 x3 y3 z3 ...)
;; Retourne: Une liste du type ((x1 y1 z1) (x2 y2 z2) (x3 y3 z3) ...)
;;                        soit (p1 p2 p3 ...)
;; Exemples :
;;   (bv:xyz->Pt '(x1 y1 z1 x2 y2 z2)) -> ((X1 Y1 Z1) (X2 Y2 Z2))
;;   (bv:xyz->Pt '(x1 y1 z1)) -> ((X1 Y1 Z1))

(defun bv:xyz->Pt (L)
 (if L
   (cons (list (car L) (cadr L) (caddr L))
  (bv:xyz->Pt (cdddr L))
   )
 )
)

;; matches (renvoie les combinaisons 2 à 2 sans répétition). 
;; Argument: Une liste du type (A B C D)
;; Retourne: Une liste du type ((A B) (A C) (A D) (B C) (B D) (C D))

(defun bv:matches (L)
 (if (cdr L)
   (append (mapcar '(lambda (x) (list (car L) x)) (cdr L))
    (bv:matches (cdr L))
   )
 )
)

;; Extrait du fichier Listes.lsp
;; REMOVE_DOUBLES - Auteur (gile)
;; Suprime tous les doublons d'une liste

(defun remove_doubles (lst)
 (if lst
   (cons (car lst) (remove_doubles (vl-remove (car lst) lst)))
 )
)

 

 

Eventuellement pour tester

(bv:ListInters (ssget))

[Patrick_35]

Salut

 

Jolie routine

J'ajoute mon grain de sel pour utiliser activeselectionset et éviter ainsi les conversions du type vlax-ename->vla-object, ssnamex

 

(defun bv:ListInters (ss / lst obj sel)
 (vlax-for obj (setq sel (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
   (setq lst (cons obj lst))
 )
 (vla-delete sel)
 (remove_doubles
   (apply 'append
          (mapcar '(lambda (x)
                     (bv:xyz->Pt
                       (vlax-invoke
                         (car x)
                         'IntersectWith
                         (cadr x)
                         0
                       )
                     )
                   )
                  (bv:matches
                    lst
                  )
          )
   )
 )
)

 

@+

[VDH-Bruno]

Bonsoir Patrick_35,

 

J'ajoute mon grain de sel pour utiliser activeselectionset

 

Comme toujours j’en suis très heureux, pour activeselectionset tu m’en apprends, merci et je vais analyser tous cela avec intérêt.

 

Si cette année je me suis construit de bonnes bases en Lisp pur, en Visual Lisp je débute tout juste.. Et avec la nouvelle version de ce forum difficile de retrouver les anciens messages que j’avais repéré, notamment 2 ou 3 posts bien explicite pour se lancer avec ActiveX (sujet datant de 2006 ou 2007 dont tu étais l’auteur il me semble…).

 

A+

[Tramber]

bv:matches est bien pratique pour cet outil.

Je pense toujours à cet outil : Qbrick.

Pas difficile à programmer avec bv:matches B)

[VDH-Bruno]

Salut Tramber

 

Pas difficile à programmer avec bv:matches

 

Pour bv :matches (et pour la petite histoire) c’est la première fonction récursive que j’ai écrite, il y a presqu’ 1 an… (je me souviens, j’étais tout fier :D ).

 

Tu trouveras ici sur le site du zéro, l’algorithme dont je m’étais inspiré à l’époque.

 

Pour Qbrick il existe certainement beaucoup de fonctions dont je n’ai pas encore connaissance car je ne vois pas le moyen de réaliser cela facilement..

 

A+ Bruno

(Ps : Félicitations et bon courage pour ton investissement dans la modération du forum)

[Tramber]

Pour Qbrick il existe certainement beaucoup de fonctions dont je n’ai pas encore connaissance car je ne vois pas le moyen de réaliser cela facilement..

(Ps : Félicitations et bon courage pour ton investissement dans la modération du forum)

 

Ah bon ? De nature optimiste je me suis mis à penser qu'il n'y avait plus qu'un pas !

Avec les lignes, les arcs et les polys c'est assez facile, on peut se passer de la commande break. Sinon, il suffit de la passer en COMMAND autant de fois que nécessaire avec tous les points et là dessus un catch-error.

Enfin bref, avec ta jolie formule l'essentiel serait fait.

 

Tu es bien gentil pour le soutien à la modération mais il n'y a que peu de mérite je pense. Demande à ceux qui le font depuis longtemps....

[VDH-Bruno]

Nouvelle version encore merci à Patrick_35 pour son activeselectionset, plus ajout d'un contrôle en cas de sélection vide.

 

 

;; -----------------------------------------------------------------------------
;; Liste toutes les intersections présentent dans le jeu de sélection
;; (Avec suppression des points en doublons)
;; -----------------------------------------------------------------------------
;; Argument: Un jeu de sélection du type <Selection set: 2a>
;; Retourne: Une liste de point du type ((x1 y1 z1) (x2 y2 z2) (x3 y3 z3) ...)
 (defun bv:ListInters (ss / lst)
   (cond
     (ss
      (vlax-for obj (vla-get-activeselectionset
	       (vla-get-activedocument (vlax-get-acad-object))
	     )
 (setq lst (cons obj lst))
      )
      (remove_doubles
 (apply
   'append
   (mapcar '(lambda (x)
	      (bv:xyz->Pt
		(vlax-invoke (car x) 'IntersectWith (cadr x) 0)
	      )
	    )
	   (bv:matches lst)
   )
 )
      )
     )
   )
 )

[Patrick_35]

Juste une petite chose, n'oublie pas d'effacer le jeu de sélection car après plusieurs appel à activeselectionset, ben le lisp plante. Pourquoi ? Je n'en sais rien. La seule parade que j'ai trouvé et donc de d'effacer systématiquement le jeu de sélection

 

@+

[VDH-Bruno]

Salut,

 

Juste une petite chose, n'oublie pas d'effacer le jeu de sélection car après plusieurs appel à activeselectionset, ben le lisp plante. Pourquoi ? Je n'en sais rien. La seule parade que j'ai trouvé et donc de d'effacer systématiquement le jeu de sélection

 

@+

 

Etrange je m’explique mieux l’introduction de ta variable sel, ce que tu dis défi mon entendement , j’essaierai de reproduire ce que tu décris pour me faire une idée.. En espérant que l’aventure Automation ActiveX ne soit pas qu’une suite de phénomène inexpliqué..

 

A+ et merci

[VDH-Bruno]

Re Patrick_35,

 

J'ai essayé ce que tu m'as dit, je n'ai pas réussi à reproduire ce que tu m'a décris. La fonction semble stable.

 

Pour tester:

(repeat 1000  (princ "\n")(princ (bv:ListInters T)))

 

ou

 

(repeat	1000
 (vla-get-activeselectionset
   (vla-get-activedocument (vlax-get-acad-object))
 )
)

A suivre...

[Patrick_35]

je m’explique mieux l’introduction de ta variable sel

En règle générale, rien n'est gratuit en ce bas monde ;)

 

ce que tu dis défi mon entendement

On est deux alors.

 

En espérant que l’aventure Automation ActiveX ne soit pas qu’une suite de phénomène inexpliqué..

Non, bien au contraire. Tu entres dans la cour "des grands" avec des possibilités :D

J'avais par exemple réussi à envoyer des messages avec des expéditeurs farfelus (juste pour le fun), faire parler notre totocad, etc...

 

@+

[Patrick_35]

Re Patrick_35,

 

J'ai essayé ce que tu m'as dit, je n'ai pas réussi à reproduire ce que tu m'a décris. La fonction semble stable.

 

Pour tester:

(repeat 1000  (princ "\n")(princ (bv:ListInters T)))

 

ou

 

(repeat	1000
 (vla-get-activeselectionset
   (vla-get-activedocument (vlax-get-acad-object))
 )
)

A suivre...

Au début, je faisais comme toi, j'utilisais dans mes lisps activeselectionset sans faire appel au vla-delete, et régulièrement, j'avais un message d'erreur sur activeselectionset.

Etant puriste de nature, j’ai cherché à comprendre pourquoi ça plantait. :angry:

Je fermais le dessin, relançais ma fonction et tout fonctionnait. :huh:

Prenant mon courage a deux mains, j’ai testé jusqu'au moment ou le message d'erreur réapparaissait. <_<

J'ai testé plusieurs solutions et seul le vla-delete m'a réglé définitivement ce problème et permis de relancer ma fonction B)

Le pourquoi du comment ? Une plage mémoire pour la sélection de saturé alors qu’avec un simple ssget tout fonctionne sans aucune restriction ? :blink:

Un bug dans les méandres d’autocad ? :mellow:

Mystère

 

@+

[VDH-Bruno]

Prenant mon courage a deux mains, j’ai testé jusqu'au moment ou le message d'erreur réapparaissait.

J'ai testé plusieurs solutions et seul le vla-delete m'a réglé définitivement ce problème et permis de relancer ma fonction

Le pourquoi du comment ? Une plage mémoire pour la sélection de saturé alors qu’avec un simple ssget tout fonctionne sans aucune restriction ?

Un bug dans les méandres d’autocad ?

Mystère.

Pour info j'ai toujours pas réussi à faire planter le Lisp..;) (testé sur une version 2007 du Boulot)

 

Non, bien au contraire. Tu entres dans la cour "des grands" avec des possibilités

Ouais mais pour l'instant je vais y entréer timidement dans la cour des grands, car un heureux événement récent me raccourci les nuits et j'avoue ne plus récupérer aussi bien qu'avant :D

 

A+

[Patrick_35]

Ouais mais pour l'instant je vais y entréer timidement dans la cour des grands, car un heureux événement récent me raccourci les nuits et j'avoue ne plus récupérer aussi bien qu'avant :D

Il n'y a pas photo :D

Que du bonheur, même si on a du mal à remettre les yeux en face des trous.

Toutes mes félicitations.

 

@+