Redefinir le point de base d\'un bloc sans le deplacer

[vincentp010]

Bonjour,

 

j'ai récupéré un fichier avec des blocs dont le point d'insertion se trouvait à des kilomètres des entités de ce bloc, pour bosser c'est pas très pratique, surtout si on veut remplacer le bloc.

Je voulais donc redéfinir ce point d'insertion sans que les entités se déplacent.

Grossièrement je voulais faire ça:

http://pix.toile-libre.org/upload/original/1303221798.jpg

 

Je viens de me mettre aux matrices, donc je les ai donc utilisée pour calculer le vecteur de déplacement des objets.

 

; Redefinit le point de base d'un bloc sans le deplacer

(vl-load-com)

;; getMatrixRot Retourne la matrice d'une rotation
(defun getMatrixRot (rot)
  (list
    (list (cos rot) (- (sin rot)) 0 0)
    (list (sin rot) (cos rot) 0 0)
    (list 0 0 1 0)
    (list 0 0 0 1)
   )
)

;; getMatrixEch Retourne la matrice d'une echelle
(defun getMatrixEch (ech)
  (list
    (list (nth 0 ech) 0 0 0)
    (list 0 (nth 1 ech) 0 0)
    (list 0 0 (nth 2 ech) 0)
    (list 0 0 0 1)
   )
)

;; getMatrixTranst Retourne la matrice d'une translation
(defun getMatrixTrans (trans)
  (list
    (list 1 0 0 (nth 0 trans))
    (list 0 1 0 (nth 1 trans))
    (list 0 0 1 (nth 2 trans))
    (list 0 0 0 1)
   )
)

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

;; mxm 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)
)

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

;;; 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))
)

;;; ReverseMatrix Retourne la matrice de tranformation inverse [mat]
;;; Utilise Vunit

;;; VUNIT Retourne le vecteur unitaire d'un vecteur
(defun vunit (v / l)
 (if (/= 0 (setq l (sqrt (apply '+ (mapcar '* v v)))))
   (mapcar '(lambda (x) (/ x l)) v)
 )
)

(defun ReverseMatrix (mat / sclst rmat)
 (setq	sclst (mapcar '(lambda (v) (expt (car (mapcar '/ (vunit v) v)) 2))
	      (trp (mapcar 'butlast (butlast mat)))
      )
 )
 (append
   (mapcar '(lambda (v1 v2) (append v1 (list v2)))
    (setq rmat	(trp (mxm (mapcar 'butlast (butlast mat))
			  (list	(list (car sclst) 0.0 0.0)
				(list 0.0 (cadr sclst) 0.0)
				(list 0.0 0.0 (caddr sclst))
			  )
		     )
		)
    )
    (mapcar '- (mxv rmat (mapcar 'last (butlast mat))))
   )
   (list '(0.0 0.0 0.0 1.0))
 )
)


