Ramener un point d'insertion au centre géométrique d'un bloc

[Steven]

Salut à tous,

 

Existerait-il un moyen de ramener au centre géométrique d'un bloc, son point d'insertion?

 

En effet, on récupère, parfois, pour ne pas dire souvent, voire de plus en plus, des dessins dont le point d'insertion des blocs est à la frontière de la galaxie...

Par conséquent, y aurait-il un moyen de redéfinir le point d'insertion de l'ensemble des blocs d'un dessin au centre géométrique des blocs respectif de manière à ce que ces points d'insertion ne soient plus à des kilomètres des blocs concernés?

[x_all]

il y a bien le lisp INSEDIT de (gile) je crois bien, Mais je suppose que tu voudrai automatiser ça?

Il faudrait le modifier pour qu'il parte du centre de la bonding box ?

 

Edit

Oups pour une foi, c'est pas (gile) enfin pas sur car généralement il signe son travail

re edit, en fait les commentaire sont après les déclaration VB... c'est bien (gile) !o!

n'ayant plus la source je le remercie quand même

et je te met le code

(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.
;; Modifié par Patrick_35 pour éviter une synchro avec les attributs

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

 (defun *error* (msg)
(or (member (strcase msg) '("FUNCTION CANCELLED" ""QUIT / EXIT ABORT"" "FONCTION ANNULEE" "QUITTER / SORTIR ABANDON"))
 	(princ (strcat "\nErreur : " msg))
)
(and lst (mapcar '(lambda(x)(vla-put-Lock x :vlax-true)) lst))
(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] <Oui> : "))
(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)))
		     )
			)
       	)
	)
	(setq posat (mapcar '(lambda(x)(list x (vlax-get x 'InsertionPoint)))(vlax-invoke obj 'getattributes)))
	(vla-Move obj
 		(vlax-3d-Point '(0. 0. 0.))
 		(vlax-3d-Point (mxv mat disp))
	)
	(and posat (mapcar '(lambda(x)(vlax-put (car x) 'insertionpoint (cadr x))) posat))
 	)
 	(vla-Delete ss)
)
 	)
)
 )
 (*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)
)

[Steven]

Salut x_all,

 

Oui, en effet, je souhaiterais que ce soit automatique.

 

J'ai déjà INSEDIT, mais on ner peut faire qu'un bloc à la fois.

 

Un truc ou je ne sélectionne que les blocs qu m'intéresse, en l'occurrence, ceux qui ont un point d'insertion plus que foireux pour ne pas sélectionner ceux qui ont un point d'insertion correct.