Patrick_35

Salut Une routine qui convertit des attributs en texte. Je la donne comme exemple car elle ajoute aux codes dxf, les codes 0,1 et 73 (defun c:atxt(/ ent js n new) (and (setq n 0 js (ssget "x" (list (cons 0 "ATTDEF"))) ) (while (setq ent (ssname js n)) (setq ent (entget ent) new (append (list (cons 0 "TEXT") (cons 1 (cdr (assoc 2 ent))) (cons 73 (cdr (assoc 74 ent))) ) (vl-remove-if '(lambda(x)(member (car x) '(-1 0 1 2 3 5 70 73 74 100 280 330))) ent) ) ) (setq new (entget (entmakex new))) (and (not (assoc 6 ent)) (assoc 6 new) (setq new (subst (cons 6 "BYLAYER") (assoc 6 new) new)) (entmod new) ) (and (not (assoc 62 ent)) (assoc 62 new) (setq new (subst (cons 62 256) (assoc 62 new) new)) (entmod ent) ) (and (not (assoc 370 ent)) (assoc 370 new) (setq ent (subst (cons 370 -1) (assoc 370 new) new)) (entmod ent) ) (entdel (cdr (assoc -1 ent))) (setq n (1+ n)) ) ) (princ (strcat "\nConvertion de " (itoa n) " attribut(s) en texte(s).")) (princ) ) @+

Salut http://www.cadlore.com/specialfeatures/softwarearticles/823-how-to-edit-cuix-files-introduced-in-autocad-2010.html @+

Salut Et avec les rtext (express tools) ? @+

Salut Si tu pouvais donner un exemple. philsogood Je n'utilise pas les objets annotatifs (peut-être un tort), alors si tu avais un exemple pour que je regarde. Ou encore sans coche dans la zone sensible. @+

