zoom sur bloc sans la commande zoom objet !!

[Matt666]

Aille...

Bonjour à tous !!

 

J'ai (encore) un problème.. Si, si.

Je cherche désespérément à faire un lisp qui, en entrant le handle graphique d'une entité, zoome sur celle-ci. Seulement voilà : Ces entités sont soit des blocs, soit des polylignes...

 

Pour les polylignes, pas (trop) de problème, il faut trouver le coin inférieur gauche et le coin supérieur droit, pour faire un zoom fenêtre. Bon mon code est (très très) loin d'être concis mais ça a le mérite de fonctionner..

(setq lis10 '() a (entget (car (entsel))))
    (foreach pt a (if (eq (car pt) 10) (setq lis10 (cons pt lis10))))
    (setq 
         lis10 (reverse lis10) 
         minlisx (car (cdr (assoc 10 lis10)))
         minlisy (cadr (cdr (assoc 10 lis10)))
         minlisz (caddr (cdr (assoc 10 lis10)))
         maxlisx minlisx
         maxlisy minlisy
         maxlisz minlisz
    )
    (foreach pt lis10 
         (if (< (cadr pt) minlisx)(setq minlisx (cadr pt)))
         (if (> (cadr pt) maxlisx)(setq maxlisx (cadr pt)))
         (if (< (caddr pt) minlisy)(setq minlisy (caddr pt)))
         (if (> (caddr pt) maxlisy)(setq maxlisy (caddr pt)))
         (if (< (cadddr pt) minlisz)(setq minlisz (cadddr pt)))
         (if (> (cadddr pt) maxlisz)(setq maxlisz (cadddr pt)))
    )
    (setq minlis (list minlisx minlisy minlisz))
    (setq maxlis (list maxlisx maxlisy maxlisz))

On ne rit pas dans le fond; merci ...

Ca, c'est un beau merdier.

 

Par contre pour les blocs, ça se complique ! Comment fait-on pour trouver l'encombrement du bloc !?! Même le point d'insertion ne sert pas...

Comme on dit par ici, c'est la merde Thierry. (Désolé pour les Thierry...)

 

Et pour couronner le tout, je n'utilise pas AutoCAD, mais bricsCAD, qui évidemment ne fournit pas l'outil de zoom objet. Bing. Fichtre !

 

Pour ceux qui seraient tentés d'utiliser des VL trucs, non plus ! Chez BricsCAD ils n'aiment que la pureté et la beauté de l'autolisp (sigh). :cool:

 

Voilà pour les bases...

 

Récapitulons : Faire un zoom sur un bloc après l'avoir sélectionné !

 

Messieurs, à vos claviers !

Et surtout merci d'avance...

Je le connais ce site, les gens dedans, ils trouvent tout !

Désolé, c'est vendredi.

 

A bientot !

Matt.

[(gile)]

Salut,

 

Je me suis penché sur la question en Visual LISP ici, en pur AutoLISP, le problème est ardu, il n'existe pas de fonction équivalente à vla-getBoundingBox excepté pour les textes (textbox).

 

Il faudrait donc pour un bloc créer une fonction équivalente pour chaque entité suceptible d'être contenue dans un bloc. c'est assez facile pour les lignes, polyligne sans arcs en récupérant leurs sommets, plus délicat pour les arcs cercles et ellipses, carrément complexe pour les splines.

 

Sinon, à partir de ptlst, une liste de points (sommets de lignes ou polylignes sans arcs) pour trouver les coordonnées minimales et maximales, tu peux utiliser les expressions suivantes, attribuées à Tony Tanzillo ou Doug Wilson (?):

 

(setq minpt (apply 'mapcar (cons 'min ptlst)))
(setq maxpt (apply 'mapcar (cons 'max plst))) 

[Matt666]

Ah... C'est vrai qu'un vieux "insterbox" serait des plus pratiques !!

 

Bon bah c'est po grave, je vais demander au développeur de se demerder pour me trouver les coordonnées de l'encombrement du bloc en VB..

 

Il va être content, vu qu'il aime bien comparer le VB et le lisp !!

 

Merci pour les petites (minuscules !!) expressions pour trouver les coordonnées min et max d'une pline, c'est cool !!!

 

Vache j'ai vachement de boulot pour arriver à ce niveau de concision !!!

 

merci encore, et bon Week-end !

 

A bientot.

Matt.

[Matt666]

c'est assez facile pour les lignes, polyligne sans arcs en récupérant leurs sommets,

 

J'avais essayé de trouver une routine qui permettait de dire si un point était à l'intérieur d'une polyligne ou pas, d'après un problème que tu avais posé dans un des nombreux forum de ce site...

 

