jacobs33

Salut, pourquoi du lisp, Fait directement une feuille de calcul EXCEL... :) :)

salut, Je voulais Faire un truc dans le genre mais le problème c'est que la "case" n'est pas respectée ça devient compliqué exemples : sdfsf 1.00m2 sdfdsf sdfsf 12.00m2 sdfdsf sdfsf 12.00 m2 sdfdsf sdfsf 13.0 m2 ci quelqu'un a une solution plus simple je prend. sinon je vais utiliser la commande _find.... (defun c:crtxt (/ sel1 n ent Asso1 pos) (setq sel1 (ssget "X" '((0 . "*TEXT")))) (cond (sel1 (setq n 0) (while (setq entname (ssname sel1 n)) (setq ent (entget entname) Asso1 (cdr (assoc 1 ent)) Longasso1 (strlen Asso1) pos (vl-string-search "m2" asso1) ) (setq ApresPos (substr asso1 (+ 5 pos))) (setq AvantPos (substr asso1 1 (- pos 5))) (setq nouvelChaine (STRCAt AvantPos ApresPos)) (entmod (subst (cons 1 nouvelChaine) (assoc 1 ent) ent) ) (setq n (1+ n)) ) ) ) (prin1) )

Bourjour, J'ai bien essayé de comprendre ce qu'il ce passé avec les "dictionary" mais je jette l'éponge... Pour conclure sur sujet voici le code que je vais utiliser pour renommer et incrémenter les tables. Merci à tous pour vont suggestions et votre aide. :D :D :D (defun c:ADWG (/ RefBase IncreNumérique Incretexte NouvoNon AncienNon elst) ;;;----------------------------Sous Programme Table----------------- (defun SousProgTable (Table Filtre Prefixe) (setq RefBase (tblnext Table t)) (setq IncreNumérique 1) (while RefBase (setq AncienNon (cdr (assoc 2 RefBase))) (if (not (wcmatch AncienNon Filtre)) (progn (setq NouvoNon (strcat Prefixe (itoa IncreNumérique))) (setq elst (entget (tblobjname Table AncienNon))) (setq RefBase (subst (cons 2 NouvoNon) (assoc 2 elst) elst)) (entmod RefBase) (setq IncreNumérique (1+ IncreNumérique)) ) ) (setq RefBase (tblnext Table)) ) ) ;;;----------------------------Sous Programme rename--------------- (defun SousProgBlock (Table Filtre Prefixe) (setq RefBase (tblnext Table t)) (setq IncreNumérique 1) (while RefBase (setq AncienNon (cdr (assoc 2 RefBase))) (if (not (cdr (assoc 1 RefBase))) (if (not (wcmatch AncienNon Filtre)) (progn (setq NouvoNon (strcat Prefixe (itoa IncreNumérique))) (command "_rename" "bl" AncienNon NouvoNon) (entmod RefBase) (setq IncreNumérique (1+ IncreNumérique)) ) ) ) (setq RefBase (tblnext Table)) ) ) ;;;----------------------------Table LAYER-------------------------- (SousProgTable "LAYER" "0,Defpoints,*|*" "LAY-") ;;;----------------------------Table LTYPE-------------------------- (SousProgTable "LTYPE" "Standard" "LTY-") ;;;----------------------------Table VIEW--------------------------- (SousProgTable "VIEW" "`**" "VUE-") ;;;----------------------------Table STYLE-------------------------- (SousProgTable "STYLE" "Standard" "STYLE-") ;;;-------------------------------Table UCS------------------------- (SousProgTable "UCS" "Standard" "UCS-") ;;;------------------------------Table VPORT------------------------ (SousProgTable "VPORT" "Standard" "VPORT-") ;;;------------------------------Table DIMSTYLE--------------------- (SousProgTable "DIMSTYLE" "Standard" "DIM-") ;;;-------------------------------Table APPID---------------------- (SousProgTable "APPID" "Standard" "APP-") ;;;------------------------------Traitement bBlock------------------ (SousProgBlock "BLOCK" "`**,*|*" "BLK-") )