Salut Tu utilises une boucle (while (< cntr lg) puis une convertion (vlax-ename->vla-object (ssname x cntr)) en objet vla Tu peux simplifier en utilisant directement une bloucle en vla Un exemple en vlisp (defun c:fp (/ doc ent sel) (vl-load-com) (setq doc (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark doc) (and (tblsearch "ltype" "cache") (ssget "x" (list (cons 8 "fauxplafond") (cons 62 1))) (progn (vlax-for ent (setq sel (vla-get-activeselectionset doc)) (vla-put-linetype ent "cache") ) (vla-delete sel) ) ) (vla-endundomark doc) (princ) ) Le même en autolisp (defun c:fp (/ ent js n) (command "_.undo" "_begin") (and (tblsearch "ltype" "cache") (setq js (ssget "x" (list (cons 8 "fauxplafond") (cons 62 1)))) (progn (setq n 0) (while (setq ent (ssname js n)) (setq ent (entget ent)) (if (assoc 6 ent) (setq ent (subst (cons 6 "CACHE") (assoc 6 ent) ent)) (setq ent (cons (cons 6 "CACHE") ent)) ) (entmod ent) (setq n (1+ n)) ) ) ) (command "_.undo" "_end") (princ) ) @+

Salut Dans ta sélection générale, tu choisis tout ce qui se trouve sur le calque fauxplafond et de couleur rouge. Tu as donc sûrement un objet dans la sélection qui n'a pas la propriété 'linetype Pour tester si un objet posséde cette propriété, utilise correctement la fonction vlax-property-available-p ou pour éviter cette vérification, tu peux ajouter dans ton filtre la sélection des lignes Je remarque aussi que tu mélange autolisp et vlisp. Fais soit l'un ou l'autre. Ce sera plus simple. De plus, cette ligne est inutile. (setq check (vlax-property-available-p vlaentité1 "Color" T)) Et je remarque aussi dans ton lisp, que tu as une boucle infini. @+

Salut (setq files (vla-get-Files (vla-get-Preferences (vlax-get-acad-object))) proj "Mon_Projet" path "C:\\Work1;C:\\Work2" ) (and (vl-catch-all-error-p (vl-catch-all-apply 'vla-GetProjectFilePath (list files proj))) ;Génére une erreur si le projet n'existe pas (vla-setprojectfilepath files proj path) ) (setvar "projectname" proj) @+

Ok, je n'avais pas bien compris Trouvé dans le marais ;) Lecture (vla-GetProjectFilePath (vla-get-Files (vla-get-Preferences (vlax-get-acad-object))) (getvar "PROJECTNAME") ) Ecriture (vla-SetProjectFilePath (vla-get-Files (vla-get-Preferences (vlax-get-acad-object))) (getvar "PROJECTNAME") "C:\\Work1;C:\\Work2" ) @+

Salut Cela me rappelle ce sondage Ce n'est pas ce que l'on appel la retraite :cool: @+

Salut Ok Quelque chose dans ce style ? (defun c:atxt(/ ent js n new) (and (setq n 0 js (ssget "x" (list (cons 0 "ATTDEF"))) ) (while (setq ent (ssname js n)) (setq ent (entget ent) new (append (list (cons 0 "TEXT") (cons 1 (cdr (assoc 2 ent))) (cons 73 (cdr (assoc 74 ent))) ) (vl-remove-if '(lambda(x)(member (car x) '(-1 0 1 2 3 5 70 73 74 100 280 330))) ent) ) ) (entmake new) (entdel (cdr (assoc -1 ent))) (and (not (assoc 62 ent)) (assoc 62 (setq ent (entget (entlast)))) (setq ent (subst (cons 62 256) (assoc 62 ent) ent)) (entmod ent) ) (setq n (1+ n)) ) ) (princ (strcat "\nConvertion de " (itoa n) " attribut(s) en texte(s).")) (princ) ) @+

Salut C'est un fonctionnement normal. Le lisp ne fait que recopier des valeurs d'attributs d'un bloc vers d'autres et ne crée pas d'attributs sur les blocs de destinations s'ils manquent. Si le bloc d'origine ne contient qu'un attribut, seul la 1er valeur sera recopiée Idem si le bloc de destination ne contient qu'un seul attribut Si le bloc d'origine contient 5 attributs et que les blocs de destination 4, alors 4 valeurs seront recopiées @+

Salut La commande Burst est à utiliser sur les attributs ? Sans décomposer le bloc. @+

Salut Les conditions OU et And peuvent aussi servir de test Tant que la valeur est nil, la condition ou évalue l'argument suivant. Exemple : (ou val1 val2 val3 val4 mon_résultat) val1, val2,val3 et val4 sont nil --> mon_résultat Dès que val1,val2, val3 ou val4 est d'une autre valeur que nil, je n'arrive pas sur mon_résultat Un autre Exemple concret avec un And (and (setq txt (nentsel)) ; Je choisis un objet (setq txt (entget (car txt))) ; Je récupere les codes dxf (member (cdr (assoc 0 txt)) '("TEXT" "MTEXT" "ATTRIB")) ; C'est un Texte ou un attribut (setq pt1 (getpoint "\nindiquez le point de centre : ")) ; Je demande un point (setq pt1 (trans pt1 1 0)) ; je convertis les coordonnées au scu courant (progn .... ) ) Cette fois-ci, la condition est tant que Donc, si je lis correctement (or (vl-string-search (strcase Mon_Repertoire) (strcase (vla-get-supportpath (setq pref (vla-get-files (vla-get-preferences (vlax-get-acad-object))))))) Si je ne trouve pas la chaîne de caractères contenus dans la variable Mon_Repertoire dans les chemins de recherches (vla-put-supportpath pref (strcat Mon_Repertoire ";" (vla-get-supportpath pref))) alors je l'ajoute. Pour distinguer un répertoire dans la chaîne de caractères de (vla-get-supportpath ...), c'est le ; qui sert de séparation. C'est le même principe qu'en dos avec la variable path @+

Salut (or (vl-string-search (strcase Mon_Repertoire) (strcase (vla-get-supportpath (setq pref (vla-get-files (vla-get-preferences (vlax-get-acad-object))))))) (vla-put-supportpath pref (strcat Mon_Repertoire ";" (vla-get-supportpath pref))) ) ps : Si tu travailles sur plusieurs projets, tu risques à un moment de bloquer avec les chemins de recherches car tu dois avoir une limite au nombre de caractères (j'ignore combien) @+

Salut (gile) Ah oui, c'est ce qui fait la richesse du site :D Pas avec une résol @+l

Salut Ah, (gile) à mis sa routine. Bon, je mets quand même la mienne, histoire de n'avoir pas bossé pour rien ;) (defun c:dtxt(/ ang der dxf jus lec pt1 pt2 sor txt) (and (setq txt (nentsel)) (setq txt (entget (car txt))) (member (cdr (assoc 0 txt)) '("TEXT" "MTEXT" "ATTRIB")) (setq pt1 (getpoint "\nindiquez le point de centre : ")) (setq pt1 (trans pt1 1 0)) (progn (while (not sor) (setq lec (grread T 1 0)) (and der (entdel der)) (cond ((or (and (eq (car lec) 2) (member (cadr lec) '(13 32))) (member (car lec) '(3 25)) ) (setq sor t) ) ((and (eq (car lec) 5) (not (equal (cadr lec) pt1))) (setq pt2 (trans (cadr lec) 1 0) ang (angle pt1 pt2) )(setq bb ang) (cond ((eq ang 0) (setq jus '(0 2 4)) ) ((and (> ang 0) (< ang (/ pi 2))) (setq jus '(0 1 7)) ) ((eq ang (/ pi 2)) (setq jus '(1 1 8)) ) ((and (> ang (/ pi 2)) (< ang pi)) (setq jus '(2 1 9)) ) ((eq ang pi) (setq jus '(2 2 6)) ) ((and (> ang pi) (< ang (+ pi (/ pi 2)))) (setq jus '(2 3 3)) ) ((eq ang (+ pi (/ pi 2))) (setq jus '(1 3 2)) ) (T (setq jus '(0 3 1)) ) ) (cond ((eq (cdr (assoc 0 txt)) "TEXT") (setq txt (subst (cons 11 pt2) (assoc 11 txt) txt) txt (subst (cons 72 (car jus)) (assoc 72 txt) txt) txt (subst (cons 73 (cadr jus)) (assoc 73 txt) txt) ) ) ((eq (cdr (assoc 0 txt)) "ATTRIB") (setq txt (subst (cons 11 pt2) (assoc 11 txt) txt) txt (subst (cons 72 (car jus)) (assoc 72 txt) txt) txt (subst (cons 74 (cadr jus)) (assoc 74 txt) txt) ) ) (T (setq txt (subst (cons 10 pt2) (assoc 10 txt) txt) txt (subst (cons 71 (caddr jus)) (assoc 71 txt) txt) ) ) ) (entmod txt) (entmake (list (cons 0 "LINE") (cons 10 pt1) (cons 11 pt2) ) ) (setq der (entlast)) ) ) ) ) ) (princ) ) @+

