(gile)

Salut, (vl-mkdir "c:\\Plans_en_PDF")

Pas mieux, et comme ça non plus : (if (setq lst (vl-remove-if-not '(lambda (x) (eq (car x) 350)) (dictsearch (namedobjdict) "ACAD_MLINESTYLE"))) (progn (foreach ent lst (setq elst (entget (cdar lst))) (while (member '(62 . 256) elst) (setq elst (subst '(62 . 0) '(62 . 256) elst)) ) (entmod elst) ) ) )

Le entmod ne semble pas fonctionner chez moi. Et, si je comprends bien, c'est le style de mline qui est modifié, pas uniquement les mlines composant un bloc. Curieuse entité :casstet:

Patrick_35, Le problème vient, il me semble des mlines elles même. Avant même d'en faire un bloc, il semble impossible de forcer la couleur d'une mline, si le code DXF change, l'objet reste de la couleur du calque sur lequel il est. :casstet:

Salut pitou66, J'ai apporté à Gile3dPoly la modification que tu demandais (si j'ai bien compris). La fonction boucle en option "Ligne" tant qu'on ne spécifie pas l'option "Arc" puis boucle dans cette option tant qu'on ne re-spécifie pas "Ligne" (un peu comme avec la commande POLYLIGN).

Exact, autant pour moi, c'est : (vla-PurgeAll (vla-get-ActiveDocument (vlax-get-acad-object)))

Le mieux, je ne sais pas, personnellement depuis que j'ai découvert cette possibilité d'éviter de transformer les listes en variants et vice-versa, je l'utilise quasi systématiquement. Les fonctions vlax-invoke, vlax-get, vlax-put sont des survivances des débuts du VisualLISP cela veut-il dire qu'elles sont amenées à disparaître, comme on peut le lire ici ou là sur des forums ? On peut aussi lire que le LISP aussi est voué à disparaître d'AutoCAD, dans les deux cas les réponses des détracteurs de ces rumeurs invoquent le nombre de routines réalisées et en circulation pour les réfuter. J'aurais tendance à plutôt, vouloir croire les derniers, tu t'en doutes ;)

Eh non, (vlax-3d-point ...) retourne un "variant" l'argument courant des fonctions vla-... et encore là, il y a une fonction pour transformer la liste en variant sans être obligé de passer par les (vlax-make-variant (vlax-SafeArray-fill (vlax-make-SafeArray vlax-vbDouble ...))). tu peux donc faire, par exemple (valx-3d-point (mapcar '+ pt '(0 0 1)) Ou, peut-être passer par les (vlax-invoke solide 'sectionsolid pt1 pt2 pt3) avec pt1, pt2 pt3 sous forme de liste (pas testé). Regarde ce sujet.

Salut, Une autre façon, Tous les blocs dynamiques sont traités, ils sont renommés avec un sufixe incrémenté pour éviter les duplications de nom (MonBloc -> MonBloc_1). Il faut ensuite purger les blocs dynamiques, bien sûr. Pour tout purger avec le LISP, enlever les points-virgules devant (vla-PurgeAll). (defun c:dyn2stat (/ n ss) (setq n 0) (if (setq ss (ssget "_X" '((0 . "INSERT")))) (foreach bl (mapcar 'cadr (ssnamex ss)) (setq bl (vlax-ename->vla-object bl)) (if (= (vla-get-IsDynamicBlock bl) :vlax-true) (vla-ConvertToStaticBlock bl (strcat (vla-get-EffectiveName bl) "_" (itoa (setq n (1+ n))) ) ) ) ) ) ;;(vla-PurgeAll (vla-get-ActiveDocument (vlax-get-acad-object))) (princ) ) [Edité le 16/11/2006 par (gile)][Edité le 16/11/2006 par (gile)] Edit : corrigé l'oubli signalé par LUDWIG pour vla-PurgeAll. [Edité le 17/11/2006 par (gile)]