Bonsoir, Cela peu venir du type de police que tu as dans ton dessin, passe tes style de texte en police Simplex ou Romans (pas de police type arial)

Merci pour vos réponses Super Effectivement je me suis tromper de forum ne suis pas un PRO, (plutôt vieux débutant) mais un petit gars qui écris quelque lignes de temps en temps pour me simplifier la vie. -comment faire pour changer le sujet de forum? l'idée de ce code et de supprimer les Textes de la forme 00.00 m2 et 0.00 m2 dans le dessin. Je viens d'essayer avec le fonction "subst" ça me fonctionne pas. (defun c:crtxt (/ sel1 ent Asso0 Asso1 NewAsso1) (setq sel1 (ssget "X" '((0 . "*TEXT")))) (setq n 0) (while (setq entname (ssname sel1 n)) (setq ent (entget entname)) (setq Asso0 (cdr (assoc 0 ent))) (setq Asso1 (cdr (assoc 1 ent))) (if (wcmatch Asso1 "*?.00 m2*,*??.00 m2*") (progn (setq NewAsso1 (vl-string-subst "" [surligneur]"*??.00 m2*"[/surligneur] Asso1)) (setq ent (subst (cons 1 NewAsso1) (assoc 1 ent) ent)) (ENTMOD ent) ) ) (setq n (1+ n)) ) )

Bonjour, je viens d'écrire ce bout de code qui recherche et remplace du texte dans un jeux de sélection. question 1: pourquoi le message suivant quand je charge le code. " erreur: parenthèse fermante supplémentaire en entrée question 2:pourquoi le message suivant a la fin de l'exécution du code " erreur: type d'argument incorrect: lentityp nil" question 3: la fonction "Subst" ne supporte pas bien les caractères génériques. exemple: (vl-string-subst "" "??.00 m2" Asso1)) (vl-string-subst "" "?.00 m2" Asso1)) existe t'il une autre fonction? (defun c:crtxt (/ sel1 ent Asso0 Asso1 NewAsso1) (setq sel1 (ssget "X" '((0 . "*TEXT")))) (setq n 0) (while (setq ent (entget (ssname sel1 n))) (setq Asso0 (cdr (assoc 0 ent))) (setq Asso1 (cdr (assoc 1 ent))) (if (wcmatch Asso0 "*TEXT") (if (wcmatch Asso1 "*?.00 m2*,*??.00 m2*") (progn (setq NewAsso1 (vl-string-subst "" "18.00 m2" Asso1)) (setq ent (subst (cons 1 NewAsso1) (assoc 1 ent) ent)) (ENTMOD ent) ) ) ) (setq n (1+ n)) ) ) Merci d'avance pour votre participation et vos réponses. :) :)

Si j'ai bien compris il faut que je charge d'abord le code de Patrick35 et ensuite le code qui suit pour passer en revue les tables "block" et "Layers" afin d' avroir une seule command a envoyer. (defun c:reno () (pat:renommer "BLOCK" "`**,*|*" "BLK-") (pat:renommer "LAYER" "*|*" "LAY-") (princ) ) Ou bien ce genre de chose (defun c:reno () (defun pat:renommer (table filtre prefixe / doc ele IncreNumérique) (vl-load-com) (setq doc (vla-get-activedocument (vlax-get-acad-object)) IncreNumérique 1 ) (vla-startundomark doc) (vlax-for ele (eval (read (strcat "(vla-get-" table "s doc)"))) (or (wcmatch (vla-get-name ele) filtre) (vla-put-name ele (strcat prefixe (itoa IncreNumérique))) (setq IncreNumérique (1+ IncreNumérique)) ) ) (vla-endundomark doc) (princ) ) (pat:renommer "BLOCK" "`**,*|*" "BLK-") (pat:renommer "LAYER" "*|*" "LAY-") (princ) ) Par contre je revient sur ma question 2 Et pour finir le regarde demain dans les dictionnnaires avec les commandes "dictnext" qui je l'espére fonctionne un comme "tblnext"..... :) bonsoir a tous Je viens de jeter a coup œil ce n'est pas gagner....... [Edité le 31/5/2010 par jacobs33] J'ai rejeté deux coup d'yeux je n'y comprend rien.... [Edité le 1/6/2010 par jacobs33] [Edité le 2/6/2010 par jacobs33]