J'étais arrivé à la conclusion que l'on ne pouvait rien faire en autolisp lorsqu'on a une polyligne avec des arcs. La routine récupérait les sommets de la polyligne , et créait une sélection polygonale (ssget "cp"...) sans recréer les arcs, evidemment. Alors oui je vois bien ce que tu veux dire quand tu parles du problème d'encombrement des arcs et cercles...

 

Je suis en train de me familiariser avec les mapcar et autres lambda ! c'est génial !!! :D plus besoin de foreach, et c'est beaucoup plus rapide..

 

Merci de me donner des pistes d'amélioration de code comme ça !

 

A bientot.

Matt.

[(gile)]

J'étais arrivé à la conclusion que l'on ne pouvait rien faire en autolisp lorsqu'on a une polyligne avec des arcs

 

Voici un exemple de ce qu'on peut faire en pur AutoLISP, c'est moins simple qu'avec les fonctions vlax-curve... mais en récupérant le "bulge" (courbure de l'arc ; code de groupe DXF 42) on peut placer des points tout le long de l'arc.

 

;; Pline2Points
;; Retourne une liste de points (coordonnées SCU courant) situés sur une polyligne
;; Les polyarcs sont divisés en fonction de leur courbure.

(defun Pline2Points (pline / bulge2arc elst elv norm dlst blst prec ang n
	   plst)

 ;; bulge2arcdata
 ;; Retourne la liste des données d'un "polyarc"
 ;; (centre, rayon, angle de départ, angle total)
 (defun bulge2arcdata (bulg start end / ang cen rad)
   (setq ang (* 2 (atan bulg)))
   (setq rad (/ (distance start end) (* 2 (sin ang)))
  cen (polar start
	     (+	(angle start end)
		(- (/ pi 2) ang)
	     )
	     rad
      )
   )
   (list cen rad (angle cen start) (* ang 2))
 )

 (setq	elst (entget pline)
elv  (cdr (assoc 38 elst))
norm (cdr (assoc 210 elst))
dlst (remove-if-not
       '(lambda (x) (or (= (car x) 10) (= (car x) 42)))
       elst
     )
 )
 (if (= 1 (logand 1 (cdr (assoc 70 elst))))
   (setq dlst (append dlst (list (assoc 10 elst))))
 )
 (while (caddr dlst)
   (setq plst (cons (cdar dlst) plst))
   (if	(/= 0.0 (cdadr dlst))
     (progn
(setq blst (bulge2arcdata (cdadr dlst) (cdar dlst) (cdaddr dlst))
      prec (1+ (fix (* 25 (sqrt (abs (cdadr dlst))))))
      ang  (/ (cadddr blst) prec)
      n	   0
)
(repeat	(1- prec)
  (setq
    plst (cons (polar (car blst)
		      (if (minusp (cdadr dlst))
			(+ pi (caddr blst) (* ang (setq n (1+ n))))
			(+ (caddr blst) (* ang (setq n (1+ n))))
		      )
		      (cadr blst)
	       )
	       plst
	 )
  )
)
     )
   )
   (setq dlst (cddr dlst))
 )
 (mapcar '(lambda (x)
	    (trans (list (car x) (cadr x) elv) norm 1)
	  )
	 (reverse (cons (cdar dlst) plst))
 )
)

;;; REMOVE-IF-NOT (vl-remove-if-not)
;;; Conserve les éléments d'une liste qui retournent T à
;;; l'exécution d'une fonction test
;;; (remove-if-not 'numberp '(0 (0 1) "str" 0.0)) -> (0 0.0)

(defun remove-if-not (fun lst)
 (apply 'append
 (mapcar '(lambda (e)
	    (if	(apply fun (list e))
	      (list e)
	    )
	  )
	 lst
 )
 )
)

 

 

Exemples d'utilisation sélection à l'aide d'unr polyligne

 

;; SelByPline
;; Crée un jeu de sélection avec tous les objets contenus ou  capturés,
;; dans la vue courante, par une polyligne fermée.
;; Arguments :
;; - pline : une polyligne fermée
;; - opt : un mode de sélection (Cp ou Wp)
;; - fltr : un filtre de sélection (liste) ou nil

(defun SelByPline (pline opt fltr)
 (ssget (strcat "_" opt) (Pline2Points pline) fltr)
 )
;; SSOC pour sélectionner tous les objets capturés, suivant
;; la vue, par le cercle, l'ellipse ou la polyligne.

(defun c:ssoc (/ ss ent opt)
 (and
   (or
     (and
(setq ss (cadr (ssgetfirst)))
(= 1 (sslength ss))
(setq ent (ssname ss 0))
(= "LWPOLYLINE" (cdr (assoc 0 (entget ent))))
(= 1 (logand 1 (cdr (assoc 70 (entget ent)))))
     )
     (and
(sssetfirst nil nil)
(setq ss (ssget	"_:S:E"
		'((0 . "LWPOLYLINE")
		  (-4 . "&")
		  (70 . 1)
		 )
	 )
)
(setq ent (ssname ss 0))
     )
   )
   (sssetfirst
     nil
     (ssdel ent (SelByPline ent "Cp" nil))
   )
 )
 (princ)
)

