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

Aller au contenu

Page 1 sur 1
  • Vous ne pouvez pas commencer un sujet
  • Vous ne pouvez pas répondre à ce sujet

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

#1 L'utilisateur est hors-ligne   Steven 

  • ceinture rouge et blanche 6em dan
  • Groupe : Membres
  • Messages : 3425
  • Inscrit(e) : 03-mars 03
  • LocationDans le TARDIS

Posté 05 février 2018 - 10:14

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?
Steven________________________________________
Pour le taf; Windows (et ses emmerdes) sinon pas d'AutoCAD.
Pour la maison; Linux Mint et pas de problèmes. Mais pas d'AutoCAD.
En rêve; AutoCAD sous Linux.
0

#2 L'utilisateur est hors-ligne   x_all 

  • ceinture rouge et blanche 6em dan
  • Groupe : Membres
  • Messages : 3214
  • Inscrit(e) : 27-juin 06
  • Location04190

Posté 05 février 2018 - 11:05

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


"La possibilité d'expliquer m'a toujours paru comme la seule excuse à l’existence de la parole"
JL Godard

quelques trucs sur autocad
0

#3 L'utilisateur est hors-ligne   Steven 

  • ceinture rouge et blanche 6em dan
  • Groupe : Membres
  • Messages : 3425
  • Inscrit(e) : 03-mars 03
  • LocationDans le TARDIS

Posté 05 février 2018 - 13:09

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.
Steven________________________________________
Pour le taf; Windows (et ses emmerdes) sinon pas d'AutoCAD.
Pour la maison; Linux Mint et pas de problèmes. Mais pas d'AutoCAD.
En rêve; AutoCAD sous Linux.
0

Partager ce sujet :


Page 1 sur 1
  • Vous ne pouvez pas commencer un sujet
  • Vous ne pouvez pas répondre à ce sujet

1 utilisateur(s) en train de lire ce sujet
0 membre(s), 1 invité(s), 0 utilisateur(s) anonyme(s)