LUDWIG

Sinon, jJ'avais fait ce lisp , qui met les entités composants les blocs sur le calque 0mais conserve la couleur d'origine. (defun c:nb2 () (setq echoold (getvar "cmdecho")) (setvar "cmdecho" 0) ;(command "-calque" "a" "e" "Normalise" "" "" "") (COMMAND "-calque" "L" "*" "AC" "*" "D" "*" "") (COMMAND "-calque" "E" "0" "") ;Normalisation des blocs dans la table des blocs (if (/= nil (setq i (tblnext "block" t)))(progn ; RECHERCHE LA PREMIERE ENTREE DANS LA TABLE DES BLOCS (setq tot 1) (while i (setq n (cdr (assoc -2 i))) ; SELECTIONNE LA PREMIERE ENTITE QUI COMPOSE LE BLOC (while n (setq n (entget n)) (setq colorigin (cdr (assoc 62 n))) (if (or (= nil colorigin)(= 256 colorigin)(= "BYLAYER" colorigin))(setq colorigin (cdr(assoc 62 (tblsearch "layer" (cdr (assoc 8 n))))))) (if (> 0 colorigin)(setq colorigin (- 0 colorigin))) ;Récupère la couleur de l'entité d'origine (ou de son calque si la couleur est "bylayer") ; RECUPERE LES VALEURS DES ENTITES QUI COMPOSE LE BLOC (if (/= (cdr (assoc 8 n)) "0") (progn (setq n (subst (cons 8 "0") (assoc 8 n) n)) ;SI L'ENTITE N'EST PAS SUR 0, LA DEPLACE SUR 0 (entmod n) ) ;_ Fin de progn ) ;_ Fin de if (if (not (assoc 62 n)) ;SI L'ENTITE N'A PAS LE CODE DXF 62 (=DuCalque), LE CREE ET LUI AFFECTE LA VALEUR de son calque d'origine (setq n (append n (list (cons 62 colorigin))))) ;CHANGE LA COULEUR EN COULEUR D4ORIGINE (setq n (subst (cons 62 colorigin) (assoc 62 n) n)) (entmod n) (setq n (entnext (cdr (assoc -1 n)))) ;ENTITE SUIVANTE ) ;_ Fin de while (setq i (tblnext "block") tot (1+ tot) ) ;BLOC SUIVANT ) ;_ Fin de while ;Normalisation des étiquettes d'attributs de blocs dans le dessin (car une étiquette peut avoir des valeurs de calque, couleur, etc. différentes de l'attribut) (setq sel (ssget "x" (list (cons 0 "INSERT")))) (setq j 0) (setq nat 0) (while (ssname sel j) (setq n (entget (ssname sel j))) (if (assoc 66 n) (progn (setq i (entget (entnext (cdr (assoc -1 n))))) (while (/= (cdr (assoc 0 i)) "SEQEND") (setq i (subst (cons 8 "0") (assoc 8 i) i)) ; mettre l'attribut sur le calque 0 (if (not (assoc 62 i))(setq i (append i (list (cons 62 0))))) (if (/= (cdr (assoc 62 i)) 0)(setq i (subst (cons 62 0) (assoc 62 i) i))) ; mettre l'attribut en couleur dubloc (entmod i) ; modifier l'entité (entupd (cdr (assoc -1 i))) ; mettre à jour sur l'écran l'entité (setq nat (+ 1 nat)) (setq i (entget (entnext (cdr (assoc -1 i))))) ) ;_ Fin de while ) ;_ Fin de progn ) ;_ Fin de if (setq j (1+ j)) ) ;_ Fin de while ;Résultat ;----------------------------------------------- (princ (strcat "\nTraitement de " (itoa (+ tot nat)) " bloc(s) (" (itoa tot) " dans la table des blocs et " (itoa nat) " étiquette(s) d'attribut(s) de bloc(s) dans le dessin)" ) ;_ Fin de strcat ) ;_ Fin de princ ;(command "-calque" "a" "s" "Normalise" "" "") (command "regen") (setvar "cmdecho" echoold) (graphscr) (princ) ) ) ) (prompt "\nnb2 : Normaliser les blocs du dessin (calque 0 - Couleur d'ORIGINE)" ) ;_ Fin de prompt