;; SSOF pour sélectionner tous les objets contenus, suivant
;; la vue, dans le cercle, l'ellipse ou la polyligne.

(defun c:ssof (/ ss ent opt)
 (and
   (or
     (and
(setq ss (cadr (ssgetfirst)))
(= 1 (sslength ss))
(setq ent (ssname ss 0))
(= "LWPOLYLINE" (cdr (assoc 0 (entget ent))))
(= 1 (logand 1 (cdr (assoc 70 (entget ent)))))
     )
     (and
(sssetfirst nil nil)
(setq ss (ssget	"_:S:E"
		'((0 . "LWPOLYLINE")
		  (-4 . "&")
		  (70 . 1)
		 )
	 )
)
(setq ent (ssname ss 0))
     )
   )
   (sssetfirst
     nil
     (SelByPline (ssname ss 0) "Wp" nil)
   )
 )
 (princ)
) 

 

 

zoom objet sur une polyligne

 

;; ZPL Effectue un "zoom objet" sur la polyligne sélectionnée

(defun c:zpl (/ pline plst)
 (and
   (setq pline (car (entsel "\nSélectionnez une polyligne: ")))
   (= "LWPOLYLINE" (cdr (assoc 0 (entget pline))))
   (setq plst (pline2points pline))
   (command "_zoom"
     "_w"
     (apply 'mapcar (cons 'min plst))
     (apply 'mapcar (cons 'max plst))
   )
 )
 (princ)
) 

 

[Edité le 19/8/2007 par (gile)]

[Matt666]

Et bing !!

Il est très fort ce Gile !!

Eh bien... Le code DXF 42 ! Connaissais pas celui là..

 

Vachement pratique ce SelByPline ! Merci ! J'avais fait un truc similaire, mais là il prend en compte les arcs... Vraiment fort...

 

Bon je vais me coucher, demain je me penche sur ce code !

 

Merci encore !

Matt.

[(gile)]

J'ai modifié la manière de faire : une routine (pline2polints) retourne la liste de points qui peut être utilisée ensuite pour une sélection un zoom...

 

PS : la courbure (bulge) correspond à la tangente du quart de l'angle de l'arc, autrement dit, la flèche divisée par la demi corde.

[(gile)]

J'ai fait l'équivalent de Pline2Points pour les ellipses : Ellipse2Points.

Je n'ai pas réussi à éviter l'utilisation d'une matrice pour la rotation.

 

;; Ellipse2Points
;; Retourne une liste de 51 points (coordonnées SCU courant) situés sur une ellipse

(defun ellipse2points (el	/	 elst	  norm	   cen	    majax
	       minax	stratang startpar incang   matrix   plst
	      )
 (setq	elst	 (entget el)
norm	 (cdr (assoc 210 elst))
cen	 (trans (cdr (assoc 10 elst)) 0 norm)
majax	 (distance '(0 0 0) (cdr (assoc 11 elst)))
minax	 (* majax (cdr (assoc 40 elst)))
startang (angle '(0 0 0) (trans (cdr (assoc 11 elst)) 0 norm))
startpar (cdr (assoc 41 elst))
incang	 (/ (- (cdr (assoc 42 elst)) startpar) 50)
matrix	 (list (list (cos startang) (- (sin startang)) 0)
	       (list (sin startang) (cos startang) 0)
	       '(0 0 1)
	 )
 )
 (repeat (setq n 51)
   (setq n    (1- n)
  plst (cons
	 (trans
	   (mapcar '+
		   cen
		   (mxv	matrix
			(list (* majax (cos (+ startpar (* n incang))))
			      (* minax (sin (+ startpar (* n incang))))
			      0.0
			)
		   )
	   )
	   norm
	   1
	 )
	 plst
       )
   )
 )
)

;; Applique une matrice de transformation à un vecteur (Vladimir Nesterovsky)
(defun mxv (m v)
 (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)
) 

[Matt666]

Ok... Tu as réussi à créer une méthode de sélection à partir d'une spline.... Bon bah cool !!! Merci pour tout ce travail :D !!

 

Quel est le problème pour la matrice ? Lenteur ?

 

Je vois pas le problème...

 

Je teste ça dès que je retourne au boulot !

 

Merci pour tout.

Matt.

[(gile)]

Quel est le problème pour la matrice ? Lenteur ?

 

Non, pas du tout, les calculs vectoriels/matriciels son rapides, c'est juste que ça n'est pas forcément très facile à comprendre.

Je te laisse le soin, si tu veux, de faire les équivalents pour les cercles et les arcs (plus facile).

[Matt666]

Salut Gile !

Désolé pour le retard, j'étais en vacances !

 

D'accord pour les calculs vectoriels... J'essaierai de m'y mettre...

 

Je vais tenter de faire les équivalents que tu dis en fonction de ton code...

 

J'ai encore une question... Je ne comprend pas très bien comment fonctionne le code que tu as donné un peu plus haut :

 
(setq minpt (apply 'mapcar (cons 'min ptlst)))
(setq maxpt (apply 'mapcar (cons 'max plst)))

 