(defun c:insredef (/ ent bl rot ech invech ptnouv ptins vect vect2 mat matrot matech debut nb nb1 allbl pt n i namebl)
  (setvar "cmdecho" 0)
  (command "annuler" "m")

  (setq ent (car (entsel "Selectionner le bloc a modifier :")))
  (if (/= ent nil) 
   (progn
    (setq bl (cdr (assoc 2 (entget ent))))
    ;; Calcul du vecteur de deplacement dans le scu du bloc
    (setq ptins (cdr (assoc 10 (entget ent))))
    (setq rot (cdr (assoc 50 (entget ent))))
    (setq ech (list
     (cdr (assoc 41 (entget ent)))
     (cdr (assoc 42 (entget ent)))
     (cdr (assoc 43 (entget ent)))
    ))
    (vla-highlight (vlax-ename->vla-object ent) :vlax-true)
    (setq ptnouv (getpoint "Pointez le nouveau point de base du bloc :"))
    (vla-highlight (vlax-ename->vla-object ent) :vlax-false)
    (setq ptnouv (trans ptnouv 1 0))
    
    (setq vect (mapcar '(lambda (x y) (- y x)) ptins ptnouv))
    (setq invech (mapcar '(lambda (x) (/ 1 x)) ech))
    (setq matech (getMatrixEch invech))
    (setq matrot (getMatrixRot (- rot)))
    (setq mat (mxm matech matrot))
    (setq vect (butlast (mxv mat vect)))
    ;;_fin calc vect dep
    
    ;; Modif definition du bloc
    (setq debut 1)
    (while (/= namebl bl)
      (setq i (tblnext "block" debut) debut nil)
      (setq namebl (cdr (assoc 2 i)))
    )
    (if (/= i nil) (progn
      (setq n (cdr (assoc -2 i)))
      (while n
        (if (and (/= (cdr (assoc 0 (entget n))) "VERTEX") (/= (cdr (assoc 0 (entget n))) "COVAPTSEL"))
          (vla-move (vlax-ename->vla-object n) (vlax-3d-point (list 0.0 0.0 0.0)) (vlax-3d-point (mapcar '(lambda (x) (- x)) vect)))
        )
        (setq n (entnext n))
        (if (/= n nil) 
         (if (= (cdr (assoc 0 (entget n))) "SEQEND") (setq n nil))
        )
      ) ;_while
    )) ;_if
    ;; Fin modif bloc
    
    ;; Deplace les blocs
    (setq allbl (ssget "x" (list (cons 2 bl))))
    (setq nb 0 nb1 (sslength allbl))
    (while (< nb nb1)
      (setq ent (ssname allbl nb))
      (setq ptins (cdr (assoc 10 (entget ent))))
      (setq rot (cdr (assoc 50 (entget ent))))
      (setq ech (list
       (cdr (assoc 41 (entget ent)))
       (cdr (assoc 42 (entget ent)))
       (cdr (assoc 43 (entget ent)))
      ))
      (setq matech (getMatrixEch ech))
      (setq matrot (getMatrixRot rot))
      (setq mat (mxm matech matrot))
      (setq vect2 (butlast (mxv mat vect)))
      (setq pt (mapcar '(lambda (x y) (+ x y)) ptins vect2))
      (entmod (subst (cons 10 pt) (assoc 10 (entget ent)) (entget ent)))
      (setq nb (+ nb 1))
    )
    ;; Fin deplace blocs
  )) ;;_if (/= ent nil)
)

 

Si vous avez des remarques sur le code n’hésitez pas.

[(gile)]

Salut,

 

J'avais fait ça, mais je n'arrive plus à le retrouver sur le forum

(vl-load-com)
(or *acad* (setq *acad* (vlax-get-acad-object)))
(or *acdoc* (setq *acdoc* (vla-get-ActiveDocument *acad*)))
(or *blocks* (setq *blocks* (vla-get-Blocks *acdoc*)))
(or *layers* (setq *layers* (vla-get-Layers *acdoc*)))

;; InsEdit (gile)
;; Redéfinit le bloc sélectionné (déplacement du point de base sur le point
;; spécifié) et déplace ou non en conséquence toutes les références insérées.

(defun c:InsEdit	(/ *error* ent elst ins pos bName lst disp ss n xform)

 (defun *error* (msg)
   (and msg
 (/= msg "Fonction annulée")
 (princ (strcat "\nErreur: " msg))
   )
   (and lst
 (foreach n lst
   (vla-put-Lock n :vlax-true)
 )
   )
   (vla-EndUndoMark *acdoc*)
   (princ)
 )

 (vla-StartUndoMark *acdoc*)
 (if
   (and
     (setq ent (car (entsel "\nSélectionnez un bloc: ")))
     (setq elst (entget ent))
     (= (cdr (assoc 0 elst)) "INSERT")
     (setq ins (getpoint "\nSpécifiez le nouveau point d'insertion: "))
   )
    (progn
      (initget "Oui Non")
      (or (setq
     pos (getkword "\nConserver la position ? [Oui/Non] <O>: ")
   )
   (setq pos "Oui")
      )
      (vlax-for l *layers*
 (and (= (vla-get-Lock l) :vlax-true)
      (setq lst (cons l lst))
      (vla-put-Lock l :vlax-false)
 )
      )
      (setq ang   (- (cdr (assoc 50 elst)))
     norm  (cdr (assoc 210 elst))
     disp  (mxv
	     (mxm
	       (list
		 (list (/ 1 (cdr (assoc 41 elst))) 0.0 0.0)
		 (list 0.0 (/ 1 (cdr (assoc 42 elst))) 0.0)
		 (list 0.0 0.0 (/ 1 (cdr (assoc 43 elst))))
	       )
	       (mxm
		 (list (list (cos ang) (- (sin ang)) 0.0)
		       (list (sin ang) (cos ang) 0.0)
		       '(0.0 0.0 1.0)
		 )
		 (mapcar
		   (function (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 '-
		     (trans ins 1 0)
		     (trans (cdr (assoc 10 elst)) norm 0)
	     )
	   )
     bName (cdr (assoc 2 elst))
      )
      (vlax-for obj (vla-item *blocks* bName)
 (vla-Move obj
	   (vlax-3d-point disp)
	   (vlax-3d-point '(0. 0. 0.))
 )
      )
      (if (= "Oui" pos)
 (progn
   (ssget "_X" (list '(0 . "INSERT") (cons 2 bName)))
   (vlax-for obj (setq ss (vla-get-ActiveSelectionSet *acdoc*))
     (setq elst	(entget (vlax-vla-object->ename obj))
	   ang	(cdr (assoc 50 elst))
	   norm	(cdr (assoc 210 elst))
	   mat	(mxm
		  (mapcar (function (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)))
		    )
		  )
		)
     )
     (vla-Move obj
	       (vlax-3d-Point '(0. 0. 0.))
	       (vlax-3d-Point (mxv mat disp))
     )
   )
   (vla-Delete ss)
 )
      )
      (if (= (vla-get-HasAttributes (vlax-ename->vla-object ent)) :vlax-true)
 (vl-cmdf "_.attsync" "_n" bName)
      )
    )
 )
 (*error* nil)
)

;; TRP
;; transpose une matrice -Doug Wilson-
;;
;; Argument : une matrice

(defun trp (m) (apply 'mapcar (cons 'list m)))

;; MXV
;; Applique une matrice de transformation à un vecteur -Vladimir Nesterovsky-
;;
;; Arguments : une matrice et un vecteur

(defun mxv (m v)
 (mapcar (function (lambda (r) (apply '+ (mapcar '* r v))))
  m
 )
)

;; MXM
;; Multiplie (combine) deux matrices -Vladimir Nesterovsky-
;;
;; Arguments : deux matrices

(defun mxm (m q)
 (mapcar (function (lambda (r) (mxv (trp q) r))) m)
)

 

La différence avec ton code, au delà du fait que l'utilisateur a le choix entre conserver la position du bloc ou le déplacer, est que j'utilise une matrice supplémentaire qui permet une utilisation en 3d.

Sinon, je préfère utiliser des matrices 3x3 (échelles et rotations) et traiter les translations à côté.

À part ça, ta routine ReverseMatrix ne fonctionne pas chez moi. Regarde dans Vecteurs&Matrices.lsp sur cette page, la routine fonctionne avec les matrices carrées de toutes dimensions.

[vincentp010]

Merci pour le code, je peux voir que ma méthodologie n'est pas mauvaise :)

Pour la fonction ReverseMatrix je l'ai trouvée dans un de tes post sur les matrices qui date de 2006, elle ne doit marcher que pour les 4x4.

 

[(gile)]

Pour la fonction ReverseMatrix je l'ai trouvée dans un de tes post sur les matrices qui date de 2006, elle ne doit marcher que pour les 4x4.

 

Je l'ai bien essayé sur une matrice 4x4 et j'ai eu l'erreur 'Division par zéro'.

Et cette erreur adviendra à chaque fois qu'un des vecteurs de la matrice argument aura une coordonnée égale à zéro (ce qui est somme toute assez courant).

À la poubelle !!!

 

Il faut que je corrige ce post...

 

[LUDWIG]

Moi j'avais fait ça mais je suis maintenant bien incapable de vous le commenter.

http://www.cadxp.com/modules.php?op=modload&name=XForum&file=viewthread&tid=5610#pid

 

[vincentp010]

J'avais eu l'erreur de division par zéro une seule fois et après plus rien donc j'ai pas cherché d'ou ça pouvais venir.

[surligneur]Il faut que je corrige ce post...[/surligneur]

Ça serait bien vu que c'est le premier que l'on trouve lors d'une recherche sur les matrices ;)