C'est une question récurrente et (gile), entre autre, à fait ce très bon lisp http://pagesperso-orange.fr/gile/LISP/Edit_bloc_3.5.zip

J'avais ce lisp pour dégrouper les groupes Tu peux peut être l'adapter avec un sssetfirst ;Décomposer les groupes (defun c:supgp () (setq dictgroup (dictsearch (namedobjdict) "acad_group")) (setq dictgroup (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 350 (car x))) dictgroup ) ;_ Fin de vl-remove-if-not ) ;_ Fin de mapcar ) ;_ Fin de setq ;;;(initget "Oui Non") ;;;(setq reponse ;;;(getkword ;;;(strcat ;;;"\nIl y a " ;;;(itoa (length dictgroup)) ;;;" groupes dans le dessin, voulez vous les supprimer ? [Oui/Non] :" ;;;) ;_ Fin de strcat ;;;) ;_ Fin de getkword ;;;) ;_ Fin de setq (setq reponse "Oui") (if (equal reponse "Non") (exit) ) ;_ Fin de if (setq i 0 ) ;_ Fin de setq (repeat (length dictgroup) (entdel (nth i dictgroup)) (setq i (1+ i)) ) ;_ Fin de while (princ (strcat "\n" (itoa i) " groupes ont été suprimés.")) (princ) ) ;_ Fin de defun

- commande fermerruban pour fermer le ruban - clic droit dans la zone en bas à gauche sur l'icone tout à fait à droite "afficher les onglets présentations et objets" - commande menubar puis 1 pour retrouver la barre des menus - enregistre ton espace de travail pour pouvoir le retrouver

en purgeant les applications peut être ?

Bonjour, J'ai testé ton lisp, il a l'air beaucoup plus rapide que le mien, (même s'il ne fait pas les sous répertoires, je n'en ai pas forcement besoin). Par contre, pourrais-tu me dire quelle serait la modif à faire pour inclure les fichier dvb, arx et fas ? Je ne comprends le wcmatch x, je suppose que c'est pour exclure des fichiers, dont justement le lisp qui charge tout (sinon boucle). Mais *`~*,`#*`# je ne vois pas. Merci d'avance

Non je ne vois pas mais vérifies déjà que ton autocad 2008 soit à jour des service pack éventuels (commande _about)

Je suppose qu'un lisp que tu utilises a un bout de code qui change les unités. Ca m'est déjà arrivé. recherche (command "units") ou quelque chose de similaire dans tes lisps.

Tu utilise quoi pour faire ça ? Ca m'a rappelé que j'avais créer un lisp pour faire ça http://www.cadxp.com/modules.php?op=modload&name=XForum&file=viewthread&tid=9756#pid

C'est essayé, c'est adopté, mais seulement pour lire des lisps quand je n'ai pas autocad ouvert. Sinon l'éditeur Vlisp me va.

Juste pour indiquer un post similaire : http://www.cadxp.com/sujetXForum-4426.htm

Je dois avoir ça sur mon poste, j'y ai autocad 2007 à 2011 (faudrait peut être que je fasse le ménage). Merki !