Bonjour a tous, Je relance le sujet car me pose encore beaucoup de questions. -Question 1: [surligneur] (defun pat:renommer(table filtre prefixe / doc ele IncreNumérique)[/surligneur] (vl-load-com) (setq doc (vla-get-activedocument (vlax-get-acad-object)) ...... ...... (princ) ) (pat:renommer "block" "`**,*|*" "LAY-") Comment doit t'ont lancer la commande sous "autocad" C:renommer. je suppose que : "block" prend la place de table dans la ligne surlignée. "`**,*|*" prend la place de Filtre dans la ligne surlignée. "LAY-" prend la place de prefixe dans la ligne surlignée. - Question 2: la routine de patrick fonctionne bien avec la table des "blocs" par contre j'ai essayer 'd'ecrire la meme chose pour la table des layer(s) mais ça ne fonctionne pas. :casstet: pourquoi ça marche pas .....? (defun c:reno (/ doc ele IncreNumérique) (vl-load-com) (setq doc (vla-get-activedocument (vlax-get-acad-object)) IncreNumérique 1 ) (vla-startundomark doc) (vlax-for ele (eval (read (strcat "(vla-get-" "LAYER" "s doc)"))) (or (wcmatch (vla-get-name ele) "*|*") (vla-put-name ele (strcat "LAY-" (itoa IncreNumérique))) (setq IncreNumérique (1+ IncreNumérique)) ) ) (vla-endundomark doc) (princ) ) - Question 3: Comment je peux récupérer les "tables" des "fenêtres" des "matériaux" des "styles de ligne de repères multiples" et des "style de tableaux".

Bonjour, Je testé cette solution sur les versions 2010 et 2008 ça fonctionne. 1 - Créer un fichier lisp que tu appel CVAV_v101.lsp tu colle le code donné ci dessous a l'intérieur. 2 - tu efface tous les fichiers AutoCAD.lsp des repertoires. 2 - tu charge au démarrage de chaque dessins le fichier CVAV_v101.lsp outil>charger une application>contenu au demarage. 3 - tu offre tes fichiiers autocad et au fur et à mesure ton probléme devrais etre supprimé. A chaque offrerture de fichiers tu doit voir sur la ligne de command ce message : **************************************** CADViet AntiVirus v1.01 is starting ... CADViet AntiVirus finishes scanning ... No infected files were found! **************************************** ;; --------- Fix AutoCAD.lsp virus --------- ;; Free lisp from CADViet.com (setq removedcodelist (list ";; Silent load." "(princ)" "(load \"acadapp\")" "(load \"ddcopy.lsp\")" "" ) infectedcodelist (strcat "(load \"acadapp\")," "(load \"ddcopy.lsp\")," "(setq path (findfile \"base.dcl\"))" ) restoresv (list (cons "cmdecho" 1) (cons "zoomfactor" 60) (cons "mbuttonpan" 1) (cons "HIGHLIGHT" 1) (cons "fillmode" 1) ) restorecmd (list "plot" "u" "qsave" "line" "quit" "trim" "extend" "move" "xplode" "xref" "xbind" ) ) (princ "\n") (princ "\n") (princ "\n****************************************") (princ "\nCADViet AntiVirus v1.01 is starting ...") (setq ifile 0) (vl-load-com) (setq support_path (findfile "base.dcl") support_path (substr support_path 1 (- (strlen support_path) 8)) nowdwg (getvar "dwgname") wjqm (findfile nowdwg) wjqm (if wjqm wjqm nowdwg ) dwg_path (substr wjqm 1 (- (strlen wjqm) (strlen nowdwg))) removedlist (list (strcat support_path "acadapp.lsp") (strcat support_path "acadappp.lsp") (strcat support_path "ddcopy.lsp") (strcat dwg_path "acad.lsp") ) fixedlist (list (strcat support_path "acad.mnl") (strcat support_path "acad.lsp") ) ) (defun fixvr (fn / content infected) (if (setq ff (open fn "r")) (progn (while (setq str (read-line ff)) (if (not (member str removedcodelist)) (setq content (append content (list str))) (if (wcmatch str infectedcodelist) (setq infected t) ) ) ) (close ff) (if infected (progn (setq ff (open fn "w")) (foreach str content (write-line str ff) ) (close ff) (princ (strcat "\nfile " fn " was fixed!")) (setq ifile (1+ ifile)) ) ) ) ) ) (foreach fn removedlist (if (vl-file-delete fn) (progn (princ (strcat "\nfile " fn " was deleted!")) (setq ifile (1+ ifile)) ) ) ) (foreach fn fixedlist (fixvr fn) ) (princ "\nCADViet AntiVirus finishes scanning ...") (if (= ifile 0) (princ "\nNo infected files were found!") (progn (setvar "cmdecho" 0) (mapcar '(lambda (cn) (setvar (car cn) (cdr cn))) restoresv) (mapcar '(lambda (cn) (command ".redefine" cn)) restorecmd) (princ (strcat "\nTotal " (itoa ifile) " infected files were found and removed!" ) ) (setvar "cmdecho" 1) ) ) (princ "\n****************************************") (princ "\n") (princ "\n") (princ)

J'ai rajouté ça [surligneur] (vl-load-com) [/surligneur] et ça fonctionne beaucoup mieux. (defun c:reno (/ doc ele IncreNumérique) [surligneur] (vl-load-com) [/surligneur] (setq doc (vla-get-activedocument (vlax-get-acad-object)) IncreNumérique 1 ) (vla-startundomark doc) (vlax-for ele (eval (read (strcat "(vla-get- " "BLOCK" "s doc)"))) (or (wcmatch (vla-get-name ele) "`**,*|*" ) (vla-put-name ele (strcat "BLK-" (itoa IncreNumérique))) (setq IncreNumérique (1+ IncreNumérique)) ) ) (vla-endundomark doc) (princ) ) [Edité le 21/5/2010 par jacobs33]

Bonjour, J'ai remplcé TABLE FILTRE PREFIXE PAR "BLOCK" "`**,*|*" "BLK-" Mais autocad me renvoi ce message d'erreur ? [surligneur] Commande: reno ; erreur: no function definition: VLAX-GET-ACAD-OBJECT Commande: [/surligneur] (defun c:reno (/ doc ele IncreNumérique) (setq doc (vla-get-activedocument (vlax-get-acad-object)) IncreNumérique 1 ) (vla-startundomark doc) ; Début d'un undo en cas d'annulation (vlax-for ele (eval (read (strcat "(vla-get- [surligneur]" "BLOCK" [/surligneur] "s doc)"))) (or (wcmatch (vla-get-name ele) [surligneur] "`**,*|*" [/surligneur] ) (vla-put-name ele (strcat [surligneur]"BLK-" [/surligneur] (itoa IncreNumérique))) (setq IncreNumérique (1+ IncreNumérique)) ) ) (vla-endundomark doc) ; Fin du undo (princ) )

Voila j'ai test les deux lignes pour le controle des variiables. J'ai Testé sur la ligne de commande: 1-(setq save_var (atoms-family 1)) 2-exécution du lisp. 3-(vl-remove-if '(lambda(x)(member x save_var))(atoms-family 1)) - Renvoie : ("C:ADWG" "SOUSPROGRENAME" "SAVE_VAR" "SOUSPROGTABLE") Intéger dans le code: - renvoie : ("ANCIENNON" "INCRENUMERIQUE" "NOUVONON" "ELST") -Quel est la bonne méthode ? -Les renvois sont ils bons ? -comme balayer les "Matériaux" "style Ligne de repère multiple "styleTAbleau" ? Patrick merci pour tes explications sur les commandes "VLA" je vais regarder et analyse ça se soir avec Moi et mon "cerveaux" car pour l'instant je n'ai pas réussi a lancer la routine. En plus Mon Moi ma dit que j'avais un peu de Boulot (par les temps qui cours.....) (defun c:ADWG (/ RefBase IncreNumérique Incretexte NouvoNon AncienNon elst) [surligneur](setq save_var (atoms-family 1))[/surligneur] ;;;----------------------------Sous Programme Table----------------------- (defun SousProgTable (Table Filtre Prefixe) (setq RefBase (tblnext Table t)) (setq IncreNumérique 1) (while RefBase (setq AncienNon (cdr (assoc 2 RefBase))) (if (not (wcmatch AncienNon Filtre)) (progn (setq NouvoNon (strcat Prefixe (itoa IncreNumérique))) (setq elst (entget (tblobjname Table AncienNon))) (setq RefBase (subst (cons 2 NouvoNon) (assoc 2 elst) elst)) (entmod RefBase) (setq IncreNumérique (1+ IncreNumérique)) ) ) (setq RefBase (tblnext Table)) ) ) ;;;----------------------------Sous Programme rename--------------- (defun SousProgRename (Table Filtre Prefixe) (setq RefBase (tblnext Table t)) (setq IncreNumérique 1) (while RefBase (setq AncienNon (cdr (assoc 2 RefBase))) (if (not (cdr (assoc 1 RefBase))) (if (not (wcmatch AncienNon Filtre)) (progn (setq NouvoNon (strcat Prefixe (itoa IncreNumérique))) (command "_rename" "bl" AncienNon NouvoNon) (entmod RefBase) (setq IncreNumérique (1+ IncreNumérique)) ) ) ) (setq RefBase (tblnext Table)) ) ) ;;;----------------------------Table LAYER-------------------------- (SousProgTable "LAYER" "0,Defpoints,*|*" "LAY-") ;;;----------------------------Table LTYPE-------------------------- (SousProgTable "LTYPE" "Standard" "LTY-") ;;;----------------------------Table VIEW--------------------------- (SousProgTable "VIEW" "`**" "VIE-") ;;;----------------------------Table STYLE-------------------------- (SousProgTable "STYLE" "Standard" "STY-") ;;;-------------------------------Table UCS------------------------- (SousProgTable "UCS" "Standard" "UCS-") ;;;------------------------------Table VPORT----------------------- (SousProgTable "VPORT" "Standard" "VPO-") ;;;------------------------------Table DIMSTYLE-------------------- (SousProgTable "DIMSTYLE" "Standard" "DIM-") ;;;;-------------------------------Table APPID----------------------- (SousProgTable "APPID" "Standard" "APP-") ;;;------------------------------Traitement bBlock----------------- (SousProgRename "BLOCK" "`**,*|*" "BLK-") [surligneur] ;;;----------------------------Traitement Materiaux----------------- (SousProgRename "?????" "`**,*|*" "MAT-") [/surligneur] [surligneur] (vl-remove-if '(lambda (x) (member x save_var)) (atoms-family 1) ) [/surligneur] )

Bonjour, J'etais parti sur ce genre de chose en lisp avec un sous programme pour "Aléger" le code. Petites Questions au passage: 1) Les lignes SousProg peuvent etre t'elles placées en tête du code, j'ai fais des testes mais cela n'est claire pour moi. 2) la déclaration des variables est elle bonne. (defun c:ADWG (/ RefBase IncreNumérique Incretexte NouvoNon AncienNon elst) (defun SousProg (Table1 Filtre Prefixe Table2 Table3) (setq RefBase (tblnext Table1 t)) (setq IncreNumérique 1) (while RefBase (setq AncienNon (cdr (assoc 2 RefBase))) (if (not (wcmatch AncienNon Filtre)) (progn (setq NouvoNon (strcat Prefixe (itoa IncreNumérique))) (setq elst (entget (tblobjname Table2 AncienNon))) (setq RefBase (subst (cons 2 NouvoNon) (assoc 2 elst) elst)) (entmod RefBase) (setq IncreNumérique (1+ IncreNumérique)) ) ) (setq RefBase (tblnext Table3)) ) ) ;;;----------------------------Table LAYER-------------------------- (SousProg "LAYER" "0,Defpoints,*|*" "aaa-" "LAYER" "LAYER") ;;;;;;----------------------------Table LTYPE-------------------------- (SousProg "LTYPE" "Standard" "aaa-" "LTYPE" "LTYPE") ;;;;;;----------------------------Table DIMSTYLE-------------------------- (SousProg "DIMSTYLE" "Standard" "aaa-" "DIMSTYLE" "DIMSTYLE") ;;;;;;----------------------------Table STYLE-------------------------- (SousProg "STYLE" "Standard" "aaa-" "STYLE" "STYLE") ;;;;;;----------------------------Table DIMSTYLE-------------------------- (SousProg "UCS" "Standard" "aaa-" "UCS" "UCS") ;;;;;;----------------------------Table DIMSTYLE-------------------------- (SousProg "BLOCK" "`**" "aaa-" "BLOCK" "BLOCK") ) Pour ton code je ne connais rien au Commande "VLA" Peu tu être un peu plus explicite Merci. (defun pat:renommer([surligneur]"layer" "0,Defpoints,*|*" "xx-" [/surligneur] / doc ele IncreNumérique) (setq doc (vla-get-activedocument (vlax-get-acad-object)) IncreNumérique 1 ) (vla-startundomark doc) (vlax-for ele (eval (read (strcat "(vla-get-" table "s doc)"))) (or (wcmatch (vla-get-name ele) filtre) (vla-put-name ele (strcat prefixe (itoa IncreNumérique))) (setq IncreNumérique (1+ IncreNumérique)) ) ) (vla-endundomark doc) (princ) )

Bonjour, Nom code ce construit petit à petit tables "LAYER" "DIMSTYLE" "STYLE" "UCS" Ok Mais je but sur la table de blocK qui ne ce mais pas à jours, la manip fonctionne avec la commande "renommer" mais pas avec le "subst" j'ai filtré les xrefs... mais ca ne vient pas de là enfin je crois... (defun c:ADWG (/ RefBase IncreNumérique Incretexte NouvoNon AncienNon elst) ;;;;;;---------------------------- (setq RefBase (tblnext "BLOCK" t)) (setq IncreNumérique 1) (while RefBase (setq AncienNon (cdr (assoc 2 RefBase))) (if (cdr (assoc 1 RefBase)) (progn (if (not (wcmatch AncienNon "`**,*|*")) (progn (setq NouvoNon (strcat "all-" (itoa IncreNumérique))) (setq elst (entget (tblobjname "BLOCK" AncienNon))) (setq elst (subst (cons 2 NouvoNon) (assoc 2 elst) elst)) (entmod elst) (setq IncreNumérique (1+ IncreNumérique)) ) ) ) ) (setq RefBase (tblnext "BLOCK")) ) )

merci pour ces explications. j'ai modifié "elst" en Reflay" pour que ça fonction. Si j'ai bien compris pour l'incrémentation aprés le test c'est pour éviter un trou dans l'incrémentation. (defun c:ADWG (/ RefLay IncreNumérique Incretexte NouvoNon AncienNon) (setq RefLay (tblnext "layer" t)) (setq IncreNumérique 1) (while RefLay (setq AncienNon (cdr (assoc 2 RefLay))) (if (not (wcmatch AncienNon "0,Defpoints,*|*,xx-*")) (progn (setq IncreNumérique (1+ IncreNumérique)) (setq NouvoNon (strcat "xx-" (itoa IncreNumérique))) (setq elst (entget (tblobjname "LAYER" AncienNon))) (setq RefLay (subst (cons 2 NouvoNon) (assoc 2 elst) elst)) (entmod [surligneur] RefLay [/surligneur]) ) ) (setq RefLay (tblnext "layer")) ) ) Je vais poursuivre dans cette voie pour les autres Tables A+ [Edité le 18/5/2010 par jacobs33]