J'ai apporté quelques petites améliorations au premier LISP : Gile3dPoly (possibilité d'annulation des derniers points entrés et conservation du nombre de segments par arc dans le dessin). À chacun de choisir, en fonction de ses besoins, d'utiliser celui-ci ou InterPoly3d, la principale différence étant le mode de calcul des sommets pour les segments figurant les arcs, comme expliqué plus haut. [Edité le 16/11/2006 par (gile)]

Je ne suis pas sûr de bien comprendre ce que tu veux , mais il me semble que le premier LISP te convient mieux.

Tout d'abord, je te remercie de me me tenir au courant. Pour ce qui est des modifs, à propos des segments droits, tu me disais après avoir essayé le premier LISP, qui fait des segments droits par défaut : J'ai fait le second en conséquence, avec la possibilité pour les segments droits d'entrer @. Et je rappelle qu'il est aussi possible de le faire à la souris en cliquant, pour le deuxième point de l'arc, soit sur le point précédent soit deux fois sur le troisième. En ce qui concerne la deuxième demande, il faut choisir : - soit le LISP interpole l'altitude du deuxième point de l'arc à partir des premiers et troisième points, et le deuxième point ne sert donc qu'à déterminer la courbure de l'arc, c'est ce que fait le deuxième LISP. - soit l'altitude du deuxième point doit être prise en compte, et alors l'arc sera forcément créé sur le plan défini par les trois points. C'est ce que fait le premier LISP. Si c'est ce fonctionnement que tu préfères, il est possible d'y apporter des modifications, je l'avis un peu laissé en plan suite aux différentes remarques. En tout cas, je ne sais pas faire un mélange des deux. ;)

Salut, En VBA, ce sont les propriétés Centroid, Principal Moment (autour du centre de gravité). Regarde dans l'aide aux dévellopeurs > ActiveX and VBA Reference.

Salut, Regarde ici.

Comme j'ai vu que tu postais aussi à propos des BoundingBox : obj : le vla-object dont on veux trouver la BoundingBox (vla-getBoundingBox obj 'minpt 'maxpt) (setq minpt (vlax-safearray->list minpt)) (setq maxpt (vlax-safearray->list maxpt))