Merci BEAUCOUP pour ton aide. Compris ! Tu as trouvé le mot juste, "arborescence". En fait au début je pensais traiter ma liste directement "en arboresence", mais je me suis renu compte que ça aurait été très compliqué de remplir le tableau. ( ("SARRAT_CLOISONS_VERTICALES" ("cloison" (80.0 (2700.0 (67 208.04) (10 425.25) ) (2910.0 (8 26.78) ) (120.0 etc Je savais que ça n'était pas simple, et j'aurais pu peut-être utiliser des if imbriqués sur 3 niveaux (si épaisseur L =épaisseur L-1 ET si type L = type L-1 ET si calque L = calque L-1 alors fusion) Tu veux dire que le fichier acadauto.chm d'autocad 2011 contient l'aide du vba ?

(setq col -1) (repeat 3 (setq col (1+ col) row 2 next 3 ) (repeat (- (vla-get-Rows tbl) 3) (if (= (vlax-variant-value (vla-GetCellValue tbl row col)) (vlax-variant-value (vla-GetCellValue tbl next col)) ) (setq next (1+ next)) (progn (vla-MergeCells tbl row (1- next) col col) [b]; ici, je ne comprends pas pourquoi on fusionne quand la condition est fausse[/b] pourtant ça marche (setq row next next (1+ row) ) ) ) ) (vla-MergeCells tbl row (1- next) col col) ) [Edité le 29/11/2010 par LUDWIG]

Merci pour vos réponses. La liste : (("SARRAT_CLOISONS_VERTICALES" "cloison" 80.0 2700.0 67 208.04) ("SARRAT_CLOISONS_VERTICALES" "cloison" 120.0 2910.0 8 26.78) ("SARRAT_CLOISONS_VERTICALES" "doublage" 40.0 2700.0 61 189.41) ("SARRAT_CLOISONS_VERTICALES" "doublage" 60.0 2700.0 2 6.22) ("SARRAT_CLOISONS_VERTICALES" "doublage" 60.0 3770.0 20 86.72) ("SARRAT_CLOISONS_VERTICALES" "doublage" 80.0 2700.0 11 34.16) ("SARRAT_CLOISONS_PLAFONDS" "cloison" 80.0 2000.0 2.0 4.6) ("SARRAT_CLOISONS_PLAFONDS" "cloison" 80.0 3959.0 6 27.32) ("SARRAT_CLOISONS_PLAFONDS" "cloison" 120.0 2397.0 2 5.52)) Le tableau dwg non mis en forme : http://www.cijoint.fr/cjlink.php?file=cj201011/cij59PmjqD.zip (gile), merci pour le code, je vais l'étudier. Il ne me revoit pas exactement ce que je voudrais : la cellule avec la valeur "80" ne devrait pas fusionner avec la précédente, car les valeurs des 1ere et 2èmes colonnes ne sont pas égales ("sarrat_cloisons_plafond" et "sarrat_cloisons_verticales" et "doublage" et "cloison"). http://img225.imageshack.us/img225/889/sanstitrecu.png Question subsidiaire : ou trouve t'on une liste des fonctions accessibles via VLA-... ? Je me souviens l'avoir trouver dans l'aide vba quand le vba était encore fourni avec autocad.

Bonjour, J'ai un tableau que j'essayes de mettre en forme en faisant des fusions de cellules, mais je n'arrive pas au résultat escompté (certainement parque la référence x y d'une cellule fusionnée n'existe plus). Mon code (setq tbl (vlax-ename->vla-object (entlast))) (setq A 2) (while (not (= A (+ 2 (length listtab)))); "(+ 2 (length listtab))" est le nombre de ligne (setq B 0) (while (not (<= 6 B)) (If (= (vlax-variant-value (vla-getcellvalue tbl A B))(vlax-variant-value (vla-getcellvalue tbl (+ A 1) B))) (progn (vla-mergecells tbl A (+ A 1) B B);fusion cellule (setq B (+ 1 B)) );fin de progn (setq A (+ 1 A));condition not );fin de if );fin de while );fin de while Voici mon tableau de base : http://img813.imageshack.us/img813/4842/81896045.png Voici le résultat auquel je souhaiterais arrivé : http://img27.imageshack.us/img27/7732/11179306.png Voici le résultat auquel j'arrive : http://img823.imageshack.us/img823/5978/40308041.png Quelqu'un pourrait-il me guider ?

superblock ?

Merci ! J'essayes demain...

Bonjour, Je me suis inspiré de tabloblo de Tramber pour créer un lisp qui créer et rempli un tableau. Je souhaiterais maintenant fusionner des cellules quand elles sont égales et adjacentes (même colonne, ligne L et L+1). Savez-vous quelle serait la fonction vla a utiliser, et la syntaxe ? Merci d'avance

Si tu créais ton calque "gelé dans toutes les fenêtres" (et non pas geler dans les nouvelles fenêtres), ça te ferait peut être moins de boulot à réactiver ce calque dans 1 présentation par fichier (plutôt que le réactiver dans 3 présentations par fichiers).

Merci bien messieurs Et merci aussi pour shortcutmenu qui me permettra de forcer l'affichage du menu à l'écran

Merci (Gile).

Rebonjour, Nouvelle question : Comment peut-on avoir une invite de ce style quand on lance un lisp ? Le résultat du choix sera une valeur utilisée dans le lisp. http://img525.imageshack.us/img525/1284/sanstitrexn.png Merci d'avance [Edité le 19/11/2010 par LUDWIG]

Bonjour, Sauriez-vous me dire comment en lisp je peux récupérer l'objet sur lequel se fait un accrochage ? J'ai un simple lisp qui insère des blocs les uns à la suite des autres. Je souhaite pouvoir récupérer un paramètre dynamique du bloc sur lequel je m'accroche pour l'appliquer au bloc que j'insère. Merci d'avance [Edité le 19/11/2010 par LUDWIG]

Essayes ça Je ne l'ai pas utiliser depuis longtemps, ni retester ;********************************************************************************************************************************************************** ;REMPLACER DES BLOCS PAR UN AUTRE BLOC ;********************************************************************************************************************************************************** ;Remplace une définition de bloc par une autre à l'échelle 1 dans une zone donnée (defun c:rep2 () (setq OSMOLD (getvar "Osmode")) (command "-accrobj" "auc") (command "scu" "Général") (while (/= "INSERT" (cdr (assoc 0 (entget (setq nouveau (car (entsel "\nSélectionnez le bloc de remplacement... \n\n" ) ;_ Fin de entsel ) ;_ Fin de car ) ;_ Fin de setq ) ;_ Fin de entget ) ;_ Fin de assoc ) ;_ Fin de cdr ) ;_ Fin de /= ) ;_ Fin de while (setq nom_nouveau (cdr (assoc 2 (entget nouveau)))) (while (/= "INSERT" (cdr (assoc 0 (entget (setq ancien (car (entsel "\nSélectionnez une défintion de bloc à remplacer... \n\n" ) ;_ Fin de entsel ) ;_ Fin de car ) ;_ Fin de setq ) ;_ Fin de entget ) ;_ Fin de assoc ) ;_ Fin de cdr ) ;_ Fin de /= ) ;_ Fin de while (setq nom_ancien (cdr (assoc 2 (entget ancien)))) ;(setq nom_nouveau (cdr (assoc 2 (entget (car (entsel "\nSélectionnez le bloc de remplacement... \n\n")))))) ;(setq ancien (entget (car (entsel "\nSélectionnez une défintion de bloc à remplacer... \n\n")))) ;(setq nom_ancien (cdr (assoc 2 ancien))) (princ "Sélectionnez la zone de remplacement") (setq jeu (ssget (list (cons 2 nom_ancien)))) (setq n 0) (repeat (sslength jeu) (setq nom (ssname jeu n)) (setq prop (entget nom)) (setq X_nouveau (cdr (assoc 41 (entget nouveau)))) (setq Y_nouveau (cdr (assoc 42 (entget nouveau)))) (setq Z_nouveau (cdr (assoc 43 (entget nouveau)))) (setq X_ancien (cdr (assoc 41 (entget nom)))) (setq Y_ancien (cdr (assoc 42 (entget nom)))) (setq Z_ancien (cdr (assoc 43 (entget nom)))) (if (> 0 X_ancien) (setq X_nouveau (* -1 X_nouveau)) ) ;_ Fin de if (if (> 0 Y_ancien) (setq Y_nouveau (* -1 Y_nouveau)) ) ;_ Fin de if (if (> 0 Z_ancien) (setq Z_nouveau (* -1 Z_nouveau)) ) ;_ Fin de if (setq prop (subst (cons 2 nom_nouveau) (assoc 2 prop) prop)) (setq prop (subst (cons 41 X_nouveau) (assoc 41 prop) prop)) (setq prop (subst (cons 42 Y_nouveau) (assoc 42 prop) prop)) (setq prop (subst (cons 43 Z_nouveau) (assoc 43 prop) prop)) (entmod prop) (setq n (+ 1 n)) ) ;_ Fin de repeat ) ;_ Fin de defun