boundingbox

zebulon_ · le 16 décembre 2005

L'objectif est de trouver l'emprise d'un objet, quel qu'il soit. J'ai trouvé la méthode getboundingbox et ça donne ceci.

(defun c:al-getboundingbox ()

(vl-load-com)

(setq util (vla-get-utility 
                  (vla-get-activedocument 
                       (vlax-get-acad-object))))
                       
(vla-getentity util 'obj 'ip "\nSelectionner Objet: ")

(vla-GetBoundingBox obj 'minpoint 'maxpoint)

(setq minpoint (trans (vlax-safearray->list minpoint) 0 1))
(setq maxpoint (trans (vlax-safearray->list maxpoint) 0 1))

(command "_line" minpoint maxpoint"")

(princ)

);defun

Cela marche bien quand on est en scu général, mais dans un scu local minpoint et maxpoint suivent toujours l'orientation du scu général et pas du scu local. Comment je peux faire pour que ça marche bien aussi dans un scu local dont l'orientation diffère du scu général ?

Merci

Zebulon_

(gile) · le 16 décembre 2005

Salut,

Ma méthode n'est pas très élégante.

Elle consiste en une rotation de l'objet de l'angle du SCU à l'angle du SCG avant de faire le getboundingbox et une rotation inverse de de l'objet et de la ligne.

Elle ne fonctionne qu'en 2D (SCU parllèle au SCG).

Je te laisse le soin de la tester en profondeur et de l'améliorer.

