MATRIX

[(gile)]

Je ne vais pas faire un cours sur les matrices, j'en serais bien incapable (j'ai quand même essayé de faire un petit topo -CF Réponse N°3 de ce fil).

 

Je me suis un peu penché sur l'utilsation de (vla-TransformBy ...) et donc des matrices de transformation.

 

Cette méthode est utile pour transformer des objets d'un système de coordonnées vers un autre et aussi pour appliquer des fonctions de rotation, de déplacement et de changement d'échelle.

 

J'ai d'abord glané sur le net deux routines de Doug C. Broad, Jr qui retournent les matrices de transformation du SCU courant vers le SCG et inversement (je m'en sert dans ce LISP).

 

;; Doug C. Broad, Jr.
;; can be used with vla-transformby to
;; [b]UCS2WCSMatrix[/b] transform objects from the UCS to the WCS
(defun UCS2WCSMatrix ()
 (vlax-tmatrix
   (append
     (mapcar
'(lambda (vector origin)
   (append (trans vector 1 0 T) (list origin))
 )
(list '(1 0 0) '(0 1 0) '(0 0 1))
(trans '(0 0 0) 0 1)
     )
     (list '(0 0 0 1))
   )
 )
)

;; [b]WCS2UCSMatrix[/b] transform objects from the WCS to the UCS
(defun WCS2UCSMatrix ()
 (vlax-tmatrix
   (append
     (mapcar
'(lambda (vector origin)
   (append (trans vector 0 1 T) (list origin))
 )
(list '(1 0 0) '(0 1 0) '(0 0 1))
(trans '(0 0 0) 1 0)
     )
     (list '(0 0 0 1))
   )
 )
) 

 

Pour transformer un vla-object du SCU courant vers le SCG, par exemple, on fait :

 

(vla-TransformBy obj (UCS2WCSMatrix))

 

 

J'ai aussi découvert deux petites mais puissantes routines de Vladimir Nesterovsky.

La première permet de transformer un vecteur à l'aide d'une matrice, la seconde de multiplier deux matrices, donc de les "combiner".

 

;; [b]mxv[/b] Apply a transformation matrix to a vector by Vladimir Nesterovsky
(defun mxv (m v)
 (mapcar '(lambda (row) (apply '+ (mapcar '* row v))) m)
)

;; [b]mxm[/b] Multiply two matrices by Vladimir Nesterovsky
(defun mxm (m q / qt)
 (setq qt (apply 'mapcar (cons 'list q)))
 (mapcar '(lambda (mrow) (mxv qt mrow)) m)
)

 

Je me suis donc essayé à définir quelques matrices de tranformation.

 

Avec des SCU "nommés" (enregistrés), la fonction (vla-GetUCSMatrix ...) permet de récupérer la matrice de transformation du SCG vers ce SCU (il faut juste s'assurer que le SCU est bien enregistré).

Avec les fonctions de Vladimir, on peut claculer la matrice de transformation inverse : ReverseMatrix (cette routine utilise butlast).

 

Edit : corrigé erreur dans ReverseMatrix (problème d'échelles) le 07/02/07

 

Edit : supprimé ReverseMatrix et remplacé par InverseMatrix

 

;;; [b]WCS2NamedUCSMatrix[/b] Retourne la matrice de transformation du SCG vers le SCU nommé [name]
(defun WCS2NamedUCSMatrix (name / ucs)
 (setq	ucs (vl-catch-all-apply
      'vla-Item
      (list
	(vla-get-UserCoordinateSystems
	  (vla-get-ActiveDocument (vlax-get-acad-object))
	)
	name
      )
    )
 )
 (if (not (vl-catch-all-error-p ucs))
   (vla-GetUCSMatrix ucs)
 )
)

;;; [b]butlast[/b] Retourne la liste privée du dernier élément
(defun butlast (lst)
 (reverse (cdr (reverse lst)))
)

;; IMAT
;; Crée une matrice d'identité de dimension n
;;
;; Argument
;; d : la dimension de la matrice

(defun Imat (d / i n r m)
 (setq i d)
 (while (    (setq n d r nil)
   (while (      (setq r (cons (if (= i n) 1.0 0.0) r))
   )
   (setq m (cons r m))
 )
)

;; INVERSEMATRIX
;; Inverse une matrice carrée (méthode Gauss-Jordan)
;;
;; Argument: la matrice
;; Retour : la matrice inverse ou nil (si non inversible)

(defun InverseMatrix (mat / col piv row res)
 (setq	mat (mapcar '(lambda (x1 x2) (append x1 x2)) mat (Imat (length mat))))
 (while mat
   (setq col (mapcar '(lambda (x) (abs (car x))) mat))
   (repeat (vl-position (apply 'max col) col)
     (setq mat (append (cdr mat) (list (car mat))))
   )
   (if	(equal (setq piv (caar mat)) 0.0 1e-14)
     (setq mat	nil
    res	nil
     )
     (setq piv	(/ 1.0 piv)
    row	(mapcar '(lambda (x) (* x piv)) (car mat))
    mat	(mapcar
	  '(lambda (r / e)
	     (setq e (car r))
	     (cdr (mapcar '(lambda (x n) (- x (* n e))) r row))
	   )
	  (cdr mat)
	)
    res	(cons
	  (cdr row)
	  (mapcar
	    '(lambda (r / e)
	       (setq e (car r))
	       (cdr (mapcar '(lambda (x n) (- x (* n e))) r row))
	     )
	    res
	  )
	)
     )
   )
 )
 (reverse res)
)

;;; [b]NamedUCS2WCSMatrix[/b] Retourne la matrice de transformation du SCU nommé [name] vers le SCG
(defun NamedUCS2WCSMatrix (name / mat)
 (if (setq mat (WCS2NamedUCSMatrix name))
    (InverseMatrix mat)
 )
)

 

Il est aussi possible, sans que le SCU ne soit actif ou nommé, de faire des transformations depuis ou vers un SCU "virtuel" défini par 3points (comme avec l'option "3points" de la commande SCU, les points devant être traduits dans le SCG)

NOTA : ces routines utilisent la fonction "NORM_3pts"

 

;;; [b]norm_3pts[/b] retourne le vecteur normal du plan défini par 3 points [org xdir ydir]
(defun norm_3pts (org xdir ydir / norm)
 (foreach v '(xdir ydir)
   (set v (mapcar '- (eval v) org))
 )
 (if (inters org xdir org ydir)
   (mapcar '(lambda (x) (* x (/ 1 (distance '(0 0 0) norm))))
    (setq norm (list (-	(* (cadr xdir) (caddr ydir))
			(* (caddr xdir) (cadr ydir))
		     )
		     (-	(* (caddr xdir) (car ydir))
			(* (car xdir) (caddr ydir))
		     )
		     (-	(* (car xdir) (cadr ydir))
			(* (cadr xdir) (car ydir))
		     )
	       )
    )
   )
 )
)

;;; [b]WCS23ptsMatrix[/b] Retourne la matrice de transformation du SCG vers un SCU 3points [org xdir ydir]
(defun WCS23ptsMatrix (org xdir ydir / lst zdir)
 (setq	lst
 (reverse
   (list
     (setq zdir (norm_3pts org xdir ydir))
     (norm_3pts org (mapcar '+ org zdir) xdir)
     (mapcar '(lambda (x y) (* (- x y) (/ 1 (distance org xdir))))
	     xdir
	     org
     )
   )
 )
 )
 (vlax-tmatrix
   (append
     (mapcar '(lambda (v1 v2) (append v1 (list v2)))
      (apply 'mapcar (cons 'list lst))
      org
     )
     (list '(0 0 0 1))
   )
 )
)

;;; [b]3pts2WCSMatrix[/b] Retourne la matrice de transformation d'un SCU 3points [org xdir ydir] vers le SCG
(defun 3pts2WCSMatrix (org xdir ydir / lst zdir)
 (setq	lst
 (reverse
   (list
     (setq zdir (norm_3pts org xdir ydir))
     (norm_3pts org (mapcar '+ org zdir) xdir)
     (mapcar '(lambda (x y) (* (- x y) (/ 1 (distance org xdir))))
	     xdir
	     org
     )
   )
 )
 )
 (vlax-tmatrix
   (append
     (mapcar '(lambda (v1 v2) (append v1 (list v2)))
      lst
      (mapcar '(lambda (x) (- (apply '+ (mapcar '* x org)))) lst)
     )
     (list '(0 0 0 1))
   )
 )
) 

 

Et grace à la fonction MXM de Vladimir on peut "combiner" plusieurs matrices entre elles, par exemple :

 

;;; [b]NamedUCS2NamedUCSMatrix[/b] Retourne la matrice de transformation d'un SCU nommé [from] vers un autre [to]
(defun NamedUCS2NamedUCSMatrix (from to)
 (vlax-tmatrix
   (mxm (vlax-safearray->list
   (vlax-variant-value (WCS2NamedUCSMatrix to))
 )
 (vlax-safearray->list
   (vlax-variant-value (NamedUCS2WCSMatrix from))
 )
   )
 )
)

;;; [b]UCS23pointsMatrix[/b] Retourne la matrice de transformation du SCU courant vers un SCU 3 points [org xdir ydir]
(defun UCS23pointsMatrix (org xdir ydir)
 (vlax-tmatrix
   (mxm (vlax-safearray->list
   (vlax-variant-value (WCS23ptsMatrix org xdir ydir))
 )
 (vlax-safearray->list
   (vlax-variant-value (UCS2WCSMatrix))
 )
   )
 )
)

 

À suivre ...[Edité le 15/8/2006 par (gile)][Edité le 16/8/2006 par (gile)][Edité le 7/2/2007 par (gile)]

[lecrabe]

Bonsoir

 

Que dire, que dire ! C'est magnifique ton travail Gilles ! :) :D :cool:

 

Dans un lointain passé (envion 20-30 ans) , on appelait des routines en Fortran avec passage en argument de tableaux pour justement faire des opérations matricielles ... :exclam:

 

On voit bien dans ces multiples exemples la PUISSANCE du Lisp !!! ;) :P

 

Le Decapode

 

 

[Edité le 15/8/2006 par lecrabe]

[(gile)]

Merci lecrabe, tu vas me faire rougir ! :red:

 

Je pense que la puissance du LISP réside surtout, dans le cas présent, dans sa capacité à manipuler les listes (et les listes de listes) qui servent à construire la matrice.

L'illustration pourrait en être cette expression, un bijou attribuée à Doug Wilson, qui transpose une matrice (sous forme de liste) :

 

(apply 'mapcar (cons 'list m))

 

Exemple ("matrice du pavé numérique") :

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

 

Tout ça me fait entrevoir que j'ai peut-être mis la charrue avant les boeufs, je n'ai pas expliqué, pour ceux qui ne le save pas (comme moi il y a peu), comment est structurée une matrice de transformation.

Ça fera partie du chapitre 2.

 

[Edité le 16/8/2006 par (gile)]

[(gile)]

Chapitre 2 (qui aurait du être le chapitre 1)

 

Petit rappel succinct sur les matrices.

 

Une matrice est un tableau de nombres, une matrice de dimension MxN comporte M rangées (ou lignes) et N colonnes.

 

Les matrices permettent de ramener à des opérations sur les nombres les fonctions linéaires (ex: rotation, translation, changement d'échelle), de la même façon qu'un système de coordonnées permet de ramener à des opérations sur les nombres les opérations vectorielles (addition/soustraction de vecteurs, multiplication scalaire, multiplication vectorielle).

 

Les matrices de tranformations utilisées en VisualLISP (ou en VBA), sous forme de variant, avec la méthode TransformBy sont des matrices carrées de dimension 4x4 se présentant sous la forme :

 

R00 R01 R02 T0

R10 R11 R12 T1

R20 R21 R22 T2

0 0 0 1

 

où R* représente une rotation (et/ou mise à l'échelle) et T* une translation.

 

R00 R01 R02 sont les coordonnées x y z du vecteur de transformation en échelle et rotation par rapport à l'axe des X du SCG, son sens et sa direction définissent la rotation et sa grandeur, l'échelle.

R10 R11 R12 définissent la même chose par rapport à l'axe des Y et R20 R21 R22 par rapport à l'axe Z.

 

T0 T1 T2 définissent le déplacement par rapport au 0 0 0 du SCG

 

Quant à la dernière ligne 0 0 0 1, je ne sais pas à quoi elle correspond, et serais très heureux de l'apprendre.

Sert-elle uniquement à faire en sorte que la matrice soit "carrée" ?

 

Quelques exemples :

 

La matrice ne définissant aucune transformation est donc :

 

1 0 0 0

0 1 0 0

0 0 1 0

0 0 0 1

 

La matrice définissant un déplacement (translation) de (0 0 0) vers (5 3 0) :

 

1 0 0 5

0 1 0 3

0 0 1 0

0 0 0 1

 

La matrice définissant un changement d'échelle uniforme de 1 à 5 :

 

5 0 0 0

0 5 0 0

0 0 5 0

0 0 0 1

 

La matrice définissant une rotation de 30° sur l'axe Z (rotation 2D) :

 

0.866 -0.5 0.0 0.0

0.5 0.866 0.0 0.0

0.0 0.0 1.0 0.0

0.0 0.0 0.0 1.0

 

En LISP, les matrices son représentées par une liste de listes où chaque élement contient les éléments d'une ligne (ou rangée) de la matrice.

Cette liste est transformée en variant avec la fonction (vlax-tmatrix ...) pour être passée comme argument de (vla-TransformBy ...).

Par exemple la matrice ci dessus s'écrit :

((0.866 -0.5 0.0 0.0) (0.5 0.866 0.0 0.0) (0.0 0.0 1.0 0.0) (0.0 0.0 0.0 1.0))

 

Exemples de matrices de transformation utlisables avec (vla-TransformBy ...)

 

Corrigé une erreur de signe dans YRotateMatrix le 07/10/06

 

;;; [b]ScaleMatrix[/b] Echelle (base scl)
(defun ScaleMatrix (base scl)
 (vlax-tmatrix
   (append
     (mapcar
'(lambda (v1 v2)
   (append (mapcar '(lambda (x) (* x scl)) v1)
	   (list v2)
   )
 )
(list '(1 0 0) '(0 1 0) '(0 0 1))
(mapcar '(lambda (x) (- x (* x scl))) base)
     )
     (list '(0 0 0 1))
   )
 )
)

;;; [b]MoveMatrix[/b] Déplacement (vec)
(defun MoveMatrix (dep)
 (vlax-tmatrix
   (append
     (mapcar
'(lambda (v1 v2)
   (append v1 (list v2))
 )
(list '(1 0 0) '(0 1 0) '(0 0 1))
dep
     )
     (list '(0 0 0 1))
   )
 )
)

;;; [b]ZRotateMatrix[/b] Rotation sur l'axe Z (base ang)
(defun ZRotateMatrix (base ang)
 (vlax-tmatrix
   (append
     (mapcar
'(lambda (v1 v2)
   (append v1 (list v2))
 )
(list (list (cos ang) (- (sin ang)) 0)
      (list (sin ang) (cos ang) 0)
      '(0 0 1)
)
(mapcar
  '-
  base
  (list	(* (cos (+ (atan (cadr base) (car base)) ang))
	   (distance '(0 0 0) (list (car base) (cadr base)))
	)
	(* (sin (+ (atan (cadr base) (car base)) ang))
	   (distance '(0 0 0) (list (car base) (cadr base)))
	)
	(caddr base)
  )
)
     )
     (list '(0 0 0 1))
   )
 )
)

;;; [b]XRotateMatrix[/b] Rotation sur l'axe X (base ang)
(defun XRotateMatrix (base ang)
 (vlax-tmatrix
   (append
     (mapcar
'(lambda (v1 v2)
   (append v1 (list v2))
 )
(list '(1 0 0)
      (list 0 (cos ang) (- (sin ang)))
      (list 0 (sin ang) (cos ang))
)
(mapcar	'-
	base
	(list
	  (car base)
	  (* (cos (+ (atan (caddr base) (cadr base)) ang))
	     (distance '(0 0 0) (list (cadr base) (caddr base)))
	  )
	  (* (sin (+ (atan (caddr base) (cadr base)) ang))
	     (distance '(0 0 0) (list (cadr base) (caddr base)))
	  )
	)
)
     )
     (list '(0 0 0 1))
   )
 )
)

;;; [b]YRotateMatrix[/b] Rotation sur l'axe Y (base ang)
(defun YRotateMatrix (base ang)
 (vlax-tmatrix
   (append
     (mapcar
'(lambda (v1 v2)
   (append v1 (list v2))
 )
(list (list (cos ang) 0 (sin ang))
      '(0 1 0)
      (list (- (sin ang)) 0 (cos ang))
)
(mapcar	'-
	base
	(list
	  (* (cos (+ (atan (caddr base) (car base)) ang))
	     (distance '(0 0 0) (list (car base) (caddr base)))
	  )
	  (cadr base)
	  (* (sin (+ (atan (caddr base) (car base)) ang))
	     (distance '(0 0 0) (list (car base) (caddr base)))
	  )
	)
)
     )
     (list '(0 0 0 1))
   )
 )
)

 

À suivre ?...[Edité le 16/8/2006 par (gile)]

 

[Edité le 7/10/2006 par (gile)]

[(gile)]

Une dernière petite couche.

 

NENTSEL vs NENTSELP

 

Les deux fonctions AutoLISP nentsel et nentselp retournent une matrice si l'objet sélectionné (une sous entité) appartient à une référence de bloc ou une référence externe.

Si l'objet sélectionné est lui même un bloc (ou une xref) imbriqué, la matrice retournée est la combinaison de la matrice de tranformation du bloc enfant dans le bloc parent (mat _enfant) et de la matrice de transformation du bloc parent dans le SCG (mat_parent), le résultat de l'expression :

 

(mxm mat_parent mat_enfant)

 

À noter toutefois, contrairement à celle retournée par NENTSELP, la matrice retourné par NENTSEL n'est pas au même format que les matrices ci-dessus, c'est une marice de dimension 4x3 qui est la transposition des 3 premières rangées des matrices utilisées avec (vlax-tmatrix ...) :

 

R00 R10 R20

R01 R11 R21

R02 R12 R22

T0 T1 T2

 

on retrouve une matrice semblable à celle retournée par NENTSELP en faisant :

 

(setq mat (caddr (nentsel)))
(append (apply 'mapcar (cons 'list mat)) (list '(0.0 0.0 0.0 1.0)))

 

Il est donc aisé de faire subir à un objet les mêmes transformations que celles d'un bloc sélectionné, à condition toutefois que les échelles en X, Y et Z soient uniformes :

 

(if (and
     (setq mat (caddr (nentselp "\nSélectionnez un bloc: ")))
     (setq obj (car (entsel "\nSélectionnez un objet: ")))
   )
 (vla-TransformBy
   (vlax-ename->vla-object obj)
   (vlax-tmatrix mat)
 )
)

[JUJUZAZA]

salut gile

 

et bien! pour moi, c'est bien trop complex tout cela .

 

:o

 

je remarque que le LISP c'est ton univers, donc je me permet de te demander si tu pouvais m'aider, moi qui ne connait que le B.A.-BA de ce language

 

ma demande et la suivante:

comment remplir 1 BLOC ayant ++ ATTRIBUTS sous AutoCad, à partir d’1 fichier EXCEL .

 

je crois te l'avoir demandé, cette question, je ne me souvient pas, mais bon!!!

 

Voir sujet:

Accueil du Forum > LISP et Visual LISP > Débuter en LISP > Excel vers ------------------>> AutoCad

 

merci

 

[Edité le 19/8/2006 par JUJUZAZA]

[(gile)]

Un sujet de discussion, ici, m'a donné une occasion d'utiliser les matrices de transformation.

 

La demande est de faire pivoter des blocs insérés dans le plan du SCG dans le pan de la vue courante (perspective) pour qu'il soient lisibles.

 

J'utilises ici la combinaison (avec mxm) de deux matrices, une pour changer de système de coordonnées (du SCG vers le plan dont la normale est VIEWDIR) et une de rotation (suivant l'angle -VIEWTWIST).

 

;; [b]WCS2View[/b] Pivote les objets texte ou bloc sélectionnés du SCG
;; dans le plan de la vue courante sur leurs points d'insertion
(defun c:WCS2View (/ ss obj ins dir ang mat)
 (vl-load-com)
 (vla-StartUndoMark
   (vla-get-ActiveDocument (vlax-get-acad-object))
 )
 (setq ss (ssget '((0 . "INSERT,*TEXT"))))
 (if ss
   (repeat (setq n (sslength ss))
     (setq obj	(vlax-ename->vla-object (ssname ss (setq n (1- n))))
    ins	(vlax-get obj 'InsertionPoint)
    dir	(mapcar	'-
		(trans (getvar "viewdir") 1 0)
		(trans '(0 0 0) 1 0)
	)
    ang	(- (getvar "viewtwist"))
    mat	(mxm
	  (mapcar '(lambda (x) (trans x 0 dir))
		  '((1 0 0) (0 1 0) (0 0 1))
	  )
	  (list	(list (cos ang) (- (sin ang)) 0)
		(list (sin ang) (cos ang) 0)
		'(0 0 1)
	  )
	)
     )
     (vla-TransformBy
obj
(vlax-tmatrix
  (append
    (mapcar
      '(lambda (v1 v2)
	 (append v1 (list v2))
       )
      mat
      (mapcar '- ins (mxv mat ins))
    )
    (list '(0 0 0 1))
  )
)
     )
   )
 )
 (vla-EndUndoMark
   (vla-get-ActiveDocument (vlax-get-acad-object))
 )
 (princ)
) 

 

Pour le processus inverse, depuis la même vue :

 

;; [b]View2WCS[/b] Pivote les objets texte ou bloc sélectionnés
;; du plan de la vue courante dans le SCG sur leurs points d'insertion
(defun c:View2WCS (/ ss obj ins dir ang mat)
 (vl-load-com)
 (vla-StartUndoMark
   (vla-get-ActiveDocument (vlax-get-acad-object))
 )
 (setq ss (ssget '((0 . "INSERT,*TEXT"))))
 (if ss
   (repeat (setq n (sslength ss))
     (setq obj	(vlax-ename->vla-object (ssname ss (setq n (1- n))))
    ins	(vlax-get obj 'InsertionPoint)
    dir	(mapcar	'-
		(trans (getvar "viewdir") 1 0)
		(trans '(0 0 0) 1 0)
	)
    ang	(getvar "viewtwist")
    mat	(mxm
	  (list	(list (cos ang) (- (sin ang)) 0)
		(list (sin ang) (cos ang) 0)
		'(0 0 1)
	  )
	  (mapcar '(lambda (x) (trans x dir 0))
		  '((1 0 0) (0 1 0) (0 0 1))
	  )
	)
     )
     (vla-TransformBy
obj
(vlax-tmatrix
  (append
    (mapcar
      '(lambda (v1 v2)
	 (append v1 (list v2))
       )
      mat
      (mapcar '- ins (mxv mat ins))
    )
    (list '(0 0 0 1))
  )
)
     )
   )
 )
 (vla-EndUndoMark
   (vla-get-ActiveDocument (vlax-get-acad-object))
 )
 (princ)
) 

 

À noter, l'ordre des matrices passées comme argument à mxm s'inverse, cette opération n'est pas "commutative".

 

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

[Patrick_35]

Salut

Belle démo qui rejoint celle donné par Kamal

 

@+

[(gile)]

Merci pour le lien Patrick_35,

 

Le sujet est très interessant.

 

À propos de la récupération de la matrice de transformation d'un bloc ou d'une xref, pour être sûr de récupérer la matrice de l'entité principale, et pas celle d'une sous entité retournée par nentselp, Joe Burke propose de reconstituer la matrice à partir des données/propriétés de l'entité principale.

 

[Edité le 21/8/2006 par (gile)]

[(gile)]

Suite à une réponse dans ce sujet, j'ai remarqué une erreur de signe dans la fonction YRotateMatrix.

 

Cette erreur est maintenant corrigée.

[(gile)]

Suite à une discussion sur TheSwamp à propos de la différence enre les SCO tel que définis par AutoCAD et de système de coordonnées à l'intérieur d'une référence de bloc ou d'une xref (souvent appelé aussi SCO ou OCS), j'ai fait deux petite routine pour traduire les coordonnées du SCR* vers le SCG et vice versa.

 

* SCR ou RCS pour Reference Coordinate System.

 

 

Edit : WCS2RCS dysfonctionnait avec les blocs dont les echelles sont différentes de 1.

C'est réparé (il me semble) avec un peu de calcul vectoriel.

 

Edit 2 : WCS2RCS dysfonctionnait avec les blocs ayant subi une rotation 3D et une échelle non uniforme, c'est réparé (il me semble) avec un peu de calcul matriciel.

 

EDIT 3 : WCS2RCS semble enfin fonctionner dans toutes les situations, les routines : InverseMatrix et Imat doivent être chargées (voir plus bas).

;;; VXV Retourne le produit scalaire (réel) de deux vecteurs
(defun vxv (v1 v2)
 (apply '+ (mapcar '* v1 v2))
)

;; Transpose une matrice Doug Wilson
(defun trp (m)
 (apply 'mapcar (cons 'list m))
)

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

;;; butlast Retourne la liste privée du dernier élément
(defun butlast (lst)
(reverse (cdr (reverse lst)))
)

;; RCS2WCS
;; Traduit les coordonnées du Système de Coordonnées Reference (bloc ou xref) vers le SCG
;;
;; Arguments :
;; pt : un point dans le RCS
;; mat : une matrice de transformation, retournée par (caddr (nentsel)) ou (caddr (nentselp))

(defun RCS2WCS (pt mat)
 (setq pt (trans pt 0 0))
 (if (= 3 (length (car mat)))
   (mapcar '+ (mxv (trp (butlast mat)) pt) (last mat))
   (mapcar '+
    (mxv (mapcar 'butlast (butlast mat)) pt)
    (butlast (mapcar 'last mat))
   )
 )
)

;; WCS2RCS
;; Traduit les coordonnées du SCG vers le Système de Coordonnées Reference (bloc ou xref)
;;
;; Arguments :
;; pt : un point dans le SCG
;; mat : une matrice de transformation, retournée par (caddr (nentsel)) ou (caddr (nentselp))

(defun WCS2RCS (pt mat)
 (setq pt (trans pt 0 0))
 (if (= 3 (length (car mat)))
   (setq mat (append (trp mat) (list '(0.0 0.0 0.0 1.0))))
 )
 (setq mat (InverseMatrix mat))
 (mapcar '+ (mxv mat pt) (butlast (mapcar 'last mat)))
)

[Edité le 15/11/2006 par (gile)][Edité le 21/11/2006 par (gile)][Edité le 20/4/2008 par (gile)]

[(gile)]

Bon c'était pas encore tout à fait au point, le résultat retourné par WCS2RCS était faux quand le bloc avait subi une (ou des) rotation(s) 3D et une échelle non uniforme sur les différents axes.

Ça semble maintenant fonctionner bans les cas les plus tordus.

[BIM G CO]

Ok pour les matrices! mais encore un challenge comment faire pour "inverser"

 

une matrice

X1 Y1 Z1

X2 Y2 Z2

X3 Y3 Z3

 

en une matrice dont les valeurs seront

X1 X2 X3

Y1 Y2 Y3

Z1 Z2 Z3

 

ceci utile pour l'utilisation DCL

 

(en vérité c'est plus pour une inversion du même genre sur des tableau 2D à nb1 rangée et nb2 colonne)

 

ce n'est rien que pour te compliquer la vie :D

 

Maximilien taquin! :D

 

 

[Edité le 30/11/2006 par Maximilien]

[(gile)]

Salut,

 

Excuse moi, je n'avais pas vu passer ton message

 

(apply 'mapcar (cons 'list '((X1 Y1 Z1) (X2 Y2 Z2) (X3 Y3 Z3)))) retourne ((X1 X2 X3) (Y1 Y2 Y3) (Z1 Z2 Z3))

 

C'est la routine trp attribuée à Doug Wilson

Elle est utilisée, par exemple, juste au dessus dans les routines RCS2WCS et WCS2RCS pour transposer les matrices retournées par nentsel ou nentselp.

 

;; transpose une matrice Doug Wilson
(defun trp (m)
 (apply 'mapcar (cons 'list m))
) 

 

[Edité le 4/12/2006 par (gile)]

[Didier-AD]

Chapitre 2 (qui aurait du être le chapitre 1)

 

Petit rappel succinct sur les matrices.

 

Une matrice est un tableau de nombres, une matrice de dimension MxN comporte M rangées (ou lignes) et N colonnes.

 

 

;;; [b]ScaleMatrix[/b] Echelle (base scl)
(defun ScaleMatrix (base scl)
 (vlax-tmatrix
   (append
     (mapcar
'(lambda (v1 v2)
   (append (mapcar '(lambda (x) (* x scl)) v1)
	   (list v2)
   )
 )
(list '(1 0 0) '(0 1 0) '(0 0 1))
(mapcar '(lambda (x) (- x (* x scl))) base)
     )
     (list '(0 0 0 1))
   )
 )
)

)

 

Encore une fois Merci Gile pour ta science

elle m'a permis , en utilisant tes routines de composer la matrice de transformation correspondant à un miroir (selon un axe dans le plan XY)

la voici

 
(defun XYMirrorMatrix (pm1 pm2 / m1 m2 m3)
 (setq m1 (vlax-safearray->list (vlax-variant-value  (ZrotateMatrix pm1 (* -1 (angle pm1 pm2)))))
m2 (vlax-safearray->list (vlax-variant-value  (XrotateMatrix pm1 pi)))
m3 (vlax-safearray->list (vlax-variant-value  (ZrotateMatrix pm1 (angle pm1 pm2))))
 )
 (vlax-tmatrix (mxm (mxm m3 m2) m1))
)  

le principe est simple ; combiner 3 rotations

la première pour amener la ligne miroir parallèle à l'axe des X (m1)

la seconde pour effectuer une rotation de pi (miroir) autour de l'axe des X (m2)

la troisième est une rotation inverse de la première.

Merci encore pour m'avoir mis le pied à l'étrier.

 

[(gile)]

:) Super, je suis content que tout ça soit utilisé et plus encore si le sujet est alimenté par de nouvelles fonctions.

 

Toutes les matrices que je donne ci dessus sont de la même forme que celles données par Doug C. Broad, Jr (UCS2WCSMatrix et WCS2UCSMatrix), et à l'usage cela s'avère peu pratique ; elles retournent des variants et pour les combiner il faut les retransformer en liste.

 

En supprimant le vlax-tmatrix au début de chaque defun on aurait des listes, plus commodes à utiliser avec MXM et MXV, et il suffirait de faire passer le résultat comme argument à vlax-tmatrix pour l'utiliser avec vla-transformby.

[(gile)]

Suite à une discussion sur TheSwamp, j'ai fait cette petite routine qui retourne la matrice de transformation d'une référence (bloc ou xref).

C'était le propos de Joe Burke (voir plus haut) mais sa routine ne fonctionne qu'en 2D.

 

Edit : Joe Burke a fait une nouvelle version de ObjMatrix (V2) qui fonctionne en 3D.

 

;; Multiplie deux matrices par Vladimir Nesterovsky
(defun mxm (m q)
 (mapcar '(lambda (r)
     (mapcar '(lambda (l) (apply '+ (mapcar '* l r)))
	     (apply 'mapcar (cons 'list q))
     )
   )
  m
 )
)

;; [b]Ename->4x4Matrix[/b] Retourne la matrice de transformation d'une référence (bloc ou xref)
;; La matrice est identique à celle retournée par (caddr (nentselp)) sur une entité de bloc
;; ou de xref non imbriquée.
;; Ex : Les trois expressions suivantes retournent le même résultat quelque soit l'entité
;; sélectionnée dans le bloc ou la xref
;; (Ename->4x4Matrix (last (last (nentselp))))
;; (Ename->4x4Matrix (last (last (nentsel))))
;; (Ename->4x4Matrix (car (entsel)))

(defun Ename->4x4Matrix (ename / entData ang norm)
 (setq	entData	(entget ename)
ang	(cdr (assoc 50 entData))
norm	(cdr (assoc 210 entData))
 )
 (append
   (mapcar
     '(lambda (v1 v2)
 (append v1 (list v2))
      )
     (mxm
(mapcar	'(lambda (v) (trans v 0 norm T))
	'((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
)
(mxm
  (list	(list (cos ang) (- (sin ang)) 0.0)
	(list (sin ang) (cos ang) 0.0)
	'(0.0 0.0 1.0)
  )
  (list	(list (cdr (assoc 41 elst)) 0.0 0.0)
	(list 0.0 (cdr (assoc 42 elst)) 0.0)
	(list 0.0 0.0 (cdr (assoc 43 elst)))
  )
)
     )
     (trans (cdr (assoc 10 elst)) norm 0)
   )
   (list '(0.0 0.0 0.0 1.0))
 )
)

[Edité le 7/2/2007 par (gile)]

 

[Edité le 9/2/2007 par (gile)]

[(gile)]

La matrice de transformation inverse : Ename->4x4ReverseMatrix

 

Le même résultat peut être obtenu en utilisant ReverseMatrix (voir plus haut version corrigée):

(Ename->4x4ReverseMatrix ename) retourne le même résultat que (ReverseMatrix (Ename->4x4Matrix ename))

 

 

(defun Ename->4x4ReverseMatrix (ename / entData ang norm mat)
 (setq	entData	(entget ename)
ang	(- (cdr (assoc 50 entData)))
norm	(cdr (assoc 210 entData))
 )
 (append
   (mapcar
     '(lambda (v1 v2)
 (append v1 (list v2))
      )
     (setq mat
     (mxm
       (list (list (/ 1 (cdr (assoc 41 entData))) 0.0 0.0)
	     (list 0.0 (/ 1 (cdr (assoc 42 entData))) 0.0)
	     (list 0.0 0.0 (/ 1 (cdr (assoc 43 entData))))
       )
       (mxm
	 (list (list (cos ang) (- (sin ang)) 0.0)
	       (list (sin ang) (cos ang) 0.0)
	       '(0.0 0.0 1.0)
	 )
	 (mapcar '(lambda (v) (trans v norm 0 T))
		 '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
	 )
       )
     )
     )
     (mapcar '-
      (mxv mat (trans (cdr (assoc 10 entData)) norm 0))
     )
   )
   (list '(0.0 0.0 0.0 1.0))
 )
) 

[(gile)]

Salut,

 

J'ai donné ici ur routine qui fonctionne un peu comme TransPt de Joe Burke, mais uniquement en AutoLISP (et plus concise)

 

En voici une autre qui retourne la matrice inverse d'une matrice 3X3.

Pour les matrices qui ne modifient pas l'échelle (tous les vecteurs de longueur 1) transposer la matrice donne la matrice inverse, la routine suivante fonctionne avec les matrice de transformation d'échelle même non uniforme.

 

;; INV-MAT Retourne la matrice de transformation (3X3) inverse

(defun inv-mat (mat / a b c d e f g h i det)
 (setq	a   (caar mat)
b   (cadar mat)
c   (caddar mat)
d   (caadr mat)
e   (cadadr mat)
f   (caddr (cadr mat))
g   (caaddr mat)
h   (cadr (caddr mat))
i   (caddr (caddr mat))
det (+ (* a e i)
       (* b f g)
       (* c d h)
       (- (* c e g))
       (- (* b d i))
       (- (* a f h))
    )
 )
 (if (/= 0 det)
   (mapcar
     (function
(lambda	(v)
  (mapcar
    (function
      (lambda (x) (* x (/ 1 det)))
    )
    v
  )
)
     )
     (list
(list (- (* e i) (* f h))
      (- (* c h) (* b i))
      (- (* b f) (* c e))
)
(list (- (* f g) (* d i))
      (- (* a i) (* c g))
      (- (* c d) (* a f))
)
(list (- (* d h) (* e g))
      (- (* b g) (* a h))
      (- (* a e) (* b d))
)
     )
   )
 )
) 

[(gile)]

Je pense avoir réussi à faire une routine polyvalente d'inversion des matrices carrées (quelque soit leur dimension)

L'algorithme étant relativement complexe (beaucoup de calculs), l'exécution de la routine est relativement lente.

 

;; REMOVE-I
;; Retourne la liste privée de l'élément à l'indice spécifié
;; (premier élément = 0)

(defun remove-i (ind lst)
 (if (or (zerop ind) (null lst))
   (cdr lst)
   (cons (car lst) (remove-i (1- ind) (cdr lst)))
 )
)

;; COFACT
;; Retourne le cofacteur associé à l'élément ij d'une matrice
;;
;; Arguments
;; i = indice de la ligne (première ligne = 1)
;; j = indice de la colonne (première colonne = 1)
;; m = une matrice

(defun cofact (i j m)
 (* (determ
      (remove-i
 (1- i)
 (mapcar (function (lambda (x) (remove-i (1- j) x))) m)
      )
    )
    (expt -1 (+ i j))
 )
)

;; DETERM
;; Retourne le déterminant d'une matrice carré
;;
;; Argument : une matrice

(defun determ (m)
 (if (= 2 (length m))
   (- (* (caar m) (cadadr m)) (* (caadr m) (cadar m)))
   ((lambda (r n)
      (apply '+
      (mapcar
	(function (lambda (x) (* x (cofact 1 (setq n (1+ n)) m))))
	r
      )
      )
    )
     (car m)
     0
   )
 )
)

;; ADJ-MAT
;; Retourne la matrice adjointe d'une matrice
;;
;; Argument : une matrice

(defun adj-mat (m / i)
 (setq i 0)
 (trp
   (mapcar
     (function
(lambda	(v / j)
  (setq	i (1+ i)
	j 0
  )
  (mapcar
    (function (lambda (x) (cofact i (setq j (1+ j)) m)))
    v
  )
)
     )
     m
   )
 )
)

;; INV-MAT
;; Retourne la matrice inverse d'une matrice
;;
;; Argument : une matrice

(defun inv-mat (m / d)
 (if (/= 0 (setq d (determ m)))
   (mapcar
     (function
(lambda	(v)
  (mapcar (function (lambda (x) (* (/ 1 d) x))) v)
)
     )
     (adj-mat m)
   )
 )
) 

 

[Edité le 20/4/2008 par (gile)]

[(gile)]

J'ai trouvé une méthode plus rapide, et plus polyvalente avec la "méthode de Gauss-Jordan".

Cette méthode permet aussi de résoudre n équations à n inconnues.

Exemple :

 

3x - 2y + z = 2

-x + 2y - 3z = 0

x - 3z = -2

 

on fait deux matrices ((3.0 -2.0 1.0) (-1.0 2.0 3.0) (1.0 0.0 -3.0)) et ((2.0) (0.0) (-2.0)) et on les passe comme arguments à la routine GaussJordan :

 

(GaussJordan '((3.0 -2.0 1.0) (-1.0 2.0 3.0) (1.0 0.0 -3.0)) '((2.0) (0.0) (-2.0))) retourne ((-0.2) (-1.0) (0.6))

 

soit x = -0.2, y = -1, z = 0.6, les résultats des équations.

 

Si on passe comme argument à cette fonction une matrice et la matrice identité de même dimension, le résultat est ma matrice inverse.

Cette routine est presque 6 fois plus rapide que la précédente sur une matrice de dimension 4 telle que celles retournées par nentselp.

 

EDIT : correction d'un bug (16/03/09) et optimisation

 

;; GaussJordan (gile)
;; Applique la méthode de Gauss-Jordan à deux matrices
;;
;; Arguments : 2 matrices

(defun GaussJordan (m1 m2 / len mat todo cnt row col piv new)
 (setq len (length m1))
 (if (= len (length m2))
   (progn
     (setq mat	(mapcar (function (lambda (x1 x2) (append x1 x2))) m1 m2)
    todo mat
    cnt	0
     )
     (while todo
(setq row (nth cnt mat)
      col (mapcar (function (lambda (x) (abs (car x)))) todo)
)
(repeat	(vl-position (apply (function max) col) col)
  (setq	mat (append (vl-remove row mat) (list row))
	row (nth cnt mat)
  )
)
(if (equal (setq piv (car row)) 0.0 1e-14)
  (setq	mat nil
	todo nil
  )
  (setq	piv (/ 1.0 piv)
	new (mapcar (function (lambda (x) (* x piv))) row)
	mat (mapcar
	      (function
		(lambda	(r / e)
		  (setq e (car r))
		  (if (equal r row)
		    (cdr new)
		    (cdr (mapcar
			   (function (lambda (x n) (- x (* n e))))
			   r
			   new
			 )
		    )
		  )
		)
	      )
	      mat
	    )
	todo mat
	cnt (1+ cnt)
  )
)
       (and todo (repeat cnt (setq todo (cdr todo))))
     )
     mat
   )
 )
)

;; IMAT (gile)
;; Crée une matrice d'identité de dimension n
;;
;; Argument
;; d : la dimension de la matrice

(defun Imat (d / i n r m)
 (setq i d)
 (while (    (setq n d r nil)
   (while (      (setq r (cons (if (= i n) 1.0 0.0) r))
   )
   (setq m (cons r m))
 )
)

;; INVERSE (gile)
;; Inverse une matrice carrée (méthode Gauss-Jordan)
;;
;; Argument: la matrice
;; Retour : la matrice inverse ou nil (si non inversible)

(defun inverse (mat)
 (GaussJordan mat (Imat (length mat)))
) 

[Edité le 20/4/2008 par (gile)]

[Bred]

Salut (gile), ça fait longtemps !

j'aurais besoin de ton aide, car je n'arrive à rien....

Je voudrais faire une routine de rotation du SCU de 90° selon X, Y, ou Z...

(en fait je voudrais remplacer ça : (command "_ucs" "_x" "-90"))

J'ai fait un code en tâtonnant, mais comme mes test partait du SCU=SCG ça fonctionnait, jusqu'à ce que je le test avec le SCU "en vrac"...pour réaliser qu'en fait je suis obligé de passer par les matrice...

je mes suis donc plongé dans l'aide, puis dans ton post.... pour me rendre compte que je n'y arrive pas....)

 

mon code (qui ne fonctionne pas dès que le SCU différent du SCG) et qui n'utilise donc pas les matrices :

; Rotation du SCU de 90 ° => Retourne liste (Vis scu_init scu_modif)
(defun Rotate_90_SCU (Axe Vis / ACDOC SCU_INIT SCU_MODIF XVECTOR XVECTOR-INI YVECTOR YVECTOR-INI) ; (setq Axe "Z")
 (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
IconSCU (getvar "UCSICON"))

 (setvar "UCSICON" Vis)
 
 ;récupération SCU Courant (ou création SCU nommé)
 (if (= "" (getvar "UCSNAME"))
   (setq scu_init (vla-add (vla-get-UserCoordinateSystems AcDoc)
		  (vlax-3d-point (trans '(0 0 0) 1 0))
		  (vlax-3d-point (trans '(1 0 0) 1 0))
		  (vlax-3d-point (trans '(0 1 0) 1 0)) "SCU_init"))
   (setq scu_init (vla-get-ActiveUCS AcDoc))
   )
 ;SCU nommé en courant
 (vla-put-ActiveUCS AcDoc scu_init)  
 
 ;Création SCU pour modif
 (setq scu_modif (vla-add (vla-get-UserCoordinateSystems AcDoc)
		   (vlax-3d-point (trans '(0 0 0) 1 0))
		   (vlax-3d-point (trans '(1 0 0) 1 0))
		   (vlax-3d-point (trans '(0 1 0) 1 0)) "SCU_MODIF"))
 ;SCU à modifier en courant
 (vla-put-ActiveUCS AcDoc scu_modif)

 ;;; Rotation du SCU

 ;récupération Vecteurs :
 (setq XVector-ini (vlax-safearray->list (vlax-variant-value (vla-get-XVector scu_modif)))
YVector-ini (vlax-safearray->list (vlax-variant-value (vla-get-YVector scu_modif))))

[b]  ; Calcul de Rotation :
 (cond
   ((equal Axe "X") (setq XVector XVector-ini
		   YVector (list (car YVector-ini)
				 (caddr YVector-ini)
				 (cadr YVector-ini))))
   ((equal Axe "Y") (setq XVector (list (caddr XVector-ini)
				 (cadr XVector-ini)
				 (car XVector-ini))
		   YVector YVector-ini))
   ((equal Axe "Z") (setq XVector YVector-ini
		   YVector (list (- (car XVector-ini))
				 (cadr XVector-ini)
				 (caddr XVector-ini))))
   (t nil)
   )[/b]

 ; Rotation du SCU
 (vla-put-XVector scu_modif (vlax-3d-point XVector))
 (vla-put-YVector scu_modif (vlax-3d-point YVector))

 ; Activation SCU Tourné
 (vla-put-ActiveUCS AcDoc scu_modif)

 (list Vis scu_init scu_modif)
)

 

[Edité le 21/5/2008 par Bred]

[(gile)]

Salut,

 

Je n'ai pas trop de temps en ce moment (gros boulot d'atelier) je regarderais ça ce soir et te répond, si je peux, dès que possible.

[Bred]

Pas de problème !

Je patiente...

Pour t'expliquer rapidement la raison, c'est pour éviter l'emploi d'un command, car sous 2009, plus que jamais, cela semble être plus long que d'habitude....

[(gile)]

Salut,

 

Pour des rotations de 90°, nul n'est besoin d'utiliser les matrices :

90° sur X équivaut à mettre l'axe Y comme le Z précédent

90° sur Y équivaut à mettre l'axe X comme l'opposé du Z précédent

90° sur Z équivaut à mettre l'axe X comme le Y précédent et l'axe Y comme l'opposé du X précédent.

 

Donc pour spécifier un point sur le nouvel axe positif des X ou des Y, arguments pour (vla-add ...), on fait faire une translation à l'origine du SCU avec le vecteur directeur de l'axe qui nous intéresse.

 

Comme je ne sais pas exactement ce que tu veux faire, j'ai essayé de rester fidèle à ton LISP d'origine, mais si tu exécutes plusieurs fois la routine, la première fois tu ajoutes "SCU_MODIF" et éventuellement "SCU_init", mais la seconde fois et les suivantes, tu ne feras qu'écraser "SCU_MODIF".

En supprimant la conditionnelle (if (= "" (getvar "UCSNAME")) ...), à chaque appel de la fonction tu remplacerais l'ancien "SCU_init" par l'ancien "SCU_MODIF" et l'ancien "SCU_MODIF" par le nouveau.

 

;; Rotation du SCU de 90 ° => Retourne liste (Vis scu_init scu_modif)
(defun Rotate_90_SCU (Axe Vis /	ACDOC SCU_INIT SCU_MODIF ORG XDIR YDIR
	      ZDIR)
 (setq	AcDoc	(vla-get-ActiveDocument (vlax-get-acad-object))
IconSCU	(getvar "UCSICON")
 )

 (setvar "UCSICON" Vis)

 ;; récupération de l'origine et des vecteurs directeurs des axes X, Y et Z du SCU Courant
 (setq	org  (getvar "ucsorg")	; ou (trans '(0 0 0) 1 0)
xdir (getvar "ucsxdir")	; ou (trans '(1 0 0) 1 0 T)
ydir (getvar "ucsydir")	; ou (trans '(0 1 0) 1 0 T)
zdir (trans '(0 0 1) 1 0 T)
 )

 ;; récupération (et éventuellement ajout à la collection) du SCU courant
 (if (= "" (getvar "UCSNAME"))
   (setq scu_init (vla-add (vla-get-UserCoordinateSystems AcDoc)
		    (vlax-3d-point org)
		    (vlax-3d-point (mapcar '+ org xdir))
		    (vlax-3d-point (mapcar '+ org ydir))
		    "SCU_init"
	   )
   )
   (setq scu_init (vla-get-ActiveUCS AcDoc))
 )
 (setq scu_init (vla-get-ActiveUCS AcDoc))

 ;; Création du nouveau SCU (ajout à la collection)
 (cond
   ((= axe "X")
    (setq scu_modif (vla-add (vla-get-UserCoordinateSystems AcDoc)
		      (vlax-3d-point org)
		      (vlax-3d-point (mapcar '+ org xdir))
		      (vlax-3d-point (mapcar '+ org zdir))
		      "SCU_MODIF"
	     )
    )
   )
   ((= axe "Y")
    (setq scu_modif (vla-add (vla-get-UserCoordinateSystems AcDoc)
		      (vlax-3d-point org)
		      (vlax-3d-point (mapcar '- org zdir))
		      (vlax-3d-point (mapcar '+ org ydir))
		      "SCU_MODIF"
	     )
    )
   )
   ((= axe "Z")
    (setq scu_modif (vla-add (vla-get-UserCoordinateSystems AcDoc)
		      (vlax-3d-point org)
		      (vlax-3d-point (mapcar '+ org ydir))
		      (vlax-3d-point (mapcar '- org xdir))
		      "SCU_MODIF"
	     )
    )
   )
   (T nil)
 )

 ;; rendre courant le nouvau SCU
 (vla-put-ActiveUCS AcDoc scu_modif)

 (list Vis scu_init scu_modif)
)