Salut Pour Autocad Electrical 2009 --> http://www.autodesk.com @+

Salut Un sujet à lire. @+

Si, si Entrez une option [Valeur/POsition/Hauteur/Angle/[surligneur]Style[/surligneur]/CAlque/COuleur/suivaNt] Sinon, avec l'un des deux lisps donné pas (gile) (dont un en pur autolisp :P ) @+

Salut Regarde la commande -attedit @+

Salut J'ai aussi un peu simplifié le filtre (defun c:convline (/ t70_et_t100) (if (setq t70_et_t100 (ssget "_x" (list (cons -4 " (cons 0 "TEXT,MTEXT") (cons -4 " (cons 62 2) (cons 62 3) (cons -4 "or>") (cons -4 "and>") ) ) ) (command "_.chprop" t70_et_t100 "" "_color" "150" "") ) ) Alors, regarde un peu les codes dxf et les fonctions entget, subst et entmod @+

Merci (gile) Mais je n'ai pas un grand mérite, c'est Elpanov Evgeniy qui m'a mis sur la piste des onglets C'est vrai que jouer avec les activex est passionnant, mais on y laisse des cheveux ;) Je suis en ce moment en plein ADO, et ce n'est pas facile, c'est le moins que l'on puisse dire. Je trouve des routines (tous langage sauf vlisp, trop facile :cool: ) qu'il faut comprendre. Je suis aussi de ton avis, ADO semble très prometteur si on n'a pas peur de relever les manches. Je songe à des routines qui pourront lire/écrire aussi bien des documents Excel que des Documents OpenOffice et je pense qu'ADO pourrait-être la passerelle. @+

Salut Salut J'ai une solution en vlisp et utilisant ADO ; Connexion sur le fichier Excel ; Retourne la connexion si tout s'est bien passé, sinon nil ; ; 1er argument --> Nom du fichier ; ; Pour ceux qui ont la version antérieur à Office 2007 ; il faut que AccessDatabaseEngine.exe (25.3Mo) soit installé pour lire les fichiers xlsx ; http://www.microsoft.com/downloads/fr-fr/confirmation.aspx?familyId=7554f536-8c28-4598-9b72-ef94e038c891&displayLang=fr (defun Connexion_Xls(fichier / adoconnect data) (setq adoconnect (vlax-create-object "ADODB.Connection")) (if (eq (strcase (vl-filename-extension fichier)) ".XLSX") (setq data (strcat "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" fichier ";Extended Properties='Excel 12.0;HDR=No;IMEX=1'" ) ) (setq data (strcat "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" fichier ";Extended Properties=;Excel 8.0;HDR=No;IMEX=1" ) ) ) (if (vl-catch-all-error-p (vl-catch-all-apply 'vlax-invoke-method (list adoconnect 'Open data "" "" nil ) ) ) nil adoconnect ) ) ; Liste des onglets ; Retourne la liste des onglets si tout s'est bien passé, sinon nil ; ; 1er argument --> Connexion excel (obtenu avec Connexion_Xls) (defun Liste_Onglets(Connexion / resultat) (if (and (not (vl-catch-all-error-p (setq resultat (vl-catch-all-apply 'vlax-invoke-method (list Connexion 'OpenSchema 20))))) (not (vl-catch-all-error-p (setq resultat (vl-catch-all-apply 'vlax-invoke-method (list resultat 'GetRows 65535))))) ) (mapcar '(lambda(x) (vl-string-right-trim "$" x)) (vl-remove-if-not '(lambda(x) (wcmatch x "*$")) (caddr (mapcar '(lambda(x) (mapcar 'vlax-variant-value x)) (vlax-safearray->list (vlax-variant-value resultat)) ) ) ) ) nil ) ) (defun Fermer_Xls(Connexion) (vl-catch-all-apply 'vlax-invoke (list Connexion 'Close)) (vl-catch-all-apply 'vlax-release-object Connexion) ) (setq fil (getfiled "Sélectionner le fichier Excel" "" "xls;xlsx" 0)) (setq mon_xls (connexion_xls fil)) (fermer_xls mon_xls) Tramber Et en installantAccessDatabaseEngine.exe ? @+

Pour parcourir toutes les lignes de la feuille (vlax-get (vlax-get (vlax-get feuille 'usedrange) 'rows) 'count) Et toutes les colonnes (vlax-get (vlax-get (vlax-get feuille 'usedrange) 'columns) 'count) @+

Salut Juste une question. Pourquoi ne pas lire la valeur d'une cellule alors que tu as déjà tout programmé ? Ce n'est pas pour dénigrer les fonctions que (gile) a donné, bien au contraire car elles sont oh combien utiles pour ceux qui ne savent pas programmer Excel, mais au point ou tu en es, cela fait doublon (setq feuille (vlax-get-property (vlax-get filo 'sheets) 'item 1)) ; pointer sur la 1er Feuille (setq cellule (vlax-get-property feuille 'range "B5")) ; Lecture de la cellule B5 (vlax-get cellule 'value2) ; Valeur de la cellule @+