(defun c:al-getboundingbox (/	    AcDoc   ModSp   ucszdir ang
		    util    obj	    ip	    cen	    minpoint
		    maxpoint	    pt1	    pt2	    pt3
		    pt4	    lst	    pline
		   )
 (vl-load-com)
 (setq	AcDoc (vla-get-activedocument (vlax-get-acad-object))
ModSp (vla-get-ModelSpace AcDoc)
 )
 (vla-startUndoMark AcDoc)
 (setq	ucszdir	(trans '(0 0 1) 1 0 T)
ang	(angle '(0 0) (trans (getvar "UCSXDIR") 0 ucszdir))
 )
 (if (equal ucszdir '(0.0 0.0 1.0) 1e-009)
   (progn
     (setq util (vla-get-utility
	   (vla-get-activedocument
	     (vlax-get-acad-object)
	   )
	 )
     )
     (vla-getentity util 'obj 'ip "\nSelectionner Objet: ")
     (setq cen (vlax-3d-point '(0.0 0.0 0.0)))
     (vla-rotate obj cen (- ang))
     (vla-GetBoundingBox obj 'minpoint 'maxpoint)
     (setq pt1	(vlax-safearray->list minpoint)
    pt3	(vlax-safearray->list maxpoint)
    pt2	(list (car pt3) (cadr pt1))
    pt4	(list (car pt1) (cadr pt3))
    lst	(list pt1 pt2 pt3 pt4)
    lst	(apply 'append
	       (mapcar
		 '(lambda (x)
		    (list (car x) (cadr x))
		  )
		 lst
	       )
	)
     )
     (setq pline (vla-addLightweightPolyline
	    ModSp
	    (vlax-make-variant
	      (vlax-SafeArray-fill
		(vlax-make-SafeArray
		  vlax-vbDouble
		  (cons	0
			(- (length lst) 1)
		  )
		)
		lst
	      )
	    )
	  )
     )
     (vla-put-Closed pline T)
     (vla-put-elevation pline (caddr pt1))
     (vla-rotate pline cen ang)
     (vla-rotate obj cen ang)
   )
   (alert
     "Cette commande ne fonctionne que dans un SCU paralèle au SCG."
   )
 )
 (vla-endUndoMark AcDoc)
 (princ)
)

PS : pour les traductions entre SCO, SCU et SCG voir ici

[Edité le 17/12/2005 par (gile)]

(gile) · le 17 décembre 2005

Je bute toujours pour les SCU non parallèles au SCG (rotation sur X ou Y), je pensais avoir trouvé en utilisant (vla-put-Normal), mais tous les objets ne réagissent pas pareil et les ellipses, par exemple, n'ont pas cette propriété.

J'ai "mis au propre" la routine ci-dessus, ajout de marques "undo" et d'un test de parallélisme des plans XY du SCU et du SCG, j'ai aussi remplacé la ligne par un rectangle pour matérialiser le Bounding box.

Le rectangle est donc dans l'axe XY du SCU et dans le plan de l'objet quelque soit son élévation par rapport au SCU.

À plus ...

[Edité le 17/12/2005 par (gile)]

(gile) · le 18 décembre 2005

Çà y est !

Cette nouvelle version semble marcher quelque soit le SCU et l'élévation de l'objet par rapport au plan du SCU.

J'ai été obligé de faire un mix d'AutoLISP et de VisualLISP : je n'ai pas trouvé de fonction en Visual équivalente à (align).

Si l'objet est un objet 2D parallèle au plan du SCU la bounding box, parallèle aux axes XY du SCU, est matérialisée par un rectangle (polyligne), sinon par une box (solide 3D).

Nouvelle version (correction d'un dysfonctionnement avec align le19/12/05 à 17h13)

(defun c:bbox (/       AcDoc   ModSp   js      obj   bb  minpoint
       maxpoint	       pt1     pt2     pt3     pt4     line
       lst     ucszdir pline   cen
      )
 (vl-load-com)
 (setq	AcDoc (vla-get-activedocument (vlax-get-acad-object))
ModSp (vla-get-ModelSpace AcDoc)
 )
 (vla-startUndoMark AcDoc)
 (while (not (setq js (ssget "_:S"))))
 (setq obj (vlax-ename->vla-object (ssname js 0)))
 (if (not (member "geom3d.arx" (arx)))
   (arxload "geom3d")
 )
 (align js
 '(0.0 0.0 0.0)
 (trans '(0.0 0.0 0.0) 0 1)
 '(1.0 0.0 0.0)
 (trans '(1.0 0.0 0.0) 0 1)
 '(0.0 1.0 0.0)
 (trans '(0.0 1.0 0.0) 0 1)
 )
 (setq	bb (vl-catch-all-apply
     'vla-getboundingbox
     (list obj
	   'minpoint
	   'maxpoint
     )
   )
 )
 (if (vl-catch-all-error-p bb)
   (progn
     (princ
(strcat "; erreur: " (vl-catch-all-error-message bb))
     )
     (align js
 (trans '(0.0 0.0 0.0) 0 1)
 '(0.0 0.0 0.0)
 (trans '(1.0 0.0 0.0) 0 1)
 '(1.0 0.0 0.0)
 (trans '(0.0 1.0 0.0) 0 1)
 '(0.0 1.0 0.0)
 )
   )
   (progn
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     (setq pt1	(vlax-safearray->list minpoint)
    pt2	(vlax-safearray->list maxpoint)
     )
     (if (equal (caddr pt1) (caddr pt2) 1e-007)
(progn
  (setq line (vla-addLine ModSp minpoint maxpoint))
  (ssadd (entlast) js)
  (align js
 (trans '(0.0 0.0 0.0) 0 1)
 '(0.0 0.0 0.0)
 (trans '(1.0 0.0 0.0) 0 1)
 '(1.0 0.0 0.0)
 (trans '(0.0 1.0 0.0) 0 1)
 '(0.0 1.0 0.0)
 )
  (setq	pt1 (trans (vlax-safearray->list
		     (vlax-variant-value (vla-get-startPoint line))
		   )
		   0
		   1
	    )
	pt3 (trans (vlax-safearray->list
		     (vlax-variant-value (vla-get-endPoint line))
		   )
		   0
		   1
	    )
	pt2 (list (car pt3) (cadr pt1))
	pt4 (list (car pt1) (cadr pt3))
	lst (list pt1 pt2 pt3 pt4)
  )
  (setq	ucszdir	(trans '(0 0 1) 1 0 T)
	lst	(apply 'append
		       (mapcar
			 '(lambda (x)
			    (setq x (trans x 1 ucszdir))
			    (list (car x) (cadr x))
			  )
			 lst
		       )
		)
  )
  (setq	pline (vla-addLightweightPolyline
		ModSp
		(vlax-make-variant
		  (vlax-SafeArray-fill
		    (vlax-make-SafeArray
		      vlax-vbDouble
		      (cons 0
			    (- (length lst) 1)
		      )
		    )
		    lst
		  )
		)
	      )
  )
  (vla-put-Closed pline T)
  (vla-put-Elevation
    pline
    (- (caddr pt1) (caddr (trans '(0 0) 0 1)))
  )
  (vla-delete line)
)
(progn
  (setq	cen (mapcar '(lambda (x) (/ x 2)) (mapcar '+ pt1 pt2))
	pt2 (mapcar '- pt2 pt1)
  )
  (vla-addBox
    ModSp
    (vlax-3d-point cen)
    (car pt2)
    (cadr pt2)
    (caddr pt2)
  )
  (ssadd (entlast) js)
  (align js
 (trans '(0.0 0.0 0.0) 0 1)
 '(0.0 0.0 0.0)
 (trans '(1.0 0.0 0.0) 0 1)
 '(1.0 0.0 0.0)
 (trans '(0.0 1.0 0.0) 0 1)
 '(0.0 1.0 0.0)
 )
)
     )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   )
 )
 (vla-endUndoMark AcDoc)
 (princ)
)

PS1 : si tu préfères matérialiser la bounding box par une ligne, comme dans ton exemple, remplace la partie de code entre les ;;;;;;;;; par celle-ci :

(vla-addLine ModSp minpoint maxpoint)
(ssadd (entlast) js)
(align js
 (trans '(0.0 0.0 0.0) 0 1)
 '(0.0 0.0 0.0)
 (trans '(1.0 0.0 0.0) 0 1)
 '(1.0 0.0 0.0)
 (trans '(0.0 1.0 0.0) 0 1)
 '(0.0 1.0 0.0)
 )

[Edité le 18/12/2005 par (gile)][Edité le 19/12/2005 par (gile)]

[Edité le 19/12/2005 par (gile)]

(gile) · le 18 décembre 2005

En utilisant le VisualLISP uniquement pour récupérer les points de la bounding box, je trouve çà beacoup plus lisible :

Nouvelle version (correction d'un dysfonctionnement avec align le19/12/05 à 17h11)

;;; Retourne les coordonnées des points de la "Bounding Box" (liste) ou un message d'erreur

(defun getbbox (ent / bb minpoint maxpoint)
 (vl-load-com)
 (setq	bb (vl-catch-all-apply
     'vla-getboundingbox
     (list (vlax-ename->vla-object ent)
	   'minpoint
	   'maxpoint
     )
   )
 )
 (if (vl-catch-all-error-p bb)
   (strcat "; erreur: " (vl-catch-all-error-message bb))
   (list (vlax-safearray->list minpoint)
  (vlax-safearray->list maxpoint)
   )
 )
)

;;; Redéfinition de *error*

(defun bbox_err	(msg)
 (if (/= msg "Fonction annulée")
   (princ msg)
 )
 (command "_undo" "_end")
 (setvar "cmdecho" v1)
 (setvar "osmode" v2)
 (setq	*error*	m:err
m:err nil
 )
)

;;; Fonction principale

(defun c:bbox (/ js lst pt1 pt2 l)
 (setq	m:err	*error*
*error*	bbox_err
 )
 (setq	v1 (getvar "cmdecho")
v2 (getvar "osmode")
 )
 (command "_undo" "_begin")
 (setvar "cmdecho" 0)
 (setvar "osmode" 0)
 (while (not (setq js (ssget "_:S"))))
 (if (not (member "geom3d.arx" (arx)))
   (arxload "geom3d")
 )
 (align js
 '(0.0 0.0 0.0)
 (trans '(0.0 0.0 0.0) 0 1)
 '(1.0 0.0 0.0)
 (trans '(1.0 0.0 0.0) 0 1)
 '(0.0 1.0 0.0)
 (trans '(0.0 1.0 0.0) 0 1)
 )
 (if
   (listp (setq lst (getbbox (ssname js 0))))
    (progn
      (setq pt1 (trans (car lst) 0 1)
     pt2 (trans (cadr lst) 0 1)
      )
      (command "_line" pt1 pt2 "")
      (ssadd (entlast) js)
      (align js
      (trans '(0.0 0.0 0.0) 0 1)
      '(0.0 0.0 0.0)
      (trans '(1.0 0.0 0.0) 0 1)
      '(1.0 0.0 0.0)
      (trans '(0.0 1.0 0.0) 0 1)
      '(0.0 1.0 0.0)
      )
      (setq pt1 (trans (cdr (assoc 10 (entget (entlast)))) 0 1)
     pt2 (trans (cdr (assoc 11 (entget (entlast)))) 0 1)
      )
      (entdel (entlast))
      (if (equal (caddr pt1) (caddr pt2) 1e-007)
 (command "_rectangle" pt1 pt2)
 (command "_box" pt1 pt2)
      )
    )
    (progn
      (command "_undo" "1")
      (princ lst)
    )
 )
 (command "_undo" "_end")
 (setvar "cmdecho" v1)
 (setvar "osmode" v2)
 (setq	*error*	m:err
m:err nil
 )
 (princ)
)

[Edité le 19/12/2005 par (gile)]

zebulon_ · le 19 décembre 2005

Je me doutais bien qu'il fallait bricoler un peu, puisque dans Autolisp il y a une antique fonction qui s'appelle textbox et qui permet d'obtenir la "bounding box" pour un texte simple uniquement. Mais la méthode consiste là à faire une rotation de scu suivant l'objet texte avant de lui appliquer la fonction textbox, comme dans l'exemple ci-dessous.

(defun c:tbox (/ textent tb ll ur ul lr OLDOS)
 (setq OLDOS (getvar "osmode"))
 (setvar "osmode" 0)
 (setq textent (car (entsel "\nSélectionner un texte : ")))
 (command "_ucs" "_e" textent)
 (setq tb (textbox (list (cons -1 textent)))
 ll (car tb)
 ur (cadr tb)
 ul (list (car ll) (cadr ur))
 lr (list (car ur) (cadr ll))
 )
 (command "_pline" ll lr ur ul "_c")
 (command "_ucs" "_p")
 (setvar "osmode" OLDOS)
 (princ)
)

Pour revenir à la méthode Bounding Box, il y a un ptit bug dans autocad 2004 qui doit lui être lié. Si on définit un style de cotation encadré et qu'on fait une ligne de repère (qui sera donc encadrée automatiquement), on obtiendra un magnifique cadre autour du texte de la ligne de repère... sauf si on tourne le scu et qu'on regénère. Là, le cadre autour de texte "tire un peu la gueule". Et si on lance la méthode Bounding box sur le texte de cote dans le scu local, on obtient les mêmes points que le cadre tordu. Dans la 2006, c'est peut être corrigé ?

En tout cas, merci (gile)

Amicalement

Zebulon_

(gile) · le 19 décembre 2005

Merci aussi à toi, on apprend aussi en essayant de répondre aux question qu'on ne s'était pas posées.

J'ai apporté une petite correction aux deux codes ci-dessus.

Patrick_35 · le 19 décembre 2005

Salut

Je te propose un truc plus simple dans la fonction trans par rapport au 1er lisp

(setq minpoint (trans (vlax-safearray->list minpoint) (vlax-vla-object->ename obj) 1))
(setq maxpoint (trans (vlax-safearray->list maxpoint) (vlax-vla-object->ename obj) 1))

@+

zebulon_ · le 19 décembre 2005

Salut patrick,

Salut
Je te propose un truc plus simple dans la fonction trans par rapport au 1er lisp

(setq minpoint (trans (vlax-safearray->list minpoint) (vlax-vla-object->ename obj) 1))
(setq maxpoint (trans (vlax-safearray->list maxpoint) (vlax-vla-object->ename obj) 1))

ça apporte quoi par rapport à

(setq minpoint (trans (vlax-safearray->list minpoint) 0 1))
(setq maxpoint (trans (vlax-safearray->list maxpoint) 0 1))

puisque (vla-GetBoundingBox obj 'minpoint 'maxpoint) renvoie des points du SCG ?

Patrick_35 · le 19 décembre 2005

Oui, sauf qu'une entité est traduite en OCS (Object Coordinate System). Ces coordonnées sont habituellement converties en WCS, UCS courant, ou DCS courant, selon l'utilisation prévue de l'objet

@+

(gile) · le 11 août 2006

Je reveille cet ancien sujet.

Je m'essaye aux matrices en vlisp (vlax-tmatrix, vla-TransformBy) et j'ai trouvé là une alternative à (align ...), j'en ai profité pour réparé un dysfonctionnement avec les objets "text" pour qui les coordonnées retournées pas vla-get-BoundingBox ne tiennent pas compte de l'élévation du texte.

Voici donc une routine mieux aboutie, qui crée une entité (polyligne ou boite) figurant l'emprise de l'objet sélectionné suivant le SCU courant.

D'après mes essais, la routine routine fonctionne quelque soient le SCU courant et le SCU dans lequel a été créé l'objet.

Modifié le 21/01/07.

Réparé un bug concernant les objets 2D des plans YZ et ZX du SCU courant..

Tous les objets 2D contenus dans les plans XY, YZ et ZX du SCU courant (boundingbox plane) sont désormais traités de la même manière : avec une poly 3D plane.

;; Doug C. Broad, Jr.
;; can be used with vla-transformby to
;; 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))
   )
 )
)
;; 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))
   )
 )
)

;;; Crée une entité (polyligne ou boite) figurant la "bounding box" de l'objet sélectionné.

(defun c:bbox (/ bbox_err AcDoc	Space obj bb minpoint maxpoint pt1 pt2 lst poly
       box cen norm)
 (vl-load-com)

 (defun bbox_err (msg)
   (if	(or
  (= msg "Fonction annulée")
  (= msg "quitter / sortir abandon")
)
     (princ)
     (princ (strcat "\nErreur: " msg))
   )
   (vla-endundomark
     (vla-get-activedocument (vlax-get-acad-object))
   )
   (setq *error* m:err
  m:err	nil
   )
   (princ)
 )

 (setq	AcDoc	(vla-get-activedocument (vlax-get-acad-object))
Space	(if (= (getvar "CVPORT") 1)
	  (vla-get-PaperSpace AcDoc)
	  (vla-get-ModelSpace AcDoc)
	)
m:err	*error*
*error*	bbox_err
 )
 (vla-startUndoMark AcDoc)
 (while (not (setq obj (car (entsel)))))
 (setq obj (vlax-ename->vla-object obj))
 (vla-TransformBy obj (UCS2WCSMatrix))
 (setq	bb (vl-catch-all-apply
     'vla-getboundingbox
     (list obj
	   'minpoint
	   'maxpoint
     )
   )
 )
 (if (vl-catch-all-error-p bb)
   (progn
     (princ
(strcat "; erreur: " (vl-catch-all-error-message bb))
     )
     (vla-TransformBy obj (WCS2UCSMatrix))
   )
   (progn
     (setq pt1	(vlax-safearray->list minpoint)
    pt2	(vlax-safearray->list maxpoint)
     )
     (if (or (equal (car pt1) (car pt2) 1e-007)
      (equal (cadr pt1) (cadr pt2) 1e-007)
      (equal (caddr pt1) (caddr pt2) 1e-007)
  )
(progn
  (cond
    ((equal (car pt1) (car pt2) 1e-007)
     (setq lst (list pt1
		     (list (car pt1) (cadr pt1) (caddr pt2))
		     pt2
		     (list (car pt1) (cadr pt2) (caddr pt1))
	       )
     )
    )
    ((equal (cadr pt1) (cadr pt2) 1e-007)
     (setq lst (list pt1
		     (list (car pt1) (cadr pt1) (caddr pt2))
		     pt2
		     (list (car pt2) (cadr pt1) (caddr pt1))
	       )
     )
    )
    ((equal (caddr pt1) (caddr pt2) 1e-007)
     (setq lst (list pt1
		     (list (car pt1) (cadr pt2) (caddr pt1))
		     pt2
		     (list (car pt2) (cadr pt1) (caddr pt1))
	       )
     )
    )
  )
  (setq	box
	 (vlax-invoke Space 'add3dPoly (apply 'append lst))
  )
  (vla-put-closed box :vlax-true)
)
(progn
  (setq	cen (mapcar '(lambda (x y) (/ (+ x y) 2)) pt1 pt2)
	pt2 (mapcar '- pt2 pt1)
	box (vla-addBox
	      Space
	      (vlax-3d-point cen)
	      (car pt2)
	      (cadr pt2)
	      (caddr pt2)
	    )
  )
)
     )
     (if (= (vla-get-ObjectName obj) "AcDbText")
(progn
  (setq	norm (vlax-get obj 'Normal)
  )
  (vla-Move
    box
    (vlax-3d-point (trans '(0 0 0) norm 0))
    (vlax-3d-point
      (trans
	(list
	  0
	  0
	  (caddr
	    (trans (vlax-get obj 'InsertionPoint)
		   0
		   norm
	    )
	  )
	)
	norm
	0
      )
    )
  )
)
     )
     (mapcar '(lambda (x) (vla-TransformBy x (WCS2UCSMatrix)))
      (list obj box)
     )
   )
 )
 (vla-endUndoMark AcDoc)
 (setq	*error*	m:err
m:err nil
 )
 (princ)
)

[Edité le 13/8/2006 par (gile)][Edité le 26/10/2006 par (gile)]

[Edité le 22/1/2007 par (gile)]

sergeluc · le 26 octobre 2006

Bonjour Gile ,

Je viens d'utiliser ta routine "bbox" 11/8/2006 à 21:55 sur des blocs en 2d elle fonctionne quelque soient le SCU dans lequel a été créé l'objet . C'est parfait .

Une seule chose m'ennuie c'est qu'elle tient compte de tous les objets constituants

un bloc y compris les attributs .Peux tu m'aider ,si c'est possible ,pour y filtrer les attributs afin

qu'ils ne soient pas pris en compte dans l'emprise d'un bloc .

merci d'avance et félicitations pour ce travail remarquable une fois de plus

[Edité le 26/10/2006 par sergeluc]

(gile) · le 26 octobre 2006

Voici une version qui ne tient pas compte de l'emprise des attributs de bloc.

;; Doug C. Broad, Jr.
;; can be used with vla-transformby to
;; 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))
   )
 )
)
;; 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))
   )
 )
)

;;; Crée une entité (polyligne ou boite) figurant la "bounding box" de l'objet sélectionné.

(defun c:bbox (/       bbox_err	       AcDoc   Space   obj     att_lst
       bb      minpoint	       maxpoint	       pt1     pt2
       pt3     pt4     line    lst     ucszdir pline   box
       cen     norm
      )
 (vl-load-com)

 (defun bbox_err (msg)
   (if	(or
  (= msg "Fonction annulée")
  (= msg "quitter / sortir abandon")
)
     (princ)
     (princ (strcat "\nErreur: " msg))
   )
   (vla-endundomark
     (vla-get-activedocument (vlax-get-acad-object))
   )
   (setq *error* m:err
  m:err	nil
   )
   (princ)
 )

 (setq	AcDoc	(vla-get-activedocument (vlax-get-acad-object))
Space	(if (= (getvar "CVPORT") 1)
	  (vla-get-PaperSpace AcDoc)
	  (vla-get-ModelSpace AcDoc)
	)
m:err	*error*
*error*	bbox_err
 )
 (vla-startUndoMark AcDoc)
 (while (not (setq obj (car (entsel)))))
 (setq obj (vlax-ename->vla-object obj))
 (vla-TransformBy obj (UCS2WCSMatrix))
 [surligneur](if
   (and (= (vla-get-ObjectName obj) "AcDbBlockReference")
 (setq
   att_lst (vl-remove-if
	     '(lambda (x) (= (vla-get-Invisible x) :vlax-true))
	     (vlax-invoke obj 'getattributes)
	   )
 )
   )
    (foreach att att_lst (vla-put-Invisible att :vlax-true))
 )[/surligneur]
 (setq	bb (vl-catch-all-apply
     'vla-getboundingbox
     (list obj
	   'minpoint
	   'maxpoint
     )
   )
 )
 [surligneur](if att_lst
   (foreach att att_lst (vla-put-Invisible att :vlax-false))
 )[/surligneur]
 (if (vl-catch-all-error-p bb)
   (progn
     (princ
(strcat "; erreur: " (vl-catch-all-error-message bb))
     )
     (vla-TransformBy obj (WCS2UCSMatrix))
   )
   (progn
     (setq pt1	(vlax-safearray->list minpoint)
    pt2	(vlax-safearray->list maxpoint)
     )
     (if (equal (caddr pt1) (caddr pt2) 1e-007)
(progn
  (setq line (vla-addLine Space minpoint maxpoint))
  (mapcar '(lambda (x) (vla-TransformBy x (WCS2UCSMatrix)))
	  (list obj line)
  )
  (setq	pt1	(trans (vlax-curve-getStartPoint line) 0 1)
	pt3	(trans (vlax-curve-getEndPoint line) 0 1)
	pt2	(list (car pt3) (cadr pt1))
	pt4	(list (car pt1) (cadr pt3))
	lst	(list pt1 pt2 pt3 pt4)
	ucszdir	(trans '(0 0 1) 1 0 T)
	lst	(apply 'append
		       (mapcar
			 '(lambda (x)
			    (setq x (trans x 1 ucszdir))
			    (list (car x) (cadr x))
			  )
			 lst
		       )
		)
	pline	(vlax-invoke Space 'addLightweightPolyline lst)
  )
  (vla-put-Closed pline T)
  (vla-put-Elevation
    pline
    (- (caddr pt1) (caddr (trans '(0 0) 0 1)))
  )
  (if (= (vla-get-ObjectName obj) "AcDbText")
    (vla-Move
      pline
      (vlax-3d-point (trans '(0 0 0) 1 0))
      (vlax-3d-point
	(trans
	  (list
	    0
	    0
	    (caddr (trans (vlax-get obj 'InsertionPoint) 0 1))
	  )
	  1
	  0
	)
      )
    )
  )
  (vla-delete line)
)
(progn
  (setq	cen (mapcar '(lambda (x y) (/ (+ x y) 2)) pt1 pt2)
	pt2 (mapcar '- pt2 pt1)
	box (vla-addBox
	      Space
	      (vlax-3d-point cen)
	      (car pt2)
	      (cadr pt2)
	      (caddr pt2)
	    )
  )
  (if (= (vla-get-ObjectName obj) "AcDbText")
    (progn
      (setq norm (vlax-get obj 'Normal)
      )
      (vla-Move
	box
	(vlax-3d-point (trans '(0 0 0) norm 0))
	(vlax-3d-point
	  (trans
	    (list
	      0
	      0
	      (caddr
		(trans (vlax-get obj 'InsertionPoint)
		       0
		       norm
		)
	      )
	    )
	    norm
	    0
	  )
	)
      )
    )
  )
  (mapcar '(lambda (x) (vla-TransformBy x (WCS2UCSMatrix)))
	  (list obj box)
  )
)
     )
   )
 )
 (vla-endUndoMark AcDoc)
 (setq	*error*	m:err
m:err nil
 )
 (princ)
)

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

sergeluc · le 26 octobre 2006

merci Gile ,

Je viens de tester ,ils sont toujours pris en compte ,je vais y réfléchir demain .Je te tiens

informé dès que je trouve une réponse .

encore merci

(gile) · le 27 octobre 2006

Salut,

Effectivement, seuls les attributs éditables étaient traités.

Voici une nouvelle version qui ne prend aussi en compte les attributs constants.

;; Doug C. Broad, Jr.
;; can be used with vla-transformby to
;; 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))
   )
 )
)
;; 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))
   )
 )
)

;;; Crée une entité (polyligne ou boite) figurant la "bounding box" de l'objet sélectionné.
;;; l'emprise des attributs (constant ou éditables) n'est pas prise en compte.

(defun c:bbox (/       bbox_err	       AcDoc   Space   obj     att_lst def ent
       bb      minpoint	       maxpoint	       pt1     pt2
       pt3     pt4     line    lst     ucszdir pline   box
       cen     norm
      )
 (vl-load-com)

 (defun bbox_err (msg)
   (if	(or
  (= msg "Fonction annulée")
  (= msg "quitter / sortir abandon")
)
     (princ)
     (princ (strcat "\nErreur: " msg))
   )
   (vla-endundomark
     (vla-get-activedocument (vlax-get-acad-object))
   )
   (setq *error* m:err
  m:err	nil
   )
   (princ)
 )

 (setq	AcDoc	(vla-get-activedocument (vlax-get-acad-object))
Space	(if (= (getvar "CVPORT") 1)
	  (vla-get-PaperSpace AcDoc)
	  (vla-get-ModelSpace AcDoc)
	)
m:err	*error*
*error*	bbox_err
 )
 (vla-startUndoMark AcDoc)
 (while (not (setq obj (car (entsel)))))
 (setq obj (vlax-ename->vla-object obj))
 (vla-TransformBy obj (UCS2WCSMatrix))
 [surligneur](if (= (vla-get-ObjectName obj) "AcDbBlockReference")
   (progn
     (setq
att_lst	(vl-remove-if
	  '(lambda (x) (= (vla-get-Invisible x) :vlax-true))
	  (vlax-invoke obj 'getattributes)
	)
     )
     (setq def	(vla-item (vla-get-Blocks AcDoc)
		  (if (vlax-property-available-p
			obj
			'EffectiveName
		      )
		    (vla-get-EffectiveName obj)
		    (vla-get-Name obj)
		  )
	)
     )
     (repeat (setq n (vla-get-count def))
(setq ent (vla-item def (setq n (1- n))))
(if (and (= (vla-get-ObjectName ent) "AcDbAttributeDefinition")
	 (= (vla-get-Invisible ent) :vlax-false)
	 (= (vla-get-Constant ent) :vlax-true)
    )
  (setq att_lst (cons ent att_lst))
)
     )
   )
 )
 (if att_lst
   (foreach att att_lst (vla-put-Invisible att :vlax-true))
 )[/surligneur]
 (setq	bb (vl-catch-all-apply
     'vla-getboundingbox
     (list obj
	   'minpoint
	   'maxpoint
     )
   )
 )
 [surligneur](if att_lst
   (foreach att att_lst (vla-put-Invisible att :vlax-false))
 )[/surligneur]
 (if (vl-catch-all-error-p bb)
   (progn
     (princ
(strcat "; erreur: " (vl-catch-all-error-message bb))
     )
     (vla-TransformBy obj (WCS2UCSMatrix))
   )
   (progn
     (setq pt1	(vlax-safearray->list minpoint)
    pt2	(vlax-safearray->list maxpoint)
     )
     (if (equal (caddr pt1) (caddr pt2) 1e-007)
(progn
  (setq line (vla-addLine Space minpoint maxpoint))
  (mapcar '(lambda (x) (vla-TransformBy x (WCS2UCSMatrix)))
	  (list obj line)
  )
  (setq	pt1	(trans (vlax-curve-getStartPoint line) 0 1)
	pt3	(trans (vlax-curve-getEndPoint line) 0 1)
	pt2	(list (car pt3) (cadr pt1))
	pt4	(list (car pt1) (cadr pt3))
	lst	(list pt1 pt2 pt3 pt4)
	ucszdir	(trans '(0 0 1) 1 0 T)
	lst	(apply 'append
		       (mapcar
			 '(lambda (x)
			    (setq x (trans x 1 ucszdir))
			    (list (car x) (cadr x))
			  )
			 lst
		       )
		)
	pline	(vlax-invoke Space 'addLightweightPolyline lst)
  )
  (vla-put-Closed pline T)
  (vla-put-Elevation
    pline
    (- (caddr pt1) (caddr (trans '(0 0) 0 1)))
  )
  (if (= (vla-get-ObjectName obj) "AcDbText")
    (vla-Move
      pline
      (vlax-3d-point (trans '(0 0 0) 1 0))
      (vlax-3d-point
	(trans
	  (list
	    0
	    0
	    (caddr (trans (vlax-get obj 'InsertionPoint) 0 1))
	  )
	  1
	  0
	)
      )
    )
  )
  (vla-delete line)
)
(progn
  (setq	cen (mapcar '(lambda (x y) (/ (+ x y) 2)) pt1 pt2)
	pt2 (mapcar '- pt2 pt1)
	box (vla-addBox
	      Space
	      (vlax-3d-point cen)
	      (car pt2)
	      (cadr pt2)
	      (caddr pt2)
	    )
  )
  (if (= (vla-get-ObjectName obj) "AcDbText")
    (progn
      (setq norm (vlax-get obj 'Normal)
      )
      (vla-Move
	box
	(vlax-3d-point (trans '(0 0 0) norm 0))
	(vlax-3d-point
	  (trans
	    (list
	      0
	      0
	      (caddr
		(trans (vlax-get obj 'InsertionPoint)
		       0
		       norm
		)
	      )
	    )
	    norm
	    0
	  )
	)
      )
    )
  )
  (mapcar '(lambda (x) (vla-TransformBy x (WCS2UCSMatrix)))
	  (list obj box)
  )
)
     )
   )
 )
 (vla-endUndoMark AcDoc)
 (setq	*error*	m:err
m:err nil
 )
 (princ)
)

ElpanovEvgeniy · le 27 octobre 2006

;; Doug C. Broad, Jr.
;; can be used with vla-transformby to
;; 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))
   )
 )
)
;; 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))
   )
 )
)

(append
 (mapcar
   '(lambda (vector origin)
      (append (trans vector 1 0 t) (list origin))
    ) ;_  lambda
   (list '(1 0 0) '(0 1 0) '(0 0 1))
   (trans '(0 0 0) 0 1)
 ) ;_  mapcar
 (list '(0 0 0 1))
) ;_  append
=  (Est toujours égal!)
(append
 (mapcar
   '(lambda (vector origin)
      (append (trans vector 0 1 t) (list origin))
    ) ;_  lambda
   (list '(1 0 0) '(0 1 0) '(0 0 1))
   (trans '(0 0 0) 1 0)
 ) ;_  mapcar
 (list '(0 0 0 1))
) ;_  append
=  (Est toujours égal!)
'((1.0 0.0 0.0 0.0) (0.0 1.0 0.0 0.0) (0.0 0.0 1.0 0.0) (0 0 0 1))

Autrement dit...

(UCS2WCSMatrix)
=
(WCS2UCSMatrix)
=
(vlax-tmatrix'((1.0 0.0 0.0 0.0) (0.0 1.0 0.0 0.0) (0.0 0.0 1.0 0.0) (0 0 0 1)))

Tramber · le 27 octobre 2006

Desvidania ! Kak dila ?

Alors, non content de parler anglais sur le Swamp, tu parles aussi Francais ????

Tramber, Call'me-bert sur le Swamp.

sergeluc · le 27 octobre 2006

bienvenue ElpanovEvgeniy (chouette , une autre grosse pointure )

merci Gile mais les attributs sont toujours pris en compte dans la boundingbox.

Ci-dessous une définition d'un des attributs qui embète tout le monde :

DEFINITION DES ATTRIBUTS Calque: "HYRREP"

Espace: Espace objet

Maintien = 491

Style = "Standard"

Fichier de polices = txt

départ point, X= 215.4429 Y= 163.5739 Z= 0.0000

hauteur 0.1000

par défaut

message (_mes_dwg "hy" 1)

étiquette REP

rotation angle 0

largeur facteur d'échelle 1.0000

inclinaison angle 0

drapeaux normal(e)

génération normal(e)

(gile) · le 27 octobre 2006

Salut Evgeniy,

C'est un plaisir de te lire ici et je suis heureux de pouvoir te dire en français toute l'admiration que j'ai pour ton style.

Je ne suis pas d'accord avec toi, le résultat retourné par les deux expressions n'est égal que si le SCU est identique au SCG.

Commande: _ucs

Nom du SCU courant: *GENERAL*
Spécifiez l'origine du SCU ou
[Face/NOMmé/OBjet/Précédent/Vue/Général/X/Y/Z/axEZ] : 100,50

Spécifiez un point sur l'axe X ou : 10

Spécifiez un point sur le plan XY ou :

Commande: 'VLIDE
Commande:
Commande: (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))
(_> )
((0.866025 0.5 0.0 -111.603) (-0.5 0.866025 0.0 6.69873) (0.0 0.0 1.0 0.0) (0 0 0 1))

Commande: 'VLIDE
Commande:
Commande: (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))
(_> )
((0.866025 -0.5 0.0 100.0) (0.5 0.866025 0.0 50.0) (0.0 0.0 1.0 0.0) (0 0 0 1))

Pour sergluc,

Je ne comprends pas, chez moi ça marche.

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

ElpanovEvgeniy · le 28 octobre 2006

Je ne suis pas d'accord avec toi, le résultat retourné par les deux expressions n'est égal que si le SCU est identique au SCG.

:exclam:

M'excusez!

Probablement, je non ai compris exactement la tвche...

Votre code travaille exactement!

(gile) · le 21 janvier 2007

Le code de la version "standard" a été un peu modifié :

Réparé un bug concernant les objets 2D des plans YZ et ZX du SCU courant..

Tous les objets 2D contenus dans les plans XY, YZ et ZX du SCU courant (boundingbox plane) sont désormais traités de la même manière : avec une poly 3D plane.

Connexion

boundingbox

Messages recommandés

zebulon_

(gile)

(gile)

(gile)

(gile)

zebulon_

(gile)

Patrick_35

zebulon_

Patrick_35

(gile)

sergeluc

(gile)

sergeluc

(gile)

ElpanovEvgeniy

Tramber

sergeluc

(gile)

ElpanovEvgeniy

(gile)

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante