(gile)

Re, J'ai trouvé comment faire un test logique en diesel pour ne rajouter le bit 32 que s'il n'est pas déjà présent, j'ai aussi mis la commande transparente comme le suggérait judicieusement Didier : 'osmode;$M=$(if,$(=,$(xor,$(getvar,osmode),32),$(+,$(getvar,osmode),32)),$(+,$(getvar,osmode),32),$(getvar,osmode)); Je trouve quand même le diesel "lourdingue" par rapport au LISP : (if (zerop (logand (getvar "osmode") 32)) (setvar "osmode" (+ (getvar "osmode") 32)) )

Salut Doberman, Si je comprends bien ce que tu décris, c'est comme si tu faisais ton wbloc sur le dessin entier. Donc, quand tu insères ton bloc, tu insères un bloc dans lequel le bloc dynamique est imbriqué, et c'est pour ça que tu dois l'exploser pour retrouver le bloc dynamique. Dans la fenêtre "Créer un fichier bloc" il faut cocher "Bloc" et choisir ton bloc dans la liste déroulante. http://img134.imageshack.us/img134/7769/wblocqk0.png

Re, En LISP, je ne connais pas le VBA. La polyligne optimisée est créée dans le plan défini par les trois premiers points non colinéaires de la poly 3d et à l'élévation du premier point (au cas ou la poly 3D ne serait pas plane). ;;;**** SOUS-ROUTINES ****;;; ;;; 3d-coord->pt-lst Convertit une liste de coordonnées 3D en liste de points ;;; (3d-coord->pt-lst '(1.0 2.0 0.0 4.0 5.0 0.0)) -> ((1.0 2.0 0.0) (4.0 5.0 0.0)) (defun 3d-coord->pt-lst (lst) (cond ((atom lst) lst) ((cons (list (car lst) (cadr lst) (caddr lst)) (3d-coord->pt-lst (cdddr lst)) ) ) ) ) ;;; V^V Retourne le produit vectoriel de deux vecteurs (defun v^v (v1 v2) (if (inters '(0 0 0) v1 '(0 0 0) v2) (mapcar '(lambda (a b c d) (- (* a b) (* c d))) (reverse (cons (car v1) (reverse (cdr v1)))) (cons (last v2) (reverse (cdr (reverse v2)))) (reverse (cons (car v2) (reverse (cdr v2)))) (cons (last v1) (reverse (cdr (reverse v1)))) ) ) ) ;;; NORM_3PTS retourne le vecteur normal du plan défini par 3 points (defun norm_3pts (org xdir ydir / norm) (foreach v '(xdir ydir) (set v (mapcar '- (eval v) org)) ) (mapcar '(lambda (x) (/ x (distance '(0 0 0) norm))) (setq norm (v^v xdir ydir)) ) ) ;;; GETSPACE Retourne l'espace courant (Modèle ou Papier) (defun getspace () (if (= (getvar "CVPORT") 1) (vla-get-PaperSpace (vla-get-activedocument (vlax-get-acad-object)) ) (vla-get-ModelSpace (vla-get-activedocument (vlax-get-acad-object)) ) ) ) ;;;**** ROUTINE PRINCIPALE ****;;; ;;; 3D2LW Crée une lwpolyligne sur une poly 3D plane (defun c:3d2lw (/ ss ent p1 p2 p3 n pt_lst norm elev pt) ;; Sélection d'une polyligne 3D (while (not (setq ss (ssget "_:S:E" '((0 . "POLYLINE") (-4 . "&") (70 . 9) ) ) ) ) ) ;; ent : 3Dpolyline object (setq ent (vlax-ename->vla-object (ssname ss 0))) ;; pt_lst : liste des sommets de la polyligne 3D (setq pt_lst (3d-coord->pt-lst (vlax-get ent 'coordinates))) ;; p1 : premier sommet de la polyligne 3D (setq p1 (car pt_lst)) ;; p2 : second sommet de la polyligne 3D (setq p2 (cadr pt_lst)) ;; p3 = p2 -temporaire- (setq p3 p2) ;; n : compteur (setq n 1) ;; on cherche p3 tel qu'il ne soit pas colinéaire avec le segment p1 p2 (while (and ( (not (inters p1 p2 p1 p3)) ) (setq p3 (nth (setq n (1+ n)) pt_lst)) ) ;; norm : normale du plan -la sous routine norm_3pts est définie plus haut- (setq norm (norm_3pts p1 p2 p3)) ;; elev : la coordonnée z de la traduction de 0,0,0 du SCG vers le SCO de la poly ;; oté de la coordonnée z de la traduction de p1 du SCG vers le SCO de la poly (setq elev (- (caddr (trans p1 0 norm)) (caddr (trans '(0 0) 0 norm))) ) ;; transformation de la liste des sommets de la poly 3D en liste de coordonnées 2D ;; dans le SCO (argument pour addLightWeightPolyline) (setq pt_lst (apply 'append (mapcar '(lambda (pt) (list (car (trans pt 0 norm)) (cadr (trans pt 0 norm))) ) pt_lst ) ) ) ;; début du groupe d'annulation (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)) ) ;; création de la lwpolyligne (setq pline (vlax-invoke (getspace) 'addLightWeightPolyline pt_lst) ) ;; Changement de la Normale de la lwpolyligne (vla-put-Normal pline (vlax-3d-point norm)) ;; Changement de l'élévation (vla-put-Elevation pline elev) ;; fermeture de la polyligne (if (= (vla-get-closed ent) :vlax-true) (vla-put-closed pline :vlax-true) ) ;; Si on veut supprimer la poly 3D : oter les points virgule ;; (vl-delete ent) ;; fin du groupe d'annulation (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)) ) (princ) ) (princ "\n3d2lw chargé. Taper 3d2lw pour lancer la commande." ) (princ) [Edité le 18/8/2006 par (gile)]

Salut, Je ne suis pas sûr de bien comprendre, veux-tu aligner ta poly sur un autre plan, ou la projeter sur ce plan ? Dans le premier cas, la commande _align ou, en VBA/Vlisp la méthode TransformBy (voir cesujet) devraient faire l'affaire. Dans le deuxième cas, il faut effectivement projeter chaque sommet sur le plan, ce qui, en programmation n'est "fastidieux" qu'une fois.

Mais justement, avec la macro proposée, ma réponse sera : les bits actifs + le bit 32 Si par exemple les bits actifs sont 1 2 et 4, osmode est à 7 lancer la macro ajoute 32 à 7 osmode passe à 39. Mais si on relance la macro, en ajoutant une nouvelle fois 32 on active le bit 64 et on désactive donc 32.

Chapitre 2 (qui aurait du être le chapitre 1) Petit rappel succinct sur les matrices. Une matrice est un tableau de nombres, une matrice de dimension MxN comporte M rangées (ou lignes) et N colonnes. Les matrices permettent de ramener à des opérations sur les nombres les fonctions linéaires (ex: rotation, translation, changement d'échelle), de la même façon qu'un système de coordonnées permet de ramener à des opérations sur les nombres les opérations vectorielles (addition/soustraction de vecteurs, multiplication scalaire, multiplication vectorielle). Les matrices de tranformations utilisées en VisualLISP (ou en VBA), sous forme de variant, avec la méthode TransformBy sont des matrices carrées de dimension 4x4 se présentant sous la forme : R00 R01 R02 T0 R10 R11 R12 T1 R20 R21 R22 T2 0 0 0 1 où R* représente une rotation (et/ou mise à l'échelle) et T* une translation. R00 R01 R02 sont les coordonnées x y z du vecteur de transformation en échelle et rotation par rapport à l'axe des X du SCG, son sens et sa direction définissent la rotation et sa grandeur, l'échelle. R10 R11 R12 définissent la même chose par rapport à l'axe des Y et R20 R21 R22 par rapport à l'axe Z. T0 T1 T2 définissent le déplacement par rapport au 0 0 0 du SCG Quant à la dernière ligne 0 0 0 1, je ne sais pas à quoi elle correspond, et serais très heureux de l'apprendre. Sert-elle uniquement à faire en sorte que la matrice soit "carrée" ? Quelques exemples : La matrice ne définissant aucune transformation est donc : 1 0 0 0 0 1 0 0 0 0 1 0 0 0 0 1 La matrice définissant un déplacement (translation) de (0 0 0) vers (5 3 0) : 1 0 0 5 0 1 0 3 0 0 1 0 0 0 0 1 La matrice définissant un changement d'échelle uniforme de 1 à 5 : 5 0 0 0 0 5 0 0 0 0 5 0 0 0 0 1 La matrice définissant une rotation de 30° sur l'axe Z (rotation 2D) : 0.866 -0.5 0.0 0.0 0.5 0.866 0.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 0.0 1.0 En LISP, les matrices son représentées par une liste de listes où chaque élement contient les éléments d'une ligne (ou rangée) de la matrice. Cette liste est transformée en variant avec la fonction (vlax-tmatrix ...) pour être passée comme argument de (vla-TransformBy ...). Par exemple la matrice ci dessus s'écrit : ((0.866 -0.5 0.0 0.0) (0.5 0.866 0.0 0.0) (0.0 0.0 1.0 0.0) (0.0 0.0 0.0 1.0)) Exemples de matrices de transformation utlisables avec (vla-TransformBy ...) Corrigé une erreur de signe dans YRotateMatrix le 07/10/06 ;;; [b]ScaleMatrix[/b] Echelle (base scl) (defun ScaleMatrix (base scl) (vlax-tmatrix (append (mapcar '(lambda (v1 v2) (append (mapcar '(lambda (x) (* x scl)) v1) (list v2) ) ) (list '(1 0 0) '(0 1 0) '(0 0 1)) (mapcar '(lambda (x) (- x (* x scl))) base) ) (list '(0 0 0 1)) ) ) ) ;;; [b]MoveMatrix[/b] Déplacement (vec) (defun MoveMatrix (dep) (vlax-tmatrix (append (mapcar '(lambda (v1 v2) (append v1 (list v2)) ) (list '(1 0 0) '(0 1 0) '(0 0 1)) dep ) (list '(0 0 0 1)) ) ) ) ;;; [b]ZRotateMatrix[/b] Rotation sur l'axe Z (base ang) (defun ZRotateMatrix (base ang) (vlax-tmatrix (append (mapcar '(lambda (v1 v2) (append v1 (list v2)) ) (list (list (cos ang) (- (sin ang)) 0) (list (sin ang) (cos ang) 0) '(0 0 1) ) (mapcar '- base (list (* (cos (+ (atan (cadr base) (car base)) ang)) (distance '(0 0 0) (list (car base) (cadr base))) ) (* (sin (+ (atan (cadr base) (car base)) ang)) (distance '(0 0 0) (list (car base) (cadr base))) ) (caddr base) ) ) ) (list '(0 0 0 1)) ) ) ) ;;; [b]XRotateMatrix[/b] Rotation sur l'axe X (base ang) (defun XRotateMatrix (base ang) (vlax-tmatrix (append (mapcar '(lambda (v1 v2) (append v1 (list v2)) ) (list '(1 0 0) (list 0 (cos ang) (- (sin ang))) (list 0 (sin ang) (cos ang)) ) (mapcar '- base (list (car base) (* (cos (+ (atan (caddr base) (cadr base)) ang)) (distance '(0 0 0) (list (cadr base) (caddr base))) ) (* (sin (+ (atan (caddr base) (cadr base)) ang)) (distance '(0 0 0) (list (cadr base) (caddr base))) ) ) ) ) (list '(0 0 0 1)) ) ) ) ;;; [b]YRotateMatrix[/b] Rotation sur l'axe Y (base ang) (defun YRotateMatrix (base ang) (vlax-tmatrix (append (mapcar '(lambda (v1 v2) (append v1 (list v2)) ) (list (list (cos ang) 0 (sin ang)) '(0 1 0) (list (- (sin ang)) 0 (cos ang)) ) (mapcar '- base (list (* (cos (+ (atan (caddr base) (car base)) ang)) (distance '(0 0 0) (list (car base) (caddr base))) ) (cadr base) (* (sin (+ (atan (caddr base) (car base)) ang)) (distance '(0 0 0) (list (car base) (caddr base))) ) ) ) ) (list '(0 0 0 1)) ) ) ) À suivre ?...[Edité le 16/8/2006 par (gile)] [Edité le 7/10/2006 par (gile)]

Salut, je ne suis pas un pro en diesel, mais ça devrait être un truc du style : ^C^Cosmode;$M=$(+,$(getvar,osmode),32); Par contre je ne sais pas si en diesel on peu faire un test pour savoir si le bit 32 n'est pas déjà actif.

Salut, avec une asterisque (*) au début, non ? *^C^C_attdia;0;-inserer;XA_point_trimble;\;;;$M=$(getvar,useri1);modifvar;useri1;$(+,$(getvar,useri2),$(getvar,useri1));;attdia;1;

Merci lecrabe, tu vas me faire rougir ! :red: Je pense que la puissance du LISP réside surtout, dans le cas présent, dans sa capacité à manipuler les listes (et les listes de listes) qui servent à construire la matrice. L'illustration pourrait en être cette expression, un bijou attribuée à Doug Wilson, qui transpose une matrice (sous forme de liste) : (apply 'mapcar (cons 'list m)) Exemple ("matrice du pavé numérique") : (apply 'mapcar (cons 'list '((7 8 9) (4 5 6) (1 2 3)))) retourne ((7 4 1) (8 5 2) (9 6 3)) Tout ça me fait entrevoir que j'ai peut-être mis la charrue avant les boeufs, je n'ai pas expliqué, pour ceux qui ne le save pas (comme moi il y a peu), comment est structurée une matrice de transformation. Ça fera partie du chapitre 2. [Edité le 16/8/2006 par (gile)]

Salut, Je viens de faire un essai, avec un RTEXT à l'intérieur d'un bloc (cartouche) inséré dans l'espace papier et un autre placé ensuite, sur le bloc, fermeture puis ré-ouverture du fichier et tout est toujours en place. Pas de problème chez moi (AutoCAD 2007), et je ne vois pas de solution. :casstet: Désolé ... :(

Salut, SHIFT+clic droit ?

Je ne vais pas faire un cours sur les matrices, j'en serais bien incapable (j'ai quand même essayé de faire un petit topo -CF Réponse N°3 de ce fil). Je me suis un peu penché sur l'utilsation de (vla-TransformBy ...) et donc des matrices de transformation. Cette méthode est utile pour transformer des objets d'un système de coordonnées vers un autre et aussi pour appliquer des fonctions de rotation, de déplacement et de changement d'échelle. J'ai d'abord glané sur le net deux routines de Doug C. Broad, Jr qui retournent les matrices de transformation du SCU courant vers le SCG et inversement (je m'en sert dans ce LISP). ;; Doug C. Broad, Jr. ;; can be used with vla-transformby to ;; [b]UCS2WCSMatrix[/b] 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)) ) ) ) ;; [b]WCS2UCSMatrix[/b] 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)) ) ) ) Pour transformer un vla-object du SCU courant vers le SCG, par exemple, on fait : (vla-TransformBy obj (UCS2WCSMatrix)) J'ai aussi découvert deux petites mais puissantes routines de Vladimir Nesterovsky. La première permet de transformer un vecteur à l'aide d'une matrice, la seconde de multiplier deux matrices, donc de les "combiner". ;; [b]mxv[/b] Apply a transformation matrix to a vector by Vladimir Nesterovsky (defun mxv (m v) (mapcar '(lambda (row) (apply '+ (mapcar '* row v))) m) ) ;; [b]mxm[/b] 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) ) Je me suis donc essayé à définir quelques matrices de tranformation. Avec des SCU "nommés" (enregistrés), la fonction (vla-GetUCSMatrix ...) permet de récupérer la matrice de transformation du SCG vers ce SCU (il faut juste s'assurer que le SCU est bien enregistré). Avec les fonctions de Vladimir, on peut claculer la matrice de transformation inverse : ReverseMatrix (cette routine utilise butlast). Edit : corrigé erreur dans ReverseMatrix (problème d'échelles) le 07/02/07 Edit : supprimé ReverseMatrix et remplacé par InverseMatrix ;;; [b]WCS2NamedUCSMatrix[/b] Retourne la matrice de transformation du SCG vers le SCU nommé [name] (defun WCS2NamedUCSMatrix (name / ucs) (setq ucs (vl-catch-all-apply 'vla-Item (list (vla-get-UserCoordinateSystems (vla-get-ActiveDocument (vlax-get-acad-object)) ) name ) ) ) (if (not (vl-catch-all-error-p ucs)) (vla-GetUCSMatrix ucs) ) ) ;;; [b]butlast[/b] Retourne la liste privée du dernier élément (defun butlast (lst) (reverse (cdr (reverse lst))) ) ;; IMAT ;; Crée une matrice d'identité de dimension n ;; ;; Argument ;; d : la dimension de la matrice (defun Imat (d / i n r m) (setq i d) (while ( (setq n d r nil) (while ( (setq r (cons (if (= i n) 1.0 0.0) r)) ) (setq m (cons r m)) ) ) ;; INVERSEMATRIX ;; Inverse une matrice carrée (méthode Gauss-Jordan) ;; ;; Argument: la matrice ;; Retour : la matrice inverse ou nil (si non inversible) (defun InverseMatrix (mat / col piv row res) (setq mat (mapcar '(lambda (x1 x2) (append x1 x2)) mat (Imat (length mat)))) (while mat (setq col (mapcar '(lambda (x) (abs (car x))) mat)) (repeat (vl-position (apply 'max col) col) (setq mat (append (cdr mat) (list (car mat)))) ) (if (equal (setq piv (caar mat)) 0.0 1e-14) (setq mat nil res nil ) (setq piv (/ 1.0 piv) row (mapcar '(lambda (x) (* x piv)) (car mat)) mat (mapcar '(lambda (r / e) (setq e (car r)) (cdr (mapcar '(lambda (x n) (- x (* n e))) r row)) ) (cdr mat) ) res (cons (cdr row) (mapcar '(lambda (r / e) (setq e (car r)) (cdr (mapcar '(lambda (x n) (- x (* n e))) r row)) ) res ) ) ) ) ) (reverse res) ) ;;; [b]NamedUCS2WCSMatrix[/b] Retourne la matrice de transformation du SCU nommé [name] vers le SCG (defun NamedUCS2WCSMatrix (name / mat) (if (setq mat (WCS2NamedUCSMatrix name)) (InverseMatrix mat) ) ) Il est aussi possible, sans que le SCU ne soit actif ou nommé, de faire des transformations depuis ou vers un SCU "virtuel" défini par 3points (comme avec l'option "3points" de la commande SCU, les points devant être traduits dans le SCG) NOTA : ces routines utilisent la fonction "NORM_3pts" ;;; [b]norm_3pts[/b] retourne le vecteur normal du plan défini par 3 points [org xdir ydir] (defun norm_3pts (org xdir ydir / norm) (foreach v '(xdir ydir) (set v (mapcar '- (eval v) org)) ) (if (inters org xdir org ydir) (mapcar '(lambda (x) (* x (/ 1 (distance '(0 0 0) norm)))) (setq norm (list (- (* (cadr xdir) (caddr ydir)) (* (caddr xdir) (cadr ydir)) ) (- (* (caddr xdir) (car ydir)) (* (car xdir) (caddr ydir)) ) (- (* (car xdir) (cadr ydir)) (* (cadr xdir) (car ydir)) ) ) ) ) ) ) ;;; [b]WCS23ptsMatrix[/b] Retourne la matrice de transformation du SCG vers un SCU 3points [org xdir ydir] (defun WCS23ptsMatrix (org xdir ydir / lst zdir) (setq lst (reverse (list (setq zdir (norm_3pts org xdir ydir)) (norm_3pts org (mapcar '+ org zdir) xdir) (mapcar '(lambda (x y) (* (- x y) (/ 1 (distance org xdir)))) xdir org ) ) ) ) (vlax-tmatrix (append (mapcar '(lambda (v1 v2) (append v1 (list v2))) (apply 'mapcar (cons 'list lst)) org ) (list '(0 0 0 1)) ) ) ) ;;; [b]3pts2WCSMatrix[/b] Retourne la matrice de transformation d'un SCU 3points [org xdir ydir] vers le SCG (defun 3pts2WCSMatrix (org xdir ydir / lst zdir) (setq lst (reverse (list (setq zdir (norm_3pts org xdir ydir)) (norm_3pts org (mapcar '+ org zdir) xdir) (mapcar '(lambda (x y) (* (- x y) (/ 1 (distance org xdir)))) xdir org ) ) ) ) (vlax-tmatrix (append (mapcar '(lambda (v1 v2) (append v1 (list v2))) lst (mapcar '(lambda (x) (- (apply '+ (mapcar '* x org)))) lst) ) (list '(0 0 0 1)) ) ) ) Et grace à la fonction MXM de Vladimir on peut "combiner" plusieurs matrices entre elles, par exemple : ;;; [b]NamedUCS2NamedUCSMatrix[/b] Retourne la matrice de transformation d'un SCU nommé [from] vers un autre [to] (defun NamedUCS2NamedUCSMatrix (from to) (vlax-tmatrix (mxm (vlax-safearray->list (vlax-variant-value (WCS2NamedUCSMatrix to)) ) (vlax-safearray->list (vlax-variant-value (NamedUCS2WCSMatrix from)) ) ) ) ) ;;; [b]UCS23pointsMatrix[/b] Retourne la matrice de transformation du SCU courant vers un SCU 3 points [org xdir ydir] (defun UCS23pointsMatrix (org xdir ydir) (vlax-tmatrix (mxm (vlax-safearray->list (vlax-variant-value (WCS23ptsMatrix org xdir ydir)) ) (vlax-safearray->list (vlax-variant-value (UCS2WCSMatrix)) ) ) ) ) À suivre ...[Edité le 15/8/2006 par (gile)][Edité le 16/8/2006 par (gile)][Edité le 7/2/2007 par (gile)]

Je l'ai faite, et continue à la faire, si souvent, cette étourderie ...

Salut Dilack, Je ne pense pas que ce soit un problème de version d'AutoCAD, c'est un bout de code placé derrière le signe " Tu peux remplacer : (setq ent (ssget '((-4 . " (0 . "SPLINE") (0 . "ELLIPSE") (0 . "CIRCLE") (0 . "LWPOLYLINE") (0 . "POLYLINE") (-4 . "OR>") ) ) ) par (setq ent (ssget '((-4 . ") (0 . "SPLINE") (0 . "ELLIPSE") (0 . "CIRCLE") (0 . "LWPOLYLINE") (0 . "POLYLINE") (-4 . "OR>") ) ) ) en enlevant l'espace entre Ou encore plus simple par : (setq ent (ssget '((0 . "SPLINE,ELLIPSE,CIRCLE,*POLYLINE"))))

Ça marche très bien avec 2007. C'est une super idée que de récupérer aussi le bulge ;)

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

Salut, Si ta numérotation est constituée d'attributs, tu vas trouver ton bonheur dans la caverne de Patrick_"Ali Baba"_35, IAT ou LATT devraient faire l'affaire.

Quelques petites routines utiles quand on manipule les angles, la plupart ont été publiées éparpillées dans différents LISP sur le site. Les classiques fonctions de conversions : ;;; D2R Convertit les degrés en radians (defun d2r (ang) (* (/ ang 180.0) pi) ) ;;; R2D Convertit les radians en degrés (defun r2d (ang) (* (/ ang pi) 180) ) ;;; G2R Convertit les grades en radians (defun g2r (ang) (* (/ ang 200.0) pi) ) ;;; R2G Convertit les radians en grades (defun r2g (ang) (* (/ ang pi) 200) ) Comme AutoCAD calcule en radians, il est plus simple de faire aussi les calculs dans cette unité. Pour les routines suivantes, les angles sont donc exprimés en radians. Les principales fonctions trigonométriques qui ne sont pas pré-définies en AutoLISP : ;;; ASIN et ACOS Retournent l'arc sinus ou cosinus du nombre, en radians (ou nil) (defun ASIN (num) (cond ((equal num 1 1e-9) (/ pi 2)) ((equal num -1 1e-9) (/ pi -2)) (( (atan num (sqrt (- 1 (expt num 2)))) ) ) ) (defun ACOS (num) (cond ((equal num 1 1e-9) 0.0) ((equal num -1 1e-9) pi) (( (atan (sqrt (- 1 (expt num 2))) num) ) ) ) ;;; TAN Retourne la tangente de l'angle ;;; Nota : (cos (/ pi 2)) retourne 6.12323e-017 à la place de 0.0 (defun tan (ang) (/ (sin ang) (cos ang)) ) Pour évaluer si un angle est nul ou plat (0° ou 180°) ;;; EQUALKPI - Évalue si un angle est égal à k*pi radians à 0.000000001 près. (defun equalkpi (ang) (or (equal (rem ang pi) 0 1e-009) (equal (abs (rem ang pi)) pi 1e-009) ) ) Pour récupérer l'angle entre un sommet et deux autres points dans le plan défini par ces trois points ("Théorème de Carnot"). ;;; ANGLE_3PTS Retourne l'angle (radians) défini par son sommet et deux points ;;; (ou nil si un des points est confondu avec le sommet) ;;; L'angle retourné est toujours positif et inférieur à pi radians. (defun angle_3pts (som p1 p2 / d1 d2 d3) (setq d1 (distance som p1) d2 (distance som p2) d3 (distance p1 p2) ) (if (and ( (ACOS (/ (+ (* d1 d1) (* d2 d2) (- (* d3 d3))) (* 2 d1 d2) ) ) ) ) Quand on additionne ou qu'on soustrait des angles, le résultat n'est pas toujours compris entre 0 et 2*pi radians, et il est souvent nécessire de le convertir dans ces valeurs (à "2 k pi près") pour pouvoir faire des comparaisons avec d'autres angles. ;;; Ang;;; (ang 0.0 ;;; (ang 3.14159 (defun ang (if (and ( ang (ang ) ) [Edité le 21/12/2006 par (gile)]

Je viens de voir une très jolie routine de Tim Willey, en vlisp, avec une sous-routine de forme récursive ici.

Salut, Le LISP de Bonuscad doit fonctionner sur 2000 (je ne peux pas tester), ceux que j'ai mis plus haut, fonctionnent sur 2007 et devraient fonctionner sur 2004.

Personnellement, je préfère avoir plusieurs fichiers .lsp dans un seul répertoire du chemin de recherce des fichiers de support, même si certains fichier contiennent plusieurs fonctions ou commandes, la maintenance est plus facile (ajouter, supprimer, modifier ou remplacer un fichier plutôt qu'un bout de fichier). ensuite pour charger tous les LISP du répertoire, j'ajoute au fichier .MNL courant : (mapcar 'load (vl-directory-files "C:\\Gile\\Gile2007" "*.lsp" 1))

Merci Bonuscad "Oeil de lynx", ;) En fait, je m'embétais à calculer la longueur d'arc avec la corde et le rayon, alors que j'avais la valeur de l'angle (cotation angulaire !) :( J'ai corrigé et tesé les deux LISP donnés plus haut, pour les versions de 2002 à 2005, puisque depuis 2006 la commande ARCCOTE (_DIMARC) existe.

Re, J'ai ajouté un filtre pour ne traiter que les polygones réguliers, ça permet de faire la sélection plus largement.

Salut ô vénérable décapode, Voici une réponse à ta requète qui devrait fonctionner quelque soient le SCU courant et les SCO des polygones : Nouvelle version : (10/08/06 15h05) - sous routines remaniées pour qu'elles puissent re-servir pour d'autres fonctions - test qui filtre les polygones réguliers uniquement - fonctionnement avec les triangle équilatéraux ;;; PG2C Transforme une sélection de polygones inscrits en cercles (defun c:pg2c (/ ss n ent) (while (not (setq ss (ssget '((0 . "LWPOLYLINE") (70 . 1))))) ) (repeat (setq n (sslength ss)) (setq ent (ssname ss (setq n (1- n)))) (if (polygonp ent) (polygon2circle ent) ) ) (princ) ) ;;; MID_PT Retourne le milieu de 2 points (defun mid_pt (p1 p2) (mapcar '(lambda (x y) (/ (+ x y) 2)) p1 p2) ) ;;; ACOS Retourne l'arc cosinus du nombre, en radians (defun ACOS (num) (if ( (atan (sqrt (- 1 (expt num 2))) num) ) ) ;;; ANGLE_3PTS Retourne l'angle (radians) défini par son sommet et deux points ;;; L'angle retourné est toujours positif et inférieur à pi radians. (defun angle_3pts (som p1 p2 / d1 d2 d3) (setq d1 (distance som p1) d2 (distance som p2) d3 (distance p1 p2) ) (if (and ( (ACOS (/ (+ (* d1 d1) (* d2 d2) (- (* d3 d3))) (* 2 d1 d2) ) ) ) ) ;;; POLYGONP Retourne T si l'entité est un polygone régulier (lwpolyline) (defun polygonp (ent / lst nb ang) ;; Compare les angles et les longueurs entre les sommets (defun regularp (l1 l2 a) (cond ((null l2) T) ((not (and (equal (angle_3pts (car l1) (cadr l1) (car l2)) a 1e-9) (equal (distance (car l1) (cadr l1)) (distance (car l1) (car l2)) 1e-9 ) ) ) nil ) (T (regularp (cdr l1) (cdr l2) a)) ) ) (and (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE") (= (cdr (assoc 70 (entget ent))) 1) (setq lst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent) ) ) ) (setq nb (length lst)) (setq ang (- pi (/ (* 2 pi) nb))) (regularp (reverse (cons (car lst) (reverse lst))) (cons (last lst) (reverse (cdr (reverse lst)))) ang ) ) ) ;;; POLYGON2CIRCLE Transforme un polygone en cercle (poylgone inscrit) (defun polygon2circle (ent / e_lst v_lst nb cen) (setq e_lst (entget ent) v_lst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) e_lst ) ) nb (length v_lst) ) (if (= 0 (rem nb 2)) (setq cen (mid_pt (car v_lst) (nth (/ nb 2) v_lst))) (setq cen (inters (nth 0 v_lst) (mid_pt (nth (/ nb 2) v_lst) (nth (+ (/ nb 2) 1) v_lst) ) (nth 1 v_lst) (mid_pt (nth (+ (/ nb 2) 1) v_lst) (cond ((nth (+ (/ nb 2) 2) v_lst)) (T (nth 0 v_lst)) ) ) T ) ) ) (entmake (list '(0 . "CIRCLE") (cons 10 cen) (cons 40 (distance cen (car v_lst))) (assoc 67 e_lst) (assoc 410 e_lst) (assoc 38 e_lst) (assoc 210 e_lst) ) ) ) [Edité le 10/8/2006 par (gile)][Edité le 10/8/2006 par (gile)] Erratum : j'avais oublié de coller les définitions de angle_3pts et acos qui sont chargées en permaence sur mon poste.[Edité le 10/8/2006 par (gile)] [Edité le 11/8/2006 par (gile)]

Salut, Tu peux essayer avec ce LISP, qui fonctionne avec tous types de polylignes (2D, 3D ou optimisées) ou celui de Elpanov Evgeniy donné plus bas dans le même sujet, qui ne fonctionne qu'avec les lwpolylignes. Il me semble qu'on trouve sur le net des versions du LISP de Didier Duhem qui sont incomplètes (il manque des définitions de sous-routines) et contrairement aux deux autres que je te propose, celle-ci ne conserve pas les largeurs des polylignes. [Edité le 10/8/2006 par (gile)]