Salut, pt_lst est la liste de coordonnées, minpt le point avec les x y et z minimums de la liste maxpt le point avec les x y et z maximums de la liste Nota : minpt et maxpt n'appartiennent pas forcément à ma liste, c'est l'équivalent des points retournés par (vla-get-boundingbox ...) sur une polyligne dont pt_lst serait la liste des coordonnées. (setq minpt (apply 'mapcar (cons 'min pt_lst))) (setq maxpt (apply 'mapcar (cons 'max pt_lst))) Exemple : (setq pt_lst '((1 4) (3 2) (5 0))) minpt : (1 0) maxpt : (5 4) J'espère que ça correspond à ta demande. [Edité le 15/11/2006 par (gile)]

Suite à une discussion sur TheSwamp à propos de la différence enre les SCO tel que définis par AutoCAD et de système de coordonnées à l'intérieur d'une référence de bloc ou d'une xref (souvent appelé aussi SCO ou OCS), j'ai fait deux petite routine pour traduire les coordonnées du SCR* vers le SCG et vice versa. * SCR ou RCS pour Reference Coordinate System. Edit : WCS2RCS dysfonctionnait avec les blocs dont les echelles sont différentes de 1. C'est réparé (il me semble) avec un peu de calcul vectoriel. Edit 2 : WCS2RCS dysfonctionnait avec les blocs ayant subi une rotation 3D et une échelle non uniforme, c'est réparé (il me semble) avec un peu de calcul matriciel. EDIT 3 : WCS2RCS semble enfin fonctionner dans toutes les situations, les routines : InverseMatrix et Imat doivent être chargées (voir plus bas). ;;; VXV Retourne le produit scalaire (réel) de deux vecteurs (defun vxv (v1 v2) (apply '+ (mapcar '* v1 v2)) ) ;; Transpose une matrice Doug Wilson (defun trp (m) (apply 'mapcar (cons 'list m)) ) ;; Applique une matrice de transformation à un vecteur Vladimir Nesterovsky (defun mxv (m v) (mapcar '(lambda (r) (vxv r v)) m) ) ;;; butlast Retourne la liste privée du dernier élément (defun butlast (lst) (reverse (cdr (reverse lst))) ) ;; RCS2WCS ;; Traduit les coordonnées du Système de Coordonnées Reference (bloc ou xref) vers le SCG ;; ;; Arguments : ;; pt : un point dans le RCS ;; mat : une matrice de transformation, retournée par (caddr (nentsel)) ou (caddr (nentselp)) (defun RCS2WCS (pt mat) (setq pt (trans pt 0 0)) (if (= 3 (length (car mat))) (mapcar '+ (mxv (trp (butlast mat)) pt) (last mat)) (mapcar '+ (mxv (mapcar 'butlast (butlast mat)) pt) (butlast (mapcar 'last mat)) ) ) ) ;; WCS2RCS ;; Traduit les coordonnées du SCG vers le Système de Coordonnées Reference (bloc ou xref) ;; ;; Arguments : ;; pt : un point dans le SCG ;; mat : une matrice de transformation, retournée par (caddr (nentsel)) ou (caddr (nentselp)) (defun WCS2RCS (pt mat) (setq pt (trans pt 0 0)) (if (= 3 (length (car mat))) (setq mat (append (trp mat) (list '(0.0 0.0 0.0 1.0)))) ) (setq mat (InverseMatrix mat)) (mapcar '+ (mxv mat pt) (butlast (mapcar 'last mat))) ) [Edité le 15/11/2006 par (gile)][Edité le 21/11/2006 par (gile)][Edité le 20/4/2008 par (gile)]

Re, Vers la fin du DCL, tu peux ajouter un paramètre de hauteur pour la case list_box : :list_box{ key="pop"; width=25; [surligneur]height=20;[/surligneur] }

Version 1.3 Ajout d'un test logique : seuls les segments convergents sont traités.

Voilà, il faut remplacer Getname.dcl par ce code : getname:dialog{ label="Choisir un nom"; initial_focus="tp"; :boxed_column{ label="Modifier la liste"; :row{ spacer; :edit_box{ key="tp"; edit_width=20; alignment=left; allow_accept=true; } spacer; } :row{ :button{ label="Ajouter"; key="add"; } :button{ label="Retirer"; key="del"; } } } spacer_1; :row{ spacer; :list_box{ key="pop"; width=25; } spacer; } spacer_1; ok_cancel; } et, dans le LISP, la sous routine getname : (defun getname (/ lst what_next dcl_id nom) (if (not (vlax-ldata-get "Pline_block" "Name")) (vlax-ldata-put "Pline_block" "Name" '("Bain" "Cuisine" "Entrée" "Séjour" "WC")) ) (setq lst (vlax-ldata-get "Pline_block" "Name")) (setq dcl_id (load_dialog "GetName.dcl")) (setq what_next 2) (while (>= what_next 2) (if (not (new_dialog "getname" dcl_id)) (exit) ) (start_list "pop") (mapcar 'add_list lst) (end_list) (action_tile "pop" (strcat "(if (or (= $reason 1) (= $reason 4))" "(set_tile \"tp\" (nth (atoi $value) lst)))" "(mode_tile \"accept\" 2)" ) ) (action_tile "add" (strcat "(if (not (member (get_tile \"tp\") lst))" "(setq lst (acad_strlsort (cons (get_tile \"tp\") lst))))" "(done_dialog 2)" ) ) (action_tile "del" (strcat "(setq lst (vl-remove (get_tile \"tp\") lst))" "(done_dialog 2)" ) ) (action_tile "accept" (strcat "(if (not (read (get_tile \"tp\")))" "(progn (alert \"Spécifiez un nom, svp.\")" "(done_dialog 2))" "(progn (setq nom (get_tile \"tp\"))" "(if (and (not (member nom lst)) (/= nom ""))" "(setq lst (acad_strlsort (cons (get_tile \"tp\") lst))))" "(vlax-ldata-put \"Pline_block\" \"Name\" lst)" "(done_dialog 1)))" ) ) (setq what_next (start_dialog)) (if (= what_next 0) (setq nom nil) ) ) (unload_dialog dcl_id) nom ) NB : Je modifie aussi les codes ici.

Salut, As tu essayé 25.4 (un pouce égal 25.4 mm) ? Sinon tu peux utiliser le LISP Edit_bloc, il y a la possibilité de redéfinit l'unité des blocs.

Tu peux utiliser ImageShack ou XS.to. Tu peux aussi voir ce sujet ou d'autres, la question a souvent été posée.

Pour un peu plus de souplesse et de polyvalence, le même mais par rapport au SCU courant. (defun c:ssbb (/ p1 p2 pt1 pt2) (initget 1) (setq p1 (getpoint "\nPremier coin de la boite: ")) (initget 1) (setq p2 (getpoint p1 "\nCoin opposé de la boite: ")) (setq pt1 (apply 'mapcar (cons 'min (list p1 p2))) pt2 (apply 'mapcar (cons 'max (list p1 p2))) ) (sssetfirst nil (selbybox pt1 pt2)) (princ) ) (defun SelByBox (p1 p2) (vl-load-com) (setq ss (ssget "_A" '((410 . "Model")))) (foreach ent (mapcar 'cadr (ssnamex ss)) (setq obj (vlax-ename->vla-object ent)) (vla-TransformBy obj (UCS2WCSMatrix)) (vla-getBoundingBox obj 'minpt 'maxpt) (vla-TransformBy obj (WCS2UCSMatrix)) (if (or (member T (apply 'mapcar (cons 'list minpt) p1)))) (member T (apply 'mapcar (cons 'list maxpt))))) ) (ssdel ent ss) ) ) ss ) ;; 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)) ) ) )

Sans programmation je ne crois pas. Avec programation, il est "relativement" simple de sélectionner tous les objets dont la "bounding box" (emprise de l'objet suivant les axes X, Y et Z du SCG) est contenue dans une "boite" défine par deux coins opposés (les arrêtes de cette "boite" étant eux aussi parallèle aux axes du SCG). Sur l'image (cliquer dessus pour l'agrandir), les bounding box sont en gris, la boite de sélection en gris interrompu. http://xs309.xs.to/xs309/06461/ssbb.PNG.xs.jpg Tu peux essayer le LISP suivant (taper ssbb pour lancer la commande) (defun c:ssbb (/ p1 p2 pt1 pt2) (initget 1) (setq p1 (trans (getpoint "\nPremier coin de la boite: ") 1 0)) (initget 1) (setq p2 (trans (getpoint p1 "\nCoin opposé de la boite: ") 1 0)) (setq pt1 (apply 'mapcar (cons 'min (list p1 p2))) pt2 (apply 'mapcar (cons 'max (list p1 p2))) ) (sssetfirst nil (selbybox pt1 pt2)) (princ) ) (defun SelByBox (p1 p2) (vl-load-com) (setq ss (ssget "_X" '((410 . "Model")))) (foreach ent (mapcar 'cadr (ssnamex ss)) (vla-getBoundingBox (vlax-ename->vla-object ent) 'minpt 'maxpt) (if (or (member T (apply 'mapcar (cons 'list minpt) p1)))) (member T (apply 'mapcar (cons 'list maxpt))))) ) (ssdel ent ss) ) ) ss )

Salut, Si la souris est une Logitech, il me semble me souvenir qu'il faut paramétrer la roulette comme étant le bouton du milieu.