C'est parce que je ne connais pas encore bien les fonctions mapcar et apply...

 

Bref je te remercie, et à biretot !

Matt.

[(gile)]

J'ai encore une question... Je ne comprend pas très bien comment fonctionne le code que tu as donné un peu plus haut :

 
(setq minpt (apply 'mapcar (cons 'min ptlst)))
(setq maxpt (apply 'mapcar (cons 'max plst)))

 

C'est parce que je ne connais pas encore bien les fonctions mapcar et apply...

 

Ce n'est pas très étonnant, ces expressions ne sont pas évidentes à comprendre mais elles sont, à mon avis, un des plus beaux exemples de la puissance du LISP dans le traitement des listes.

 

On va essayer de décortiquer ça.

Tout d'abord, un petit retour sur deux fonctions LISP majeures dans le traitement des listes : mapcar et apply.

 

mapcar fait passer tous les éléments d'une ou de plusieurs listes comme argument à une fonction et retourne une liste (de son côté foreach qui peut parfois être utilisé pour le même usage retourne le résultat de l'évaluation de la dernière expression).

Voir ici une explication plus détaillée sur mapcar et plus bas dans le même sujet, son utilisation avec lambda.

 

Ce qui nous intéresse ici, c'est de passer plusieurs listes comme arguments à la fonction mapcar.

 

Par exemple :

(mapcar 'min '(1 5 3) '(6 2 8) '(4 7 0))

équivaut à :

(list (min '(1 6 4)) (min '(5 2 7)) (min '(3 8 0))) >> (list 1 2 0) >> (1 2 0)

 

 

apply applique une fonction à une liste.

Tout comme mapcar, la fonction peut être une fonction LISP prédéfinie, une fonction "defun" (routine) ou une fonction lambda.

 

Exemple :

(apply '+ '(1 2 3)) 

 

applique la fonction + à la liste (1 2 3) ce qui équivaut à faire:

(eval (cons '+ '(1 2 3))) 

 

Si on "décomposait" l'évaluation depuis l'expression la plus imbriquée, comme le fait l'interpréteur, on aurait :

(eval (cons '+ '(1 2 3))) >> (eval '(+ 1 2 3)) >> (+ 1 2 3) >> 6

 

 

En LISP, le moyen utilisé pour faire passer un nombre indéterminé d'arguments à une fonction, est de grouper ces arguments dans une liste, laquelle liste sera passée comme argument à la fonction.

Les expressions (apply 'mapcar (cons ...) vont permettre de faire passer à mapcar un nombre indéterminé de listes comme arguments.

 

Si on "décomposait" l'évaluation de l'expression (apply 'mapcar (cons 'min ptlst)) où ptlst serait la liste de points (p1 p2 p3 ... pn), on aurait :

(apply 'mapcar (cons 'min ptlst))

>> (apply 'mapcar (cons 'min '(p1 p2 p3 ... pn)))

>> (apply 'mapcar '(min p1 p2 p3 ... pn)))

>> (mapcar 'min p1 p2 p3 ... pn)

 

Dans le même registre, avec par exemple :

(setq ptlst (list '(1 2 3) '(4 5 6) '(7 8 9)))

 

On peut faire la somme vectorielle d'une liste de vecteurs (ou points) :

(apply 'mapcar (cons '+ ptlst)) >> (12 15 18)

 

On peut transposer une matrice (Doug Wilson)

(apply 'mapcar (cons 'list ptlst)) >> ((1 4 7) (2 5 8) (3 6 9))

 

[Edité le 31/8/2007 par (gile)]

[Matt666]

Dément... Simplement dément !! Tout s'éclaire !! Merci Gile !

 

Elle est géniale cette explication... Le mini bout de code aussi d'ailleurs...

 

Merci, vraiment ! Décidément, que ferait ce forum lisp sans toi et Patrick_35 !! Impressionnant...

 

Je tente d'incorporer tout ça dans l'écriture des lisps !

A bientot !

Matt.

[Matt666]

Gile, tu pourrais donner ta solution de sélection par polyigne dans ce post !

C'est un peu vieux mais ça peut toujours servir...

A bientot.

Matt.

[(gile)]

Je l'avais fait (ici).

[Matt666]

Ah ok pardon !

J'avais pas vu...

 

A+ !

Matt.