Aller au contenu

Sélection bloc par valeur d'attribut


Begood

Messages recommandés

Bonjour,

Je souhaitais pouvoir sélectionner un ou plusieurs blocs selon la valeur d'un attribut et j'ai trouvé cette routine sur le net :

 

;; Select Blocks by Attribute Value  -  Lee Mac
;; Selects all attributed blocks in the current layout which contain a specified attribute value.

(defun c:selblkbyattval ( / att atx ent idx sel str )
   (if (/= "" (setq str (strcase (getstring t "\nEntrez la valeur de l'attribut: "))))
       (if (and
               (setq sel
                   (ssget "_X"
                       (list '(0 . "INSERT") '(66 . 1)
                           (if (= 1 (getvar 'cvport))
                               (cons 410 (getvar 'ctab))
                              '(410 . "Model")
                           )
                       )
                   )
               )
               (progn
                   (repeat (setq idx (sslength sel))
                       (setq ent (ssname sel (setq idx (1- idx)))
                             att (entnext ent)
                             atx (entget  att)
                       )
                       (while
                           (and (= "ATTRIB" (cdr (assoc 0 atx)))
                                (not (wcmatch (strcase (cdr (assoc 1 atx))) str))
                           )
                           (setq att (entnext att)
                                 atx (entget  att)
                           )
                       )
                       (if (= "SEQEND" (cdr (assoc 0 atx)))
                           (ssdel ent sel)
                       )
                   )
                   (< 0 (sslength sel))
               )
           )
           (sssetfirst nil sel)
           (princ (strcat "\nAucun bloc trouvé avec la valeur d'attribut \"" str "\"."))
       )
   )
   (princ)
)

 

(J'ai traduit les textes)

Elle fonctionne parfaitement mais j'aimerais bien la personnaliser un peu.

Je voudrais effectuer un zoom sur le ou les objets sélectionnés grâce à cette fonction, j'ai donc rajouté à la fin :

 

(command "zoom" "o")
(command)

 

Le problème c'est que je perds la sélection en cours.

Si je tape "select" et "p" je sélectionne à nouveau le ou les blocs recherchés

Alors je rajoute ça :

 

(command "select" "p")

 

Mais ça ne fonctionne pas, ça me sélectionne tous mes blocs et non ceux recherchés avec la fonction.

 

Une idée ?

Merci d'avance.

David

Lien vers le commentaire
Partager sur d’autres sites

Re,

Merci pour la réponse rapide ;)

 

La routine de (gile) pour la sélection par attribut ne convient pas pour ce que je veux faire (je l'ai testé).

J'ai juste besoin de rechercher par la valeur d'attribut, peu importe l'étiquette.

 

Pour ce qui est du zoom, la commande "zoom" "o" fonctionne très bien, le problème c'est que je perds la sélection.

Je voudrais juste pouvoir re-sélectionner le jeu de sélection précédent.

Lien vers le commentaire
Partager sur d’autres sites

Salut

 

Avec les éléments que j'avais donné

(defun c:selblkbyattval ( / att atx ent idx sel str )
   (if (/= "" (setq str (strcase (getstring t "\nEntrez la valeur de l'attribut: "))))
       (if (and
               (setq sel
                   (ssget "_X"
                       (list '(0 . "INSERT") '(66 . 1)
                           (if (= 1 (getvar 'cvport))
                               (cons 410 (getvar 'ctab))
                              '(410 . "Model")
                           )
                       )
                   )
               )
               (progn
                   (repeat (setq idx (sslength sel))
                       (setq ent (ssname sel (setq idx (1- idx)))
                             att (entnext ent)
                             atx (entget  att)
                       )
                       (while
                           (and (= "ATTRIB" (cdr (assoc 0 atx)))
                                (not (wcmatch (strcase (cdr (assoc 1 atx))) str))
                           )
                           (setq att (entnext att)
                                 atx (entget  att)
                           )
                       )
                       (if (= "SEQEND" (cdr (assoc 0 atx)))
                           (ssdel ent sel)
                       )
                   )
                   (< 0 (sslength sel))
               )
           )

;;; Modification by Patrick_35
     (progn
       (zoomobject (mapcar '(lambda(x)(vlax-ename->vla-object (cadr x))) (ssnamex sel)))
       (sssetfirst nil sel)
     )
;;; Fin de la modification by Patrick_35

           (princ (strcat "\nAucun bloc trouvé avec la valeur d'attribut \"" str "\"."))
       )
   )
   (princ)
)

;; ZoomObject Effectue un zoom sur les objets contenus dans la liste
;;
;; Argument
;; objlst : une liste de vla-object
;;
;; Variables
;; dir : normale du plan de la vue courante
;; ang : angle de la vue courante
;; 3x3 : matrice de transformation du SCG vers la vue courante (dimension 3)
;; 4x4 : matrice de transformation du SCG vers la vue courante (dimension 4)
;; ptlst : liste des points minimum et maximum des bounding-boxes des objets sélectionnés (SCG)

(defun ZoomObject (objlst / dir ang 3x3 4x4 ptlst)
 (vl-load-com)
 (setq dir (mapcar '-
                   (trans (getvar "viewdir") 1 0)
                   (trans '(0 0 0) 1 0)
           )
       ang (- (getvar "viewtwist"))
       3x3 (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)
                )
           )
       4x4 (append
             (mapcar
               '(lambda (v o)
                  (append v (list o))
                )
               3x3
               '(0 0 0)
             )
             (list '(0 0 0 1))
           )
 )
 (foreach obj objlst
   (vla-TransformBy obj (vlax-tmatrix (trp 4x4)))
   (vla-getBoundingBox obj 'minpt 'maxpt)
   (vla-TransformBy obj (vlax-tmatrix 4x4))
   (setq ptlst (cons (vlax-safearray->list minpt)
                     (cons (vlax-safearray->list maxpt) ptlst)
               )
   )
 )
 (vla-ZoomWindow
   (vlax-get-acad-object)
   (vlax-3d-point (mxv 3x3 (apply 'mapcar (cons 'min ptlst))))
   (vlax-3d-point (mxv 3x3 (apply 'mapcar (cons 'max ptlst))))
 )
)

;; transpose une matrice Doug Wilson

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

;; Apply a transformation matrix to a vector by Vladimir Nesterovsky

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

;; Multiply two matrices by Vladimir Nesterovsky

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

 

@+

Les Lisps de Patrick

Le but n'est pas toujours placé pour être atteint, mais pour servir de point de mire.

Joseph Joubert, 1754-1824

Lien vers le commentaire
Partager sur d’autres sites

Merci beaucoup Patrick_35.

La routine fonctionne impec, c'est du bonheur !

 

Merci d'avoir mis en application le ZoomObject de (gile), je n'y serais pas arrivé, trop compliqué pour moi...

 

Je précise aussi pour ceux que ça intéresse que cette fonction de recherche est compatible avec la recherche multiple et la recherche partielle.

 

Exemples :

Vous recherchez l'attribut B001, entrez :

B001

Vous recherchez les attributs B001 et B002, entrez :

B001,B002

Vous recherchez les attributs qui commencent par B, entrez :

B*

Vous recherchez les attributs qui contiennent 00, entrez :

*00*

 

Autre info importante, la fonction ne tient pas compte de la casse.

 

Exemple :

Vous recherchez l'attribut B001, vous pouvez entrer :

b001

 

 

Merci encore ;)

++

Lien vers le commentaire
Partager sur d’autres sites

Re,

J'ai cru comprendre qu'avec un fichier d'aide xaml on pouvait ajouter du texte dans l'info bulle au survol du bouton de commande.

 

Je souhaiterai ajouter les exemples ci-dessus mais je n'arrive pas à mettre la main sur la structure de base d'un fichier xaml pour qu'il soit reconnu par Autocad.

 

Merci

Lien vers le commentaire
Partager sur d’autres sites

Coucou

 

Je ne veux en rien minimiser le travail de (gile), patrick_35 et consorts que je respecte (ouf, si c'est pas du politiquement correct ça !)

 

Car je me permets de signaler que la commande RECHERCHER fait la même chose en natif

Une fois que les attributs sont trouvés il est possible d'en faire un jeu de sélection.

 

Je dis ça pour les ceusses qui ont du mal à copier-coller les lisps de nos mentors et qui n'en comprennent pas le code, il devraient tout d'abord utiliser les commandes natives.

 

Amicalement

Lien vers le commentaire
Partager sur d’autres sites

Je ne connaissais pas la commande RECHERCHER, je viens de tester.

 

Elle permet effectivement de chercher la valeur d'un attribut mais je n'arrive pas à effectuer une recherche multiple.

Le résultat de la recherche ne sélectionne pas le bloc mais surligne juste la valeur recherchée. Pour une sélection il est nécessaire de cliquer sur un bouton.

 

La recherche est aussi partielle par défaut, pas pratique pour une recherche ciblée.

 

Après plusieurs tests, la routine est bien meilleure pour mes besoins.

Merci quand même pour le tuyau, ça peut toujours servir.

Lien vers le commentaire
Partager sur d’autres sites

Re,

@ Patrick_35,

J'ai voulu installé la routine sur le poste d'un collègue qui est sous 2013 et ça ne fonctionne pas, j'ai le message d'erreur suivant :

; erreur: no function definition: VLAX-ENAME->VLA-OBJECT

 

Est-ce qu'il est possible de la faire fonctionner quand même ?

Merci

Lien vers le commentaire
Partager sur d’autres sites

Super merci, ça fonctionne.

 

Voici la routine mise à jour pour ceux que ça intéresse :

 

;; Select Blocks by Attribute Value  -  Lee Mac
;; Selects all attributed blocks in the current layout which contain a specified attribute value.

(defun c:selblkbyattval ( / att atx ent idx sel str )
(vl-load-com)
(if (/= "" (setq str (strcase (getstring t "\nEntrez la ou les valeurs de l'attribut (Séparez les valeurs par une virgule) : "))))
	(if (and
			(setq sel
				(ssget "_X"
					(list '(0 . "INSERT") '(66 . 1)
						(if (= 1 (getvar 'cvport))
							(cons 410 (getvar 'ctab))
						   '(410 . "Model")
						)
					)
				)
			)
			(progn
				(repeat (setq idx (sslength sel))
					(setq ent (ssname sel (setq idx (1- idx)))
						  att (entnext ent)
						  atx (entget  att)
					)
					(while
						(and (= "ATTRIB" (cdr (assoc 0 atx)))
							 (not (wcmatch (strcase (cdr (assoc 1 atx))) str))
						)
						(setq att (entnext att)
							  atx (entget  att)
						)
					)
					(if (= "SEQEND" (cdr (assoc 0 atx)))
						(ssdel ent sel)
					)
				)
				(< 0 (sslength sel))
			)
		)

;;; Modification by Patrick_35
		 (progn
		   (zoomobject (mapcar '(lambda(x)(vlax-ename->vla-object (cadr x))) (ssnamex sel)))
		   (sssetfirst nil sel)
		 )
;;; Fin de la modification by Patrick_35

		(princ (strcat "\nAucun bloc trouvé avec la valeur d'attribut \"" str "\"."))
	)
)
(princ)
)

;; ZoomObject Effectue un zoom sur les objets contenus dans la liste
;;
;; Argument
;; objlst : une liste de vla-object
;;
;; Variables
;; dir : normale du plan de la vue courante
;; ang : angle de la vue courante
;; 3x3 : matrice de transformation du SCG vers la vue courante (dimension 3)
;; 4x4 : matrice de transformation du SCG vers la vue courante (dimension 4)
;; ptlst : liste des points minimum et maximum des bounding-boxes des objets sélectionnés (SCG)

(defun ZoomObject (objlst / dir ang 3x3 4x4 ptlst)
 (vl-load-com)
 (setq dir (mapcar '-
				(trans (getvar "viewdir") 1 0)
				(trans '(0 0 0) 1 0)
		)
	ang (- (getvar "viewtwist"))
	3x3 (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)
			 )
		)
	4x4 (append
		  (mapcar
			'(lambda (v o)
			   (append v (list o))
			 )
			3x3
			'(0 0 0)
		  )
		  (list '(0 0 0 1))
		)
 )
 (foreach obj objlst
(vla-TransformBy obj (vlax-tmatrix (trp 4x4)))
(vla-getBoundingBox obj 'minpt 'maxpt)
(vla-TransformBy obj (vlax-tmatrix 4x4))
(setq ptlst (cons (vlax-safearray->list minpt)
				  (cons (vlax-safearray->list maxpt) ptlst)
			)
)
 )
 (vla-ZoomWindow
(vlax-get-acad-object)
(vlax-3d-point (mxv 3x3 (apply 'mapcar (cons 'min ptlst))))
(vlax-3d-point (mxv 3x3 (apply 'mapcar (cons 'max ptlst))))
 )
)

;; transpose une matrice Doug Wilson

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

;; Apply a transformation matrix to a vector by Vladimir Nesterovsky

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

;; Multiply two matrices by Vladimir Nesterovsky

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

Lien vers le commentaire
Partager sur d’autres sites

  • 11 mois après...

Bonjour à tous,

Je souhaiterai pourvoir fixer le nom des blocs recherchés dans ce lisp afin que la fonction ne recherche par exemple que les blocs nommés "Bulle" avec l'attribut "30".

 

J'ai fais quelques recherches et j'ai vu qu'il fallait rajouter (2 . "Bulle") après (0 . "INSERT") mais ça ne fonctionne pas.

 

Est-ce que l'on peut définir plusieurs noms comme "Bulle" et "Bulle Alu" ?

 

Merci.

Lien vers le commentaire
Partager sur d’autres sites

Salut

 

Pour la valeur de l'attribut, tu remplaces

(setq str (strcase (getstring t "\nEntrez la ou les valeurs de l'attribut (Séparez les valeurs par une virgule) : ")))

par

(setq str (strcase "30"))

 

Et pour sélectionner le bon bloc, tu remplaces

(list '(0 . "INSERT") '(66 . 1)

par

(list '(0 . "INSERT") '(66 . 1) '(2 . "Bulle")

 

@+

Les Lisps de Patrick

Le but n'est pas toujours placé pour être atteint, mais pour servir de point de mire.

Joseph Joubert, 1754-1824

Lien vers le commentaire
Partager sur d’autres sites

Re,

Pour l'attribut "30" c'était juste un exemple, je souhaite conserver l'invite de valeur d'attribut, c'est tout l'intérêt de ce lisp.

 

Mais pour le nom de bloc j'ai bien rajouté

'(2 . "Bulle")

et ça ne fonctionne pas, j'ai la réponse : Aucun bloc trouvé avec la valeur d'attribut "XXX".

 

Mes blocs sont bien nommés "Bulle", peut-être parce que ce sont des blocs dynamiques ?

Lien vers le commentaire
Partager sur d’autres sites

Salut,

 

Quand on modifie les propriétés dynamiques d'un bloc dynamique, AutoCAD crée une nouvelle définition de bloc anonyme : *Uxxx.

On ne peut donc pas directement filtrer une sélection de blocs dynamiques avec le nom du bloc.

Tu peux sélectionner tous les blocs "Bulle" et les blocs anonymes de l'espace courant et, dans la boucle (repeat ...) ne traiter que les blocs dont le "nom effectif" est : "Bulle".

 

(if (and
     (setq sel
            (ssget "_X"
                   (list '(0 . "INSERT")
                         '(2 . "Bulle,`*U*")
                         '(66 . 1)
                         (cons 410 (getvar 'ctab))
                   )
            )
     )
     (repeat (setq idx (sslength sel))
       (setq ent (ssname sel (setq idx (1- idx))))
       (if (= (vla-get-EffectiveName ent) "Bulle")
         (progn
          ;; ...
         )
       )
     )
   )
)

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

Lien vers le commentaire
Partager sur d’autres sites

Bonjour à tous,

Merci Gilles pour le coup de main.

J'ai ajouté cette portion de code et j'obtiens l'erreur suivante :

; erreur: type d'argument incorrect: VLA-OBJECT <Nom d'entité: 187dc3c1f50>

 

Voici le lisp complet au cas où j'aurais fait une erreur :

 

;; Select Blocks by Attribute Value  -  Lee Mac
;; Selects all attributed blocks in the current layout which contain a specified attribute value.

(defun c:selblkbyattval ( / att atx ent idx sel str )
(vl-load-com)
(if (/= "" (setq str (strcase (getstring t "\nEntrez la ou les valeurs de l'attribut (Séparez les valeurs par une virgule) : "))))
		(if (and
				(setq sel
					(ssget "_X"
						(list '(0 . "INSERT")
							'(2 . "Bulle,`*U*")
							'(66 . 1)
							(cons 410 (getvar 'ctab))
						)
					)
				)
				(repeat (setq idx (sslength sel))
					(setq ent (ssname sel (setq idx (1- idx))))
					(if (= (vla-get-EffectiveName ent) "Bulle")
						(progn
							(repeat (setq idx (sslength sel))
								(setq ent (ssname sel (setq idx (1- idx)))
									  att (entnext ent)
									  atx (entget  att)
								)
								(while
									(and (= "ATTRIB" (cdr (assoc 0 atx)))
										 (not (wcmatch (strcase (cdr (assoc 1 atx))) str))
									)
									(setq att (entnext att)
										  atx (entget  att)
									)
								)
								(if (= "SEQEND" (cdr (assoc 0 atx)))
									(ssdel ent sel)
								)
							)
							(< 0 (sslength sel))
						)
					)
				)
			)

;;; Modification by Patrick_35
		 (progn
		   (zoomobject (mapcar '(lambda(x)(vlax-ename->vla-object (cadr x))) (ssnamex sel)))
		   (sssetfirst nil sel)
		 )
;;; Fin de la modification by Patrick_35

		(princ (strcat "\nAucun bloc trouvé avec la valeur d'attribut \"" str "\"."))
	)
)
(princ)
)

;; ZoomObject Effectue un zoom sur les objets contenus dans la liste
;;
;; Argument
;; objlst : une liste de vla-object
;;
;; Variables
;; dir : normale du plan de la vue courante
;; ang : angle de la vue courante
;; 3x3 : matrice de transformation du SCG vers la vue courante (dimension 3)
;; 4x4 : matrice de transformation du SCG vers la vue courante (dimension 4)
;; ptlst : liste des points minimum et maximum des bounding-boxes des objets sélectionnés (SCG)

(defun ZoomObject (objlst / dir ang 3x3 4x4 ptlst)
 (vl-load-com)
 (setq dir (mapcar '-
				(trans (getvar "viewdir") 1 0)
				(trans '(0 0 0) 1 0)
		)
	ang (- (getvar "viewtwist"))
	3x3 (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)
			 )
		)
	4x4 (append
		  (mapcar
			'(lambda (v o)
			   (append v (list o))
			 )
			3x3
			'(0 0 0)
		  )
		  (list '(0 0 0 1))
		)
 )
 (foreach obj objlst
(vla-TransformBy obj (vlax-tmatrix (trp 4x4)))
(vla-getBoundingBox obj 'minpt 'maxpt)
(vla-TransformBy obj (vlax-tmatrix 4x4))
(setq ptlst (cons (vlax-safearray->list minpt)
				  (cons (vlax-safearray->list maxpt) ptlst)
			)
)
 )
 (vla-ZoomWindow
(vlax-get-acad-object)
(vlax-3d-point (mxv 3x3 (apply 'mapcar (cons 'min ptlst))))
(vlax-3d-point (mxv 3x3 (apply 'mapcar (cons 'max ptlst))))
 )
)

;; transpose une matrice Doug Wilson

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

;; Apply a transformation matrix to a vector by Vladimir Nesterovsky

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

;; Multiply two matrices by Vladimir Nesterovsky

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

 

Merci

Lien vers le commentaire
Partager sur d’autres sites

Dans ton code, tu remplaces :

(= (vla-get-EffectiveName ent) "Bulle")

par:

(= (vla-get-EffectiveName (vlax-ename->vla-object ent)) "Bulle")

 

Oui, ça c'est fait et j'obtiens cette erreur :

; erreur: type d'argument incorrect: lentityp nil

 

Et concernant ta réponse "Probablement ent qui est nil", je ne sais pas l'interpréter, je ne sais pas ce qu'il faut modifier.

Lien vers le commentaire
Partager sur d’autres sites

;; Select Blocks by Attribute Value  -  Lee Mac
;; Selects all attributed blocks in the current layout which contain a specified attribute value.

(defun c:selblkbyattval (/ att atx ent idx sel str)
 (vl-load-com)
 (if (/= ""
         (setq str (strcase
                     (getstring t "\nEntrez la ou les valeurs de l'attribut (Séparez les valeurs par une virgule) : ")
                   )
         )
     )
   (if (and
         (setq sel
                (ssget "_X"
                       (list '(0 . "INSERT")
                             '(2 . "Bulle,`*U*")
                             '(66 . 1)
                             (cons 410 (getvar 'ctab))
                       )
                )
         )
         (progn
           (repeat (setq idx (sslength sel))
             (setq ent (ssname sel (setq idx (1- idx))))
             (if (= (vla-get-Effectivename (vlax-ename->vla-object ent)) "Bulle")
               (progn
                 (setq att (entnext ent)
                       atx (entget att)
                 )
                 (while
                   (and (= "ATTRIB" (cdr (assoc 0 atx)))
                        (not (wcmatch (strcase (cdr (assoc 1 atx))) str))
                   )
                    (setq att (entnext att)
                          atx (entget att)
                    )
                 )
                 (if (= "SEQEND" (cdr (assoc 0 atx)))
                   (ssdel ent sel)
                 )
               )
             )
           )
           (< 0 (sslength sel))
         )
       )

;;; Modification by Patrick_35
     (progn
       (zoomobject (mapcar '(lambda (x) (vlax-ename->vla-object (cadr x))) (ssnamex sel)))
       (sssetfirst nil sel)
     )
;;; Fin de la modification by Patrick_35

     (princ (strcat "\nAucun bloc trouvé avec la valeur d'attribut \"" str "\"."))
   )
 )
 (princ)
)

;; ZoomObject Effectue un zoom sur les objets contenus dans la liste
;;
;; Argument
;; objlst : une liste de vla-object
;;
;; Variables
;; dir : normale du plan de la vue courante
;; ang : angle de la vue courante
;; 3x3 : matrice de transformation du SCG vers la vue courante (dimension 3)
;; 4x4 : matrice de transformation du SCG vers la vue courante (dimension 4)
;; ptlst : liste des points minimum et maximum des bounding-boxes des objets sélectionnés (SCG)

(defun ZoomObject (objlst / dir ang 3x3 4x4 ptlst)
 (vl-load-com)
 (setq dir (mapcar '-
                   (trans (getvar "viewdir") 1 0)
                   (trans '(0 0 0) 1 0)
           )
       ang (- (getvar "viewtwist"))
       3x3 (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)
                )
           )
       4x4 (append
             (mapcar
               '(lambda (v o)
                  (append v (list o))
                )
               3x3
               '(0 0 0)
             )
             (list '(0 0 0 1))
           )
 )
 (foreach obj objlst
   (vla-TransformBy obj (vlax-tmatrix (trp 4x4)))
   (vla-getBoundingBox obj 'minpt 'maxpt)
   (vla-TransformBy obj (vlax-tmatrix 4x4))
   (setq ptlst (cons (vlax-safearray->list minpt)
                     (cons (vlax-safearray->list maxpt) ptlst)
               )
   )
 )
 (vla-ZoomWindow
   (vlax-get-acad-object)
   (vlax-3d-point (mxv 3x3 (apply 'mapcar (cons 'min ptlst))))
   (vlax-3d-point (mxv 3x3 (apply 'mapcar (cons 'max ptlst))))
 )
)

;; transpose une matrice Doug Wilson

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

;; Apply a transformation matrix to a vector by Vladimir Nesterovsky

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

;; Multiply two matrices by Vladimir Nesterovsky

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

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

Lien vers le commentaire
Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité