Serge

Patrick, Alors envoie 25 lignes vides consécutives :) Mais qu,est-ce que tu veux faire avec ton SendCommand ? Tu peux m'envoyer ton code en privé si tu préfère. Serge

Tramber, Tu as droit à 10 zoom précédent par onglet et par session. Je doute que ce soit pratique. Mais ce que tu demande est exactement ce que fait le MVPort. Serge

Pako, Tiens, salut capitaine Patenaude :) Serge

Ludwig, J'ai honte de ne pas avoir testé en 2005 Remplace (> (substr (getvar "acadver") 1 4) "16.1") par (>= (substr (getvar "acadver") 1 4) "16.1") Blame l'erreur sur Rio Pour ce qui est de notre occupation du temps, je passe environ 20% de mon temps à programmer donc ça devient une routine :-) Serge

Patrick, Voici la traduction en bon français: "Pourquoi ne pas acheter un MVPort? C'est très rentable." Serge

Patrick, Je n'ai jamais réussi même avec Nomutt. La commande utilise un canal différent. Probablement un AcApDocManager::sendStringToExecute Serge

Ludwig, Petite transfo. Je n'ai pas testé si le dessin contient des mailles polygonales ou des 3poly. Dans un tel cas, la commande pedit agit différemment et fera sans doute planter la routine. Il suffira alors d'élaborer le filtre. (defun c:pedit2 ( / fuzz hasLineOrArc i layer layer_ss1 layer_ss2 layer_sss n objet objetGet oldPeditaccept peditaccept repere ss ) (setq fuzz 0.0) (setq ss (ssget (list (cons 0 "*polyline,arc,line")))) ; élaborer si on veut filtrer les mailles et 3dpoly (setq hasLineOrArc nil) (setq i 0) (setq n (if ss (sslength ss) 0)) (setq layer_sss nil) (while (< i n) (setq objet (ssname ss i)) (setq objetGet (entget objet)) (setq hasLineOrArc (if (member (strcase (cdr (assoc 0 objetGet)) t) '("arc" "line")) t nil)) (setq layer (cdr (assoc 8 objetGet))) (if (setq layer_ss1 (assoc layer layer_sss)) (progn (setq layer_ss2 (list layer (ssadd objet (cadr layer_ss1)) (or hasLineOrArc (caddr layer_ss1)))) (setq layer_sss (subst layer_ss2 layer_ss1 layer_sss)) ) (progn (setq layer_ss2 (list (list layer (ssadd objet (ssadd)) hasLineOrArc))) (setq layer_sss (append layer_ss2 layer_sss)) )) (setq i (1+ i)) ) (while layer_sss (setq layer_ss1 (car layer_sss)) (setq layer (car layer_ss1)) (setq ss (cadr layer_ss1)) (setq hasLineOrArc (caddr layer_ss1)) (princ (strcat "\n" (itoa (sslength ss)) " objets sélectionnés sur le calque '" layer "'.")) (cond ((not ss) nil) ((< (sslength ss) 2) nil) ; Au moins 2 segments requis ((> (substr (getvar "acadver") 1 4) "16.1") (setq oldPeditaccept (getvar "peditaccept")) (setvar peditaccept 1) (command "_pedit" "_multiple" ss "" "_join" fuzz "") ) (hasLineOrArc (command "_pedit" "_multiple" ss "" "_yes" "_join" fuzz "")) (t (command "_pedit" "_multiple" ss "" "_join" fuzz "")) ) (setq layer_sss (cdr layer_sss)) ) (princ) ) Serge

À tous, À mon tour de vous souhaiter une très bonne année 2005. Il va peut-être falloir que je change d'avatar. Bonhomme est maintenant syndiqué et veut faire la grève :) Serge

Patrick_135, Dans ta signature, tu devrais peut-être écrire (1934-2003) ;-) Sylvain, Voici une routine que j'ai laissée sur l'autre forum. C'est un bon point de départ. ;;; C:LONGAIRE ;;; Retourne la longueur et l'aire totale d'un jeu d'objets parmi: ;;; ligne, polyligne de toute sorte, arc, cercle, ellipse, spline et mline ;;; ;;; Compatibilité: AutoCAD 2002 et plus ;;; ;;; Instructions: ;;; 1) Charger ce fichier ;;; 2) Tapez LONGAIRE sur la ligne de commande ;;; 3) Choisissez des objets. Les objets invalides sont filtrés. ;;; ;;; Modifications: ;;; 2004/12/24 : Compatibilité avec 2002 ;;; 2004/12/28 : Traitement des Mline et exclusion des xline. ;;; 2004/12/30 : Correction pour version française. ;;; ;;; Par Serge Camiré, CadNovation, 2004/12/30 ;;; http://www.cadnovation.com/fr ;;; (defun c:longaire ( / AireTotale ename i LongueurTotale n ss vlaObject wasOldPolyline ) (vl-load-com) (if (< (atoi (getvar "acadver")) 15) (progn (alert "Ce programme n'est compatible qu'à partir de la version 2000") (exit) )) (princ "\nChoisissez des objets à mesurer: ") (setq ss (ssget (list (cons 0 "*polyline,arc,circle,ellipse,line,mline")))) (if ss (progn (setq AireTotale 0.0) (setq LongueurTotale 0.0) (setq i 0 n (sslength ss)) (while (< i n) (setq ename (ssname ss i)) (setq wasOldPolyline nil) (setq wasOldPolyline (convertOldPolyline ename)) ; Si retourne T, un nouvel objet a été créé (setq vlaObject (vlax-ename->vla-object ename)) (setq LongueurTotale (+ LongueurTotale (getObjectLength vlaObject))) (setq AireTotale (+ AireTotale (getObjectArea vlaObject))) (if wasOldPolyline (undoConvert)) (setq i (1+ i)) ) (princ (strcat "\nLa longueur totale est: " (rtos LongueurTotale))) (princ (strcat "\tL'aire totale est: " (rtos AireTotale))) )) (princ) ) (defun undoConvert () (command "_u") (princ) ) (defun convertOldPolyline ( ename / return ) (setq return nil) (if (and (= (atoi (getvar "acadver")) 15) (= 'ENAME (type ename)) (= (cdr (assoc 0 (entget ename))) "POLYLINE")) (progn (command "_convert" "_polyline" "_select" ename "" ) (if (= (cdr (assoc 0 (entget ename))) "LWPOLYLINE") (setq return t)) )) return ) ;;; getObjectLength ;;; Retourne la longueur d'un objet ;;; Reçoit un objet Vla d'une ligne, polyligne de toute sorte, arc, cercle, ellipse, spline. ;;; Retourne un Real (defun getObjectLength ( vlaObject / coordinates flagBit71 i isClosed n points3D return version15 ) (setq version15 (= (atoi (getvar "acadver")) 15)) (cond ;; Spline et Ellipse sont des NURBS ((wcmatch (vla-get-ObjectName vlaObject) "AcDbSpline,AcDbEllipse") (setq return (vlax-curve-getDistAtParam vlaObject (vlax-curve-getEndParam vlaObject))) ) ;; Arcs ((wcmatch (vla-get-ObjectName vlaObject) "AcDbArc") (setq return (vla-get-ArcLength vlaObject)) ) ;; Cercles ((wcmatch (vla-get-ObjectName vlaObject) "AcDbCircle") (setq return (vla-get-Circumference vlaObject)) ) ;; Line ((wcmatch (vla-get-ObjectName vlaObject) "AcDbLine") (setq return (vla-get-Length vlaObject)) ) ;; Mline ((wcmatch (vla-get-ObjectName vlaObject) "AcDbMline") (setq coordinates (safearray-value (variant-value (vla-get-coordinates vlaObject)))) (setq points3D nil) (while coordinates (setq points3D (append points3D (list (list (car coordinates) (cadr coordinates) (caddr coordinates))))) (setq coordinates (cdddr coordinates)) ) ;; Il n'existe pas d'interface pour savoir si l'objet est ouivert ou fermé !!! (setq flagBit71 (cdr (assoc 71 (entget (vlax-vla-object->ename vlaObject))))) (setq isClosed (= 2 (boole 1 flagBit71 2))) ;; Ajouter le premier point à la suite si le mline est fermé. (if isClosed (setq points3D (reverse (cons (car points3D) (reverse points3D))))) (setq return 0) (setq i 0 n (1- (length points3D))) (while (< i n) (setq return (+ return (distance (nth i points3D) (nth (1+ i) points3D)))) (setq i (1+ i)) ) ) ;; LightweightPolyline, Polyline, 3dPolyline (à faire en dernier) ((wcmatch (vla-get-ObjectName vlaObject) "AcDbPolyline,AcDb2dPolyline,AcDb3dPolyline") (setq return (if version15 (vlax-curve-getDistAtParam vlaObject (vlax-curve-getEndParam vlaObject)) ; R15 (vla-get-Length vlaObject) ; R16 et + )) ) ;; MVPort ((wcmatch (vla-get-ObjectName vlaObject) "*mvport*") (setq return 0.0) ; Pub ) (t (setq return 0.0)) ; Type inconnu ) return ) ;;; getObjectArea ;;; Retourne l'aire d'un objet ;;; Reçoit un objet Vla d'une ligne, polyligne de toute sorte, arc, cercle, ellipse, spline. ;;; Retourne un Real (defun getObjectArea ( vlaObject / coordinates oldOsmode points3D return ) (cond ;; Spline et Ellipse sont des NURBS ((wcmatch (vla-get-ObjectName vlaObject) "AcDbSpline,AcDbEllipse") (setq return (vlax-curve-getArea vlaObject)) ) ;; Arcs ((wcmatch (vla-get-ObjectName vlaObject) "AcDbArc") (setq return (vla-get-Area vlaObject)) ) ;; Cercles ((wcmatch (vla-get-ObjectName vlaObject) "AcDbCircle") (setq return (vla-get-Area vlaObject)) ) ;; Line ((wcmatch (vla-get-ObjectName vlaObject) "AcDbLine") (setq return 0.0) ) ;; Mline ((wcmatch (vla-get-ObjectName vlaObject) "AcDbMline") (setq coordinates (safearray-value (variant-value (vla-get-coordinates vlaObject)))) (setq points3D nil) (while coordinates (setq points3D (append points3D (list (list (car coordinates) (cadr coordinates) (caddr coordinates))))) (setq coordinates (cdddr coordinates)) ) (setvar "nomutt" 1) ; Attention : à usage restraint. Enlève totalement l'écho. (setq oldOsmode (getvar "osmode")) (setvar "osmode" 0) ; Pas de modes d'accrochage (command "_area") (foreach point3D points3D (command point3D)) (command "") (setvar "osmode" oldOsmode) (setvar "nomutt" 0) (setq return (getvar "area")) ) ;; LightweightPolyline, Polyline ((wcmatch (vla-get-ObjectName vlaObject) "AcDbPolyline,AcDb2dPolyline") (setq return (vla-get-Area vlaObject)) ) ;; MVPort ((wcmatch (vla-get-ObjectName vlaObject) "*mvport*") (setq return 0.0) ; Pub ) (t (setq return 0.0)) ; Type inconnu ) return ) (princ "\nTapez LONGAIRE pour connaitre la longueur et l'aire totale d'un jeu d'objets.") (princ) Serge

Tramber, Ta condition n'empêche pas les ",," Il te faudra alors une deuxième condition comme suit: (setq texte "100,215,22,a,331,1,12") (setq invalide "*[a-z]*,*[A-Z]*,*`,`,*,") (if (not (or (wcmatch texte "*[~0-9`,]*") (wcmatch texte "*`,`,*"))) (progn (princ "\nBravo!") ) (progn (princ "\nErreur!") )) Ou encore ceci (note: tu pourrais évaluer directement intrus au besoin): (setq texte "100,215,22,331,1,12") (setq lettres '("#" "@" "." "*" "?" "~" "-" "!" "/" "\\")) ; Ne pas mettre le , dans ce cas-ci (setq intrus "") (foreach lettre lettres (setq intrus (strcat intrus ",*`" lettre "*"))) (setq intrus (strcat "*[a-z]*,*[A-Z]*,*`,`,*" "," intrus)) (if (not (wcmatch texte intrus)) (progn (princ "\nBravo!") ) (progn (princ "\nErreur!") )) Serge

Encore moi :-), Je me suis dis que ce serait plus clair comme suit: (setq texte "100,215,22,331,1,12") (setq invalide "*[a-z]*,*[A-Z]*,*`,`,*") (if (not (wcmatch texte invalide)) (progn (princ "\nBravo!") ) (progn (princ "\nErreur!") )) Serge

Tramber, Je ne sais pas si ton problème est résolu. À première vue, j'aurais pensé que tu voulais examiner chaque éléments de la première liste. Sinon que tu n'as pas de valeur vide (double ,,). Pour ce dernier critère : (wcmatch "100,215,22,331,1,12" "*[a-z]*,*[A-Z]*,*`,`,*") Serge

Ludwig, (defun c:pedit2 ( / fuzz hasLineOrArc i layer n objet oldPeditaccept peditaccept repere ss ) (setq fuzz 0.0) (setq repere (entsel"\nChoix de la polyligne, arc ou ligne à joindre: ")) (setq layer (cdr (assoc 8 (entget (car repere))))) (setq ss (ssget (list (cons 0 "*polyline,arc,line") (cons 8 layer)))) (setq hasLineOrArc nil) (setq i 0 n (if ss (sslength ss) 0)) (while (< i n) (setq objet (ssname ss i)) (if (member (strcase (cdr (assoc 0 (entget objet))) t) '("arc" "line")) (setq hasLineOrArc t i (1+ n)) ) (setq i (1+ i)) ) (cond ((not ss) nil) ((> (substr (getvar "acadver") 1 4) "16.1") (setq oldPeditaccept (getvar "peditaccept")) (setvar peditaccept 1) (command "_pedit" "_multiple" ss "" "_join" fuzz "") ) (hasLineOrArc (command "_pedit" "_multiple" ss "" "_yes" "_join" fuzz "")) (t (command "_pedit" "_multiple" ss "" "_join" fuzz "")) ) (princ) ) (princ "\nTapez PEDIT2 pour joindre des objets d'un même calque.") (princ) Serge

Didier, J'aurais aimé un site canadien pour notre site mais je n'ai pas vu l'équivalent. En tout cas, vous pouvez voir notre lien à http://www.cadnovation.com/fr/home.asp Serge

Didier, Je viens d'essayer http://www.croix-rouge.com/ Ce nom de domaine est à vendre. INCROYABLE !!! Il y a des gens tellement sans scrupules. Ça m'écoeure au plus haut point. Dans le texte, on dit que la transaction peut être effectuée par escrow.com. Ils auraient du écrire escrocs.com Passons à autre chose. Serge [Edité le 29/12/2004 par Serge]

oops, Ça irait mieux comme suit: ' Lorsque tu veux faire ta sélection Do m_AcadState = m_AcadApp.GetAcadState Loop While (m_AcadState.IsQuiescent = False) Sinon, ça risque de boucler très longtemps :-)) Serge

Patrick, Je suis peut-être encore endormi mais je n'arrive pas à voir aucune de leurs images. Suis-je normal ? En désespoir de cause, j'ai même essayé directement cette adresse comme url sans passer par une page html. http://www.croix-rouge.fr/goto/images/banners/crf_acces_175-48.gif En passant, Noël est souvent tragique pour les tremblements de terre. L'an dernier c'était à Bam en Iran. Pour ceux qui ont lu "La cité de la joie" de Dominique Lapierre, on se souviendra d'un passage ou le révérend Paul Lambert célébrait la messe à Calcutta le jour de Noël lorsqu'un des pires typhons s'est abattu sur la côte (cas réel). Un des survivants se rappelle s'être réveillé à 9 km du point où il a vu la vague l'engloutir. Serge

Oli553, Si tu es en 2005, il existe les champs définissables avec les Sheet sets. Serge

eagle4, Tu as un problème vicieux. J'ai déjà eu un tel problème en mélangeant des langages. Un cas classique est l'exécution d'un SendCommand en VBA pour faire du Lisp ou à l'inverse, faire du VBA à partir du Lisp. Il n'y a pas de garantie sur l'état de l'autre environnement. Le DoEvents peut peut-être corriger le problème. Ça ne coûte pas cher d'essayer. Tu peux aussi essayer ceci: ' Au début de ta classe Private m_AcadState As AcadState ' Lorsque tu te lie à AutoCAD m_AcadApp = GetActiveObject("AutoCAD.Application.15.0") ' 15.0 == 2002 ; 16.0 == 2004 ; 16.1 == 2005 m_AcadState = m_AcadApp.GetAcadState ' Lorsque tu veux faire ta sélection Do Loop While (m_AcadState.IsQuiescent = False) En espérant que ce ci puisse t'aider. Sinon, tu peux carrément faire ce que tu as à faire dans un fichier AutoCAD.dvb qui sera auto-exécuté par AutoCAD, ou encore lancer une routine dans acaddoc.lsp où tu aura pris soin de définir un s::startup si tu utilise des appel à (command). En terminant, nous avons aussi les huitres de Malpèque. Je suis sur que Pako va nous donner son avis :-)) Serge

Miamar, Voici la réponse donnée à Badis sur le forum d'Autodesk (coïncidence : est-ce que tu es Badis?) Voici un exemple. L'idée est d'utiliser une fonction qui retourne les sommets. Après on peut utiliser le mode _WP (Window Polygon) ou _CP (Crossing Polygon) et l'option Remove (defun c:test ( / ename) (setq ename (car (entsel "\nMontrez une polyligne: "))) (command "_erase" "_all" "_remove" (ssget "_cp" (getVertices ename)) "") (princ) ) (defun getVertices ( ename / plineGet return vertex vertexGet ) (setq return nil) (cond ((or (/= (type ename) 'ENAME) (not (setq plineGet (entget ename)))) (setq return nil)) ((= "POLYLINE" (cdr (assoc 0 plineGet))) (setq vertex (entnext ename)) (while (= "VERTEX" (cdr (assoc 0 (setq vertexGet (entget vertex))))) (setq return (cons (cdr (assoc 10 vertexGet)) return)) (setq vertex (entnext vertex)) ) (setq return (reverse return)) ) ((= "LWPOLYLINE" (cdr (assoc 0 plineGet))) (setq return (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) plineGet))) ) (t (setq return nil)) ) return ) Serge

Eagle4, La programmation .NET n'est permise dans AutoCAD qu'avec la 2005 si on veut se lier à AutoCAD. On charge le programme via NETLOAD. Pour ce qui est de VB6, c'est un peu regrettable si c'est confirmé car ce sera encore utile 1 an (jusqu'à la mort de 2002). La 2004 demande Visual .NET 2002 Pour le prix, j'ai payé nos licences environ 2500$ (+/- 1500 euros). Pour diminuer les coût, j'ai d'abord acheté des produits concurrents ce qui donnait droit à une escompte, soit le produit DreamWeaver de MacroMedia. Un des avantages de .NET est de pouvoir programmer dans la langue qu'on veut (VB, C#, etc). Ce code sera pré-compilé et géré par le FrameWork, peut importe la plateforme du système d'exploitation. J'apporte une nuance: les programmes en C++ (ObjectArx) continuent d'être en code non managé et ne requière pas déployement du FrameWork tandis que tous les autres sont en code managé et l'exigent (une bagatelle de 50Mo avant même de commencer). Avec AutoCAD 2002 (je n'ai pas testé en 2004), on peut importer un dll provenant d'une solution .NET dans un projet de VC++ 6 pourvu qu'il n'y ait pas de référence à AutoCAD et pourvu que l'on utilise les utilitaires regAsm.exe (pour créer un tlb que VC6 reconnaitra), regsvcs.exe et gacutil.exe (pour enregistrer les assemblages et les objets COM+, attention de bien désintaller avant toutes nouvelles installations. Pourquoi faire tous ces détours ? Parce que justement on est en train de développer une solution pour AutoCAD Mechanical 6 et qui ouvre des boites de dialogue lire lisant l'inventaire (base de données connectées ou non sans problèmes). Pour ceux que ça peut intéresser, je me demande s'il serait possible d'inclure une référence au TLB produit par le regasm à l'intérieur d'un programme VBA. À tester. Serge

Laurent, J'ai toujours eu beaucoup de difficultés avec les "différences culturelles" entre nous et Paris mais pas avec le reste de la France. Je tiens à souligner que le phénomène s'étend à beaucoup de pays. Chaque métropole se considère à part et c'est vrai de Toronto pour le Canada, Montréal pour le Québec, New York pour les US, Paris pour la France, etc. Est-ce que je me trompe. En tout cas, il faut que j'y travaille fort cette année et que j'évite le Campa-NUL qui est près de l'aéroport "Charles-de-Gaulle". Serge

Laurent, Tiens on reconnait l'expert en bière. Serge

Maximilien, Il y a aussi la variable système FONTALT si la police est introuvé mais encore FONTMAP qui définit l'emplacement d'un fichier où toutes les correspondances sont données. Tu n'as qu'à alterner entre 2 fichier pour FONTMAP. Serge

À tous, Je me place entre l'arbre et l'écorce. Normalement, tout le monde ici s'aime et vous devriez arrêter vos querelles sinon tôt ou tard, vous accuser le père de l'autre d'être un ancien de la Gestapo et Patrick va finir par supprimer ce fil. Quoi qu'il en soit, voici un petit bout de code qui saura ravir les plus exigeants. Joyeux Noël à tous. ;;; On sait que depuis la 2002, AutoCAD permute TRIM et EXTEND automatiquement ;;; en appuyant sur Shift (defun c:exttrim ( / continuer limite msg1 msg2 n ss ss1 ThisDrawing ) (setq limite 1000) (setq msg1 "\nSélectionnez les bords de coupe...") (setq msg2 "\nSélectionnez l'objet à ajuster ou utilisez la touche Maj pour le prolonger") (princ msg1) (setq ss1 (ssget)) (if ss (progn (setq n (sslength ss)) ) ;; Sélection vide, mais pas si vide pour Extend et Trim (progn (setq ThisDrawing (vla-get-ActiveDocument (vlax-get-acad-object))) (setq n (vla-get-count (if (= acModelSpace (vla-get-ActiveSpace ThisDrawing)) (vla-get-ModelSpace ThisDrawing) (vla-get-PaperSpace ThisDrawing) ))) )) (setq continuer "Oui") (if (> n limite) (progn (initget "Oui Non") (setq continuer (getkword (strcat "\nPlus de " (itoa n) " objets implicites. Continuer [Oui/Non] : "))) (if (/= "Oui" Continuer) (setq Continuer "Non")) )) (cond ((= "Non" Continuer) (princ "\nDommage")) ((not ss) (command "_trim" "") (princ msg2)) (t (command "_trim" ss "") (princ msg2)) ) (princ) ) (princ "\nTapez EXTTRIM mais ne vous tapez pas dessus même si on se sent extrim-iste à l'approche de Noël.") (princ) Serge