PHILPHIL

hello quelques routines, pour extraire sans ou avec destruction des entites dans l'XREF ou bloc, pour incorporer avec ou sans destruction d'entité dans l'Xref ou bloc les Xref ne doivent pas etre ouvert dans autocad pour extraire d'un Xref, le plus simple et de ne faire apparaitre que la couche a extraire. et pour la routine "c:extraire_entite_xref_bloc_copie_CALQUE" il suffit d'etre déja dans le calque ou l'on veut que la copie soit faite SANS DESTRUCTION DES ENTITES c:extraire_entite_xref_bloc_copie c:extraire_entite_xref_bloc_copie_CALQUE c:INCORPORER_entite_xref_bloc_copie AVEC DESTRUCTION DES ENTITES c:extraire_entite_xref_bloc_efface c:INCORPORER_entite_xref_bloc_efface a+ Phil ;;;------------------------------------------ ;;;EXTRAIRE DES ENTITEES D'UN BLOC OU XREF ;;;------------------------------------------ (defun c:extraire_entite_xref_bloc_copie () (setq osm (getvar "osmode")) (prompt "\nVEUILLEZ SELECTIONNER UN XREF OU BLOC POUR L'EXTRACTION D'ENTITES ") (command-s "-editref" pause "" "OK" "T" "N") (prompt "\nCLIQUER SUR LES OBJETS A EXTRAIRE :") (setq obj nil) (while (null obj) (setq obj (ssget))) (setvar "osmode" 0) (command-s "ALIGNER3D" obj "" "c" "0,0,0" "100000,0,0" "" "0,0,0" "100000,0,0" "q") (command-s "_refset" "S" obj "") (command-s "_refclose" "e" "d" "0,0,0" "0,0,0" ) (setvar "osmode" osm) ) (defun c:extraire_entite_xref_bloc_copie_CALQUE () (setq osm (getvar "osmode")) (setq cav (getvar "clayer")) (prompt "\nVEUILLEZ SELECTIONNER UN XREF OU BLOC POUR L'EXTRACTION D'ENTITES ") (command-s "-editref" pause "" "OK" "T" "N") (prompt "\nCLIQUER SUR LES OBJETS A EXTRAIRE :") (setq obj nil) (while (null obj) (setq obj (ssget))) (setvar "osmode" 0) (command-s "ALIGNER3D" obj "" "c" "0,0,0" "100000,0,0" "" "0,0,0" "100000,0,0" "q") (command "_laymch" obj "" "N" cav) (command-s "_refset" "S" obj "") (command-s "_refclose" "e" "d" "0,0,0" "0,0,0" ) (setvar "osmode" osm) ) (defun c:INCORPORER_entite_xref_bloc_copie () (setq osm (getvar "osmode")) (prompt "\nCLIQUER SUR LES OBJETS A INCORPORER :") (setq obj nil) (while (null obj) (setq obj (ssget))) (setvar "osmode" 0) (command-s "ALIGNER3D" obj "" "c" "0,0,0" "100000,0,0" "" "0,0,0" "100000,0,0" "q") (prompt "\nVEUILLEZ SELECTIONNER UN XREF OU BLOC POUR L'INCORPORATION D'ENTITES ") (command-s "-editref" pause "" "OK" "T" "N") (command-s "_refset" "A" obj "") (command-s "_refclose" "e" "d" "0,0,0" "0,0,0" ) (setvar "osmode" osm) ) (defun c:extraire_entite_xref_bloc_efface () (setq osm (getvar "osmode")) (prompt "\nVEUILLEZ SELECTIONNER UN XREF OU BLOC POUR L'EXTRACTION D'ENTITES ") (command-s "-editref" pause "" "OK" "T" "N") (prompt "\nCLIQUER SUR LES OBJETS A EXTRAIRE :") (setq obj nil) (while (null obj) (setq obj (ssget))) (setvar "osmode" 0) (command-s "_refset" "S" obj "") (command-s "_refclose" "e" "d" "0,0,0" "0,0,0" ) (setvar "osmode" osm) ) (defun c:INCORPORER_entite_xref_bloc_efface () (setq osm (getvar "osmode")) (prompt "\nCLIQUER SUR LES OBJETS A INCORPORER :") (setq obj nil) (while (null obj) (setq obj (ssget))) (setvar "osmode" 0) (prompt "\nVEUILLEZ SELECTIONNER UN XREF OU BLOC POUR L'INCORPORATION D'ENTITES ") (command-s "-editref" pause "" "OK" "T" "N") (command-s "_refset" "A" obj "") (command-s "_refclose" "e" "d" "0,0,0" "0,0,0" ) (setvar "osmode" osm) )

hello La Lozere une piste peut etre, ca "bave" parce qu'il y a des lignes superposées "pile poil". quand c'est une seule ligne, c'est plus nette, j'ai l'impression, ou la ligne semble moins épaisse après sélection. un moyen de vérifier les superpositions d’entités a+ Phil

bonjour OUPPSSS je viens de comprendre comment ca marche. pour sauvegarder l'etat de calque il faut sélectionner la fenêtre dans la présentation et non pas par rapport a la liste dans la fenêtre GEF. puis sélectionner la liste des fenetres que l'on veut modifier dans la liste de gauche GEF pour la restauration j'ai testé sur GEF 3.22 le fait de sauvegarder l'etat de calque d'une fenetre, puis de restaurer cet etat pour d'autres fenetres, mais ca ne semble pas fonctionner. avez vous utilisé ces fonctions de GEF et si oui, est ce que ca fonctionne chez vous ? en ouvrant le fichier de sauvegarde généré on a bien la liste de tous les calques, mais rien dans la liste indiquant que le calque est gelé ou dégélé Merci Phil

bonjour un petit lisp pour donner un angle aux hachures en fonction de deux points. suffit de répondre "N" ( majuscule ) pour choisir un autre angle incrémenter tous les 45 degres. ca marche que le fichier soit en degrés, radiant, ou autre a tester a+ Phil (defun c:hachure_rotation (/ a0 a1 cals surfent surfent ent js) (setvar "cmdecho" 0) (setvar "dimzin" 0) (command-s "scu" "") (prompt "\nAGIT SUR L'ANGLE DE ROTATION DES HACHURES :") (setq poi1 nil) (while (null poi1) (setq poi1 (getpoint "\nPOINT DE BASE N° 1"))) (setq poi2 nil) (while (null poi2) (setq poi2 (getpoint "\nPOINT DE BASE N° 2"))) (prompt "\nCLIQUER SUR LE(S) HACHURE(S) A REMPLACER :") (setq bl nil) (while (null bl) (setq bl (ssget (list (cons 0 "HATCH"))))) (setq rempbl (angle poi1 poi2)) (setq ent nil) (setq compt 0) (setq com (sslength bl)) (command-s "ANNULER" "M") (while (< compt com) (progn (setq ent (entget (ssname bl compt))) (vla-put-patternangle (vlax-ename->vla-object (cdr (car (entget (ssname bl compt))))) rempbl) (setq compt (1+ compt)) ) ) (initget "O N") (setq repon (getkword "\nEST CE LE BON ANGLE ? (O/N):")) (if (= repon "N") (progn (command-s "ANNULER" "R") (setq compt 0) (command-s "ANNULER" "M") (setq rempbl (+ (angle poi1 poi2) (/ pi 4))) (while (< compt com) (progn (setq ent (entget (ssname bl compt))) (vla-put-patternangle (vlax-ename->vla-object (cdr (car (entget (ssname bl compt))))) rempbl) (setq compt (1+ compt)) ) ) (initget "O N") (setq repon (getkword "\nEST CE LE BON ANGLE ? (O/N):")) (if (= repon "N") (progn (command-s "ANNULER" "R") (setq compt 0) (command-s "ANNULER" "M") (setq rempbl (+ (angle poi1 poi2) (/ pi 2))) (while (< compt com) (progn (setq ent (entget (ssname bl compt))) (vla-put-patternangle (vlax-ename->vla-object (cdr (car (entget (ssname bl compt))))) rempbl) (setq compt (1+ compt)) ) ) (initget "O N") (setq repon (getkword "\nEST CE LE BON ANGLE ? (O/N):")) (if (= repon "N") (progn (command-s "ANNULER" "R") (setq compt 0) (command-s "ANNULER" "M") (setq rempbl (+ (angle poi1 poi2) (+ (/ pi 2) (/ pi 4)))) (while (< compt com) (progn (setq ent (entget (ssname bl compt))) (vla-put-patternangle (vlax-ename->vla-object (cdr (car (entget (ssname bl compt))))) rempbl) (setq compt (1+ compt)) ) ) (initget "O N") (setq repon (getkword "\nEST CE LE BON ANGLE ? (O/N):")) (if (= repon "N") (progn (command-s "ANNULER" "R") (setq compt 0) (command-s "ANNULER" "M") (setq rempbl (+ (angle poi1 poi2) pi)) (while (< compt com) (progn (setq ent (entget (ssname bl compt))) (vla-put-patternangle (vlax-ename->vla-object (cdr (car (entget (ssname bl compt))))) rempbl) (setq compt (1+ compt)) ) ) (initget "O N") (setq repon (getkword "\nEST CE LE BON ANGLE ? (O/N):")) (if (= repon "N") (progn (command-s "ANNULER" "R") (setq compt 0) (command-s "ANNULER" "M") (setq rempbl (+ (angle poi1 poi2) (+ pi (/ pi 4)))) (while (< compt com) (progn (setq ent (entget (ssname bl compt))) (vla-put-patternangle (vlax-ename->vla-object (cdr (car (entget (ssname bl compt))))) rempbl) (setq compt (1+ compt)) ) ) (initget "O N") (setq repon (getkword "\nEST CE LE BON ANGLE ? (O/N):")) (if (= repon "N") (progn (command-s "ANNULER" "R") (setq compt 0) (command-s "ANNULER" "M") (setq rempbl (+ (angle poi1 poi2) (+ pi (/ pi 2)))) (while (< compt com) (progn (setq ent (entget (ssname bl compt))) (vla-put-patternangle (vlax-ename->vla-object (cdr (car (entget (ssname bl compt))))) rempbl ) (setq compt (1+ compt)) ) ) (initget "O N") (setq repon (getkword "\nEST CE LE BON ANGLE ? (O/N):")) (if (= repon "N") (progn (command-s "ANNULER" "R") (setq compt 0) (command-s "ANNULER" "M") (setq rempbl (+ (angle poi1 poi2) (+ pi (/ pi 2) (/ pi 4)))) (while (< compt com) (progn (setq ent (entget (ssname bl compt))) (vla-put-patternangle (vlax-ename->vla-object (cdr (car (entget (ssname bl compt))))) rempbl ) (setq compt (1+ compt)) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) (setvar "dimzin" 8) (command-s "scu" "p") (princ) (princ) )

hello une autre solution sans contraintes déplacement de points et action en chaine par contre ca marche car le verrin est une ligne, ca serait un verrin plus détaillé, la je ne suis pas sur a+ Phil TEST BRAS.dwg

hello CRL je n'utilise jamais les contraintes des entites ( j'ai relu ton message apres avoir trouvé cette solution désolé ) quel est le but suivant ? désinner les verrins ? j'ai d'abord transformé les premières entités en bloc pour etre sur que le cercle de base ne bouge pas puis refait la première contrainte de rotation des bras. puis contraint les extrémités des polylignes rouges sur les centres des cercles et ca a l'air de fonctionner a+ Phil

hello le point de base 0,0,0 de l XREF est a combien de kilomètres des entités de dessins ? car un zoom étendu dans le fichier ou est inséré l XREF et on ne voit plus rien qu'un pixel a l'écran. pas facile a voir a+ Phil

hello il te faut télécharger aussi le fichier *.dcl qui est la boite de dialogue en relation avec le programme *.lsp l'un ne fonctionne pas sans l'autre a télécharger dans le meme sous répertoire, a+ Phil

hello tu l'as en partie dans le *.zip que tu as mis mais voici une autre version ou la meme de Gile commande : ju2 a+ Phil JUSTIFY.lsp JUSTIFY.dcl

hello regarde ici, tu auras ce qu'il te faut je pense a+ Phil

hello j'ai finalement écrit un bout de lisp pas tres propre mais ca marche, si ca intéresse ca trie les noms de présentations en fonction de la plage en rouge puis la plage en bleu attention il ne faut pas d'autres noms de présentations plus court que ceux que vous voulez trier on choisit le debut et la longueur de plage rouge en fonction de : A4H totozero-2-A-I-4-k-9 1-20 PL020- (defun c:cnptrier4axet4a2fin (/ acdoc layouts layout layoutsname name) (setq cnpcdepuisdebut1 (atoi (getcfg "APPDATA/CNPCDEPUISDEBUT1"))) (initget 4) (setq tmp (getint (strcat "\nENTRER UN NOMBRE POUR DEFINIR LE DEPART DE LA PLAGE DE TRIE DEPUIS LE DEBUT DU NOM [ MINIMUM : 1]<" (rtos cnpcdepuisdebut1 2 0) ">: " ) ) ) (if tmp (setq cnpcdepuisdebut1 tmp) ) (setcfg "APPDATA/CNPCDEPUISDEBUT1" (rtos cnpcdepuisdebut1 2 0)) (setq cnpcsurx1 (atoi (getcfg "APPDATA/CNPCSURX1"))) (initget 4) (setq tmp (getint (strcat "\nENTRER UN NOMBRE POUR DEFINIR LA PLAGE DE TRIE PRIMAIRE DU NOM <" (rtos cnpcsurx1 2 0) ">: " ) ) ) (if tmp (setq cnpcsurx1 tmp) ) (setcfg "APPDATA/CNPCSURX1" (rtos cnpcsurx1 2 0)) (setq acdoc (vla-get-activedocument (vlax-get-acad-object))) (setq layouts (vla-get-layouts acdoc)) ;; récupérer la liste des noms de présentations (vlax-for layout layouts (setq layoutsname (cons (vla-get-name layout) layoutsname))) ;; supprimer la présentation "Model" de cette liste (setq layoutsname (vl-remove "Model" layoutsname)) ;; nombre de presentations (setq nblayouts (length layoutsname) listelayoutsdecomp nil listelayoutrecomp nil ) ;;décomposer le nom de la présentation en 5 morceaux et en faire une liste (foreach name layoutsname (setq nbc (strlen name)) (setq listelayoutsdecomp (cons (list (substr name 1 (- cnpcdepuisdebut1 1)) (substr name cnpcdepuisdebut1 cnpcsurx1) (substr name (+ cnpcdepuisdebut1 cnpcsurx1) (- nbc 3 (+ cnpcdepuisdebut1 cnpcsurx1))) (substr name (- nbc 3) 3) (substr name nbc) ) listelayoutsdecomp ) ) ) ;; trier la liste sur 2 et 4 morceaux (setq listelayoutsdecomp1 (vl-sort listelayoutsdecomp '(lambda (a b) (if (eq (cadr a) (cadr b)) (< (cadddr a) (cadddr b)) (< (cadr a) (cadr b)) ) ) ) ) ;;reconstituer le noms des présentations et la lister (foreach decomp listelayoutsdecomp1 (setq listelayoutrecomp (cons (strcat (nth 0 decomp) (nth 1 decomp) (nth 2 decomp) (nth 3 decomp) (nth 4 decomp)) listelayoutrecomp ) ) ) ;inverser la liste (setq listelayoutrecomp (reverse listelayoutrecomp)) ;; attribuer l'ordre à chaque présentation (setq i 1) ;; l'ordre 0 est réservé à la présentation "Model" (foreach name listelayoutrecomp (setq layout (vla-item layouts name)) (vla-put-taborder layout i) (princ (strcat "\n" (itoa i) " SUR " (itoa nblayouts) " : " name)) (setq i (1+ i)) ) (getlayouts "POUR VERIFICATION DES NOMS DE PRESENTATION" t) (princ) ) a+ Phil

Bonjour j'ai une liste de présentation ( 150) que je voudrais trier en premier sur les (caractères 5 à 13) ( variable ) ( en rouge ) puis sur les derniers caractères en bleu est ce que ta fonction permet de faire ca ??? sachant que je peux transformé le totozero-2-A en totozero-02-A pour avoir le meme nombre de caractere a prendre en compte avant tri : list =A4H totozero-13-A-I-4-k-9 1-10 PL009-,A4V totozero-13-A-I-4-k-9 1-10 PL019-,A4H totozero-7-A-I-4-k-9 1-10 PL009-,A4V totozero-7-A-I-4-k-9 1-10 PL010-,A4V totozero-2-B-I-4-k-9 1-7 PL007-,A4H totozero-2-A-I-4-k-9 1-20 PL020- apres tri : list =A4H totozero-2-A-I-4-k-9 1-20 PL020-,A4V totozero-2-B-I-4-k-9 1-7 PL007-,A4H totozero-7-A-I-4-k-9 1-9 PL009-,A4V totozero-7-A-I-4-k-9 1-10 PL010-, A4H totozero-13-A-I-4-k-9 1-9 PL009-,A4V totozero-13-A-I-4-k-9 1-19 PL019- merci Phil

hello Gile comme d'habitude GRAND MERCI ca marche NICKEL par contre ca dépasse mes compétences en lisp la, autant des fois j'arrive a modifier tes bouts de codes, autant la je ne comprend plus rien lolll merci Phil

bonjour j'ai des milliers de blocs tous pareil composé de deux lignes et deux arcs (issu de revit ) je veux les décomposer et joindre ensuite les deux lignes et deux arcs pour en faire une polylignes quand je lance seul la commande "JOINDRE" en sélectionnant les deux lignes et deux arcs, ca créer une polyligne quand j'insère la meme commande "joindre" dans le lisp ca ne marche plus et ne veux plus des arc de cercle. normal ?? ou est le soucis ? merci Phil ;;;------------------------------ ;;;DECOMPOSE BLOC POUR EN FAIRE polyligne ;;;------------------------------ (defun c:blocs_to_joindre (/ s i e) (setvar "cmdecho" 0) (and (setq s (ssget '((0 . "INSERT")))) (setq i -1 com (sslength s) ) (while (setq e (ssname s (setq i (1+ i)))) (command "_explode" e "" ) (setq obj (ssget "P" )) (command-s "JOINDRE" obj "") (acet-ui-progress-init (strcat "AVANCEMENT " (rtos (/ (* i 100) (float com)) 2 2) " %") com) (acet-ui-progress-safe i) ) ) (acet-ui-progress-done) (princ) )

HELLO commande : CEP4 une mise a jour de "CEP" de FRED a tester et a modifier suivant vos critères avec un bloc servant de référence fenêtre orienté dans n'importe quel SCU a tester avec le fichier *.dwg "ACAD 2013 -TEXT CADRE IMAGE" les attributs servent a nommer la présentation, J'utilise cette méthode mais une autre méthode est possible la concaténation des attributs doit etre unique, sinon le lisp se bloque, ne pouvant pas créer deux présentations de même noms le point de référence du bloc permetant de créer la fenêtre est au centre on ajuste la LARGEUR et la HAUTEUR du bloc en fonction de la fenêtre voulue et correspondant a un multiple des largeur hauteur des fenêtres de présentations en multipliant LARGEUR et HAUTEUR on change l'échelle je bosse en centimètre et mes présentations sont en millimètres ca peut avoir son importance si vous travaillez dans d'autres unités, il vous faudra adapter des paramètres dans le lisp le bloc "CADRE IMAGE" doit etre implanter dans "T_FENETRE IMAGE" ( sinon adapter le lisp ) sélectionner les type cadres de meme orientations ( HORIZONTAUX ou VERTICAUX ) sans distinction de format a la volée et le lisp fera la mise en page il suffira ensuite d'utiliser "CPP_FIXE" pour copier les entités de cartouches entre présentations pour UNE fenêtre par présentation paramètres a modifier dans le LISP suivant le type de fenêtre de présentation : voir onglet "A4V 1-X PL001-" et "A4H 1-X PL001-" l'origine de mon "SCU" dans mes présentations est en bas a droite pointcentre1 (list -105.0 160.5 0.0) : point central de la fenêtre dans la présentation rot ac0degrees : un angle suivant si la fenêtre est verticale ou horizontale dans la présentation "ac90degrees" = HORIZONTALE largeur 204.0 : LARGEUR de la fenêtre dans votre présentation d'arrivée hauteur 267.0 : HAUTEUR de la fenêtre dans votre présentation d'arrivée a+ Phil (defun c:cep4 (/ acdoc b c fen i lays n-p nom-p ;;; ONG-BASE ;;; ONG_DEST sel ;;; xmin ymax a-p haut larg p1 p2 nom ech lay lock ;unit ) (vl-load-com) ; 4 Millimètres 5 Centimètres 6 Mètres ;;; (setq typecadre (atof (getcfg "APPDATA/TYPECADRE"))) ;;;(setq unit (cdr ;;; (assoc (getvar "INSUNITS") '((4 . 1) (5 . 10) (6 . 1000))) ;;; ) ;;; ) (setq separa1 (getcfg "APPDATA/SEPARA1")) (setq tmp (getstring t (strcat "\nENTRER LE SEPARATEUR ENTRE ATTRIBUT A INTEGRER <" separa1 "> : "))) (if (/= tmp "") (setq separa1 tmp) ) (setcfg "APPDATA/SEPARA1" separa1) (while (not sel) (setq sel (car (entsel "\nCHOIX DU CADRE SOURCE (Bloc) :"))) (if sel (if (not (equal (vla-get-objectname (setq b (vlax-ename->vla-object sel))) "AcDbBlockReference")) (setq sel nil) ) ) ) (if (= (tblsearch "layer" "T_FENETRE") nil) (command-s "-calque" "n" "T_FENETRE" "co" "7" "T_FENETRE" "") ) (setq cav (getvar "clayer")) (command-s "-calque" "ac" "T_FENETRE" "ch" "T_FENETRE" "") (setq rege (getvar "REGENMODE")) (setvar "REGENMODE" 1) (setvar "cmdecho" 0) (prompt "\nSELECTIONNER LES BLOCS CADRES POUR LA CREATION DES PRESENTATIONS :") (setq sel (ssget (list '(0 . "INSERT") (cons 8 "T_FENETRE IMAGE"))) acdoc (vla-get-activedocument (vlax-get-acad-object)) lays (layoutlist) ) (setq compteur 0) (setq compteurmax (sslength sel)) (prompt "\n 1 : A4V 1-X PL001-") (prompt "\n 2 : A4H 1-X PL001-") (initget "1 2 3 4 5 6") (setq typecadre (getcfg "APPDATA/TYPECADRE")) (setq tmp (getstring t (strcat "\nSELECTIONNER LE TYPE DE CADRE A RECRER (1 2 3 4 5) < " typecadre " >: "))) (if (/= tmp "") (setq typecadre tmp) ) (if (= typecadre "1") (setq ong-base "A4V 1-X PL001-") ) (if (= typecadre "2") (setq ong-base "A4H 1-X PL001-") ) (setcfg "APPDATA/TYPECADRE" typecadre) (setq a-p (vla-item (vla-get-layouts acdoc) ong-base)) (vla-getcustomscale a-p 'n 'm) (vla-put-activelayout acdoc a-p) (vlax-for e (vla-get-paperspace acdoc) (if (equal (vla-get-objectname e) "AcDbViewport") (setq lay (vla-get-layer e) lock (vla-get-displaylocked e) ) ) ) (setq i 0) (repeat (sslength sel) (if (vlax-property-available-p (vlax-ename->vla-object (ssname sel i)) 'effectivename) (setq nom vla-get-effectivename) (setq nom vla-get-name) ) (if (equal (nom (setq c (vlax-ename->vla-object (ssname sel i)))) (nom b)) (progn (setq baserotation (vlax-get-property (vlax-ename->vla-object (ssname sel i)) 'rotation) poitinsert (vlax-safearray->list (vlax-variant-value (vlax-get-property (vlax-ename->vla-object (ssname sel i)) 'insertionpoint)) ) largcadre (getpropertyvalue (cdr (assoc -1 (entget (ssname sel i)))) "AcDbDynBlockPropertyLARGEUR CADRE") hautcadre (getpropertyvalue (cdr (assoc -1 (entget (ssname sel i)))) "AcDbDynBlockPropertyHAUTEUR CADRE") x1 (car poitinsert) y1 (cadr poitinsert) bgx (- (car poitinsert) (/ largcadre 2)) bgy (- (cadr poitinsert) (/ hautcadre 2)) hdx (+ (car poitinsert) (/ largcadre 2)) hdy (+ (cadr poitinsert) (/ hautcadre 2)) lstima (getatt c) nblstima (length lstima) ima1 (cdr (nth 0 lstima)) ima2 (cdr (nth 1 lstima)) ima3 (cdr (nth 2 lstima)) ima4 (cdr (nth 3 lstima)) ima5 (cdr (nth 4 lstima)) ima6 (cdr (nth 5 lstima)) ima7 (cdr (nth 6 lstima)) ima8 (cdr (nth 7 lstima)) ) (setq ong_dest (strcat ima1)) (if (/= ima2 "") (setq ong_dest (strcat ong_dest separa1 ima2)) ) (if (/= ima3 "") (setq ong_dest (strcat ong_dest separa1 ima3)) ) (if (/= ima4 "") (setq ong_dest (strcat ong_dest separa1 ima4)) ) (if (/= ima5 "") (setq ong_dest (strcat ong_dest separa1 ima5)) ) (if (/= ima6 "") (setq ong_dest (strcat ong_dest separa1 ima6)) ) (if (/= ima7 "") (setq ong_dest (strcat ong_dest separa1 ima7)) ) (if (/= ima8 "") (setq ong_dest (strcat ong_dest separa1 ima8)) ) (if (= (strlen ima7) 1) (setq nombre (strcat "00" ima7)) ) (if (= (strlen ima7) 2) (setq nombre (strcat "0" ima7)) ) (if (= (strlen ima7) 3) (setq nombre ima7) ) (if (= typecadre "1") (setq ong_dest (strcat "A4V " ong_dest " 1-X PL" nombre "-");; un nom de presentation different pointcentre1 (list -105.0 160.5 0.0) rot ac0degrees largeur 204.0 hauteur 267.0 ) ) (if (= typecadre "2") (setq ong_dest (strcat "A4H " ong_dest " 1-X PL" nombre "-");; un nom de presentation different pointcentre1 (list -148.5 117.0 0.0) rot ac90degrees largeur 291.0 hauteur 180.0 ) ) (setq n-p (vla-add (vla-get-layouts acdoc) ong_dest)) (setq ech (vla-get-yscalefactor c)) (vla-copyfrom n-p a-p) (vla-put-activelayout acdoc n-p) (setq fen (vla-addpviewport (vla-get-paperspace acdoc) (vlax-3d-point pointcentre1) largeur hauteur ) ) (vla-put-layer fen lay) (vla-zoomextents (vlax-get-acad-object)) (vla-display fen :vlax-true) (vla-put-mspace acdoc :vlax-true) (vla-put-activepviewport acdoc fen) (vla-zoomwindow (vlax-get-acad-object) (vlax-3d-point bgx bgy 0.0) (vlax-3d-point hdx hdy 0.0)) (vla-put-mspace acdoc :vlax-false) (vla-put-plotrotation (vla-get-activelayout acdoc) rot) (command-s "espaceo") (setq ucs1 (getvar "ucsfollow")) (setvar "osmode" 0) (setvar "orthomode" 0) (setvar "ucsfollow" 0) (setq p2 (polar poitinsert baserotation 1000)) (command-s "_DVIEW" "" "_TW" (- 360 (* (angle poitinsert p2) (/ 180 pi))) "") (setvar "ucsfollow" ucs1) (command-s "espacep") (vla-put-displaylocked fen lock) (setq i (1+ i)) (setq compteur (1+ compteur)) (command-s "zoom" "et") (prompt (strcat "\nLE PROGRAMME A TRAITE : " (rtos compteur 2 0) " OPERATION(S) SUR : " (rtos compteurmax 2 0) ) ) (princ) ) ) ) (setvar "TILEMODE" 1) (setvar "REGENMODE" rege) (setvar "cmdecho" 1) (setvar "clayer" cav) (prompt "\n") (princ) ) (defun c:cpp_FIXE (/ acdoc layouts selectedlayouts *error* lay ss sa) ; Bryce, janvier 2012 ; Copie les objets sélectionnés dans les présentations choisies. (vl-load-com) (setq layouts (vla-get-layouts (setq acdoc (vla-get-activedocument (vlax-get-acad-object))))) (defun *error* (msg) (and msg (or (member (strcase msg) '("FUNCTION CANCELLED" "QUIT / EXIT ABORT" "FONCTION ANNULEE" "QUITTER / SORTIR ABANDON") ) (princ (strcat "\nErreur : " msg)) ) ) (if ss (setq ss nil) ) (vla-endundomark acdoc) (princ) ) (vla-startundomark acdoc) (or (and (/= (getvar 'ctab) "Model") (= (getvar 'cvport) 1)) (progn (princ "\n** Commande non autorisée dans l'espace Objet**") (quit)) ) (if (and (or (setq ss (cadr (ssgetfirst))) (setq ss (ssget))) (setq sa (bs:ss2safearray ss))) (progn (setq selectedlayouts (bs:getotherlayouts nil t)) (foreach lay selectedlayouts (vla-copyobjects acdoc sa (vla-get-block (vla-item layouts lay)))) ; foreach (princ "\nCopie effectuée !") ) ) ;if ssget (*error* nil) ) ;;--------------------------------------------------------------------------------------------------------------------------------------------------------------- ;;--------------------------------------------------------------------------------------------------------------------------------------------------------------- ;; BS:GETOTHERLAYOUTS Bryce 19/01/2012 ;; basé sur GETLAYOUTS (gile) 03/12/07 ;; ;; Retourne la liste des présentations choisies dans la boite de dialogue ;; La présentation active n'est pas proposée. ;; ;; arguments ;; titre : titre de la boite de dialogue ou nil, défauts = Choisir la (ou les) présentation(s) ;; mult : T ou nil (pour choix multiple ou unique) (defun bs:getotherlayouts (titre mult / lay tmp file ret) (setq lay (vl-sort (vl-remove (getvar 'ctab) (layoutlist)) (function (lambda (x1 x2) (< (taborder x1) (taborder x2)))) ) tmp (vl-filename-mktemp "tmp.dcl") file (open tmp "w") ) (write-line (strcat "GetLayouts:dialog{label=" (if titre (vl-prin1-to-string titre) (if mult "\"Choisir les présentations\"" "\"Choisir une présentation\"" ) ) ";:list_box{height = 80;key=\"lst\";multiple_select=" (if mult "true;width = 80;}:row{:retirement_button{label=\"Toutes\";key=\"all\";} ok_button;cancel_button;}}" "false;}ok_cancel;}" ) ) file ) (close file) (setq dcl_id (load_dialog tmp)) (if (not (new_dialog "GetLayouts" dcl_id)) (exit) ) (start_list "lst") (mapcar 'add_list lay) (end_list) (action_tile "all" "(setq ret (reverse lay)) (done_dialog)") (action_tile "accept" "(or (= (get_tile \"lst\") \"\") (foreach n (str2lst (get_tile \"lst\") \" \") (setq ret (cons (nth (atoi n) lay) ret)))) (done_dialog)" ) (start_dialog) (unload_dialog dcl_id) (vl-file-delete tmp) (reverse ret) ) (defun taborder (name / dict lay) ; (gile) (setq dict (dictsearch (namedobjdict) "ACAD_LAYOUT")) (if (setq lay (cdr (assoc 350 (member (cons 3 name) dict)))) (cdr (assoc 71 (entget lay))) ) ) (defun str2lst (str sep / pos) ; (gile) (if (setq pos (vl-string-search sep str)) (cons (substr str 1 pos) (str2lst (substr str (+ (strlen sep) pos 1)) sep)) (list str) ) ) (defun bs:ss2safearray (sset / i entlst) ; Bryce (setq i 0) (repeat (sslength sset) (setq entlst (cons (vlax-ename->vla-object (ssname sset i)) entlst)) (setq i (1+ i)) ) (vlax-safearray-fill (vlax-make-safearray vlax-vbobject (cons 0 (1- (length entlst)))) entlst) ) ;; GETATT ;; Retourne une liste d'association des attribut du bloc ;; ;; Argument ;; bl : la référence de bloc (ename ou vla-object) ;; ;; Retour ;; une liste d'association du type : ((etiquette . valeur) ...) (defun getatt (bl) (vl-load-com) (or (= (type bl) 'vla-object) (setq bl (vlax-ename->vla-object bl))) (if (and (= (vla-get-objectname bl) "AcDbBlockReference") (= (vla-get-hasattributes bl) :vlax-true)) (mapcar (function (lambda (x) (cons (vla-get-tagstring x) (vla-get-textstring x)))) (vlax-invoke bl 'getattributes) ) ) ACAD 2013 -TEXT CADRE IMAGE.dwg

hello autant pour moi je vais mettre mon post ailleurs sinon lee-mac en a ecrit trois aussi. a+ Phil VPOutlineV1-3.lsp

HELLO commande : CEP4 déplacer ici

hello Gile oui en cherchant je viens de tomber sur ton lisp mercii Phil

bonjour merci j'utilise tabsort de LEE mac, oui Luna comment sélectionnes tu les présentations pour ton bout de lisp set-layout-pos phil

bonjour je voulais utiliser comme base un lisp de Gile effacant les hachure dans les blocs et le modifier pour mettre les hachures en arriere plan et les cotes en avant plan comment pouvoir faire des modifs a l'interieur du bloc sans les ouvrir ? merci Phil

Bonjour j'essaie de trier des noms de présentation en fonction des 4 à 2 caracteres en partant de la fin du nom exemple de nom de présentation : "******-a-11 1-X PL011-" = "011" le programme a fonctionné une fois puis apres plus rien j'ai ca comme erreur : Erreur Automation Valeur de la propriété TabOrder non valable il semble que le numero de la fenetre ne se mette pas a jour dans la base tant que l'on a pas fermé le fichier, et meme la les numeros n'ont pas l'air de forcement se suivrent genre "0" pour model ca ok mais ensuite des nombre entiers qui ne se suivent pas forcement tant qu'il n'y en a pas deux pareils, VRAI ou FAUX ? comment vérifier ca ? (defun c:verifier_order_layout ( / acdoc leslayouts layoutsname ) (setq acdoc (vla-get-activedocument (vlax-get-acad-object))) (setq leslayouts (vla-get-layouts acdoc)) (vlax-for layout leslayouts (setq layoutsname (cons (vla-get-name layout) layoutsname))) (setq nblayouts (length layoutsname)) (setq i 1) (foreach name layoutsname (setq layout (vla-item leslayouts name)) (setq nb1 (vla-get-taborder layout)) (princ (strcat "\n" (itoa i) " SUR " (itoa nblayouts) " : " name " " (rtos nb1 2 0))) (princ) (setq i (1+ i)) )(princ) ) et sinon comment renuméroter chaque fenetre dans ce cas la en etant sur que les numero se suivent ? (defun c:cnptrier4a2fin ( / acdoc leslayouts ;;; layouts i layout ) (setq acdoc (vla-get-activedocument (vlax-get-acad-object))) (setq leslayouts (vla-get-layouts acdoc)) (setq layouts (getlayouts nil t) layoutsold layouts ) (setq layouts (vl-sort layouts '(lambda (a b) (< (atoi (substr a (- (strlen a) 3) 3)) (atoi (substr b (- (strlen b) 3) 3)))) ) ) (setq i (vla-get-taborder (vla-item leslayouts (nth 0 layouts)))) (foreach name layouts (setq layout (vla-item leslayouts name)) (vla-put-taborder layout i) (setq i (1+ i)) ) (getlayouts "POUR VERIFICATION DES NOMS DE PRESENTATION" t) ) merci Phil

hello ca fonctionne sous autocad architecture 2021 ca NE fonctionnement PAS sous autocad architecture 2022 donc il doit y avoir un BUG sous la 2022 merci Phil PBO

hello je viens de tester les lisp et ca ne semble pas fonctionner sur le fichier envoyé pourtant ca parait logique faut peut etre aller attaquer le "width" directement sans passer par le code 41 dxf ? a+ Phil

hello merci pour vos réponses, je regarde ca merci pour les lisp une version lisp est plus rapide, et pas besoin de se poser de questions, surtout que ce genre de chose peut revenir j'ai mis un exemple des milliers de cotes qu'il peut y avoir. et un "dump" Commande: IN SELECTIONNER UNE ENTITE POUR INFO NENTSEL.; IAcadMText: Interface AutoCAD Mtext (texte multiple) ; Valeurs de propriétés: ; Application (RO) = #<VLA-OBJECT IAcadApplication 00007ff7f6354e50> ; AttachmentPoint = 5 ; BackgroundFill = 0 ; Document (RO) = #<VLA-OBJECT IAcadDocument 000001e9aef27d88> ; DrawingDirection = 1 ; EntityTransparency = "DuBloc" ; Handle (RO) = "9848" ; HasExtensionDictionary (RO) = 0 ; Height = 0.0875 ; Hyperlinks (RO) = #<VLA-OBJECT IAcadHyperlinks 000001ea08b0e118> ; InsertionPoint = (26.3697 7.42976 0.0) ; Layer = "6_00 - Cotations__" ; LineSpacingDistance = 0.145833 ; LineSpacingFactor = 1.0 ; LineSpacingStyle = 1 ; Linetype = "ByLayer" ; LinetypeScale = 1.0 ; Lineweight = -1 ; Material = "ByLayer" ; Normal = (0.0 0.0 1.0) ; ObjectID (RO) = 74 ; ObjectName (RO) = "AcDbMText" ; OwnerID (RO) = 75 ; PlotStyleName = "ByBlock" ; Rotation = 0.0 ; StyleName = "Century Gothic_3" ; TextString = "\\A1;239" ; TrueColor = #<VLA-OBJECT IAcadAcCmColor 000001ea08b0e710> ; Visible = -1 ; Width = 245380.0 LE CALQUE DE L ENTITE EST : 6_00 - Cotations__ Fraid, merci mais je ne veux pas etre aussi destructeur en changeant le style de l'archi ca m'a permis de découvrir un truc un "\x" au lieux d'un "\p" dans le texte de cote ne donne pas la meme chose, intéressant pour moi qui met le texte de cote au dessus et non pas au centre, pour la cotation des baies Commande: IE SELECTIONNER UNE ENTITE POUR INFO ENTSEL.; IAcadDimRotated: Interface AutoCAD Rotated Dimension ; Valeurs de propriétés: ; AltRoundDistance = 0.0 ; AltSubUnitsFactor = 100.0 ; AltSubUnitsSuffix = "" ; AltSuppressLeadingZeros = 0 ; AltSuppressTrailingZeros = 0 ; AltSuppressZeroFeet = -1 ; AltSuppressZeroInches = -1 ; AltTextPrefix = "" ; AltTextSuffix = "" ; AltTolerancePrecision = 2 ; AltToleranceSuppressLeadingZeros = 0 ; AltToleranceSuppressTrailingZeros = 0 ; AltToleranceSuppressZeroFeet = -1 ; AltToleranceSuppressZeroInches = -1 ; AltUnits = 0 ; AltUnitsFormat = 2 ; AltUnitsPrecision = 2 ; AltUnitsScale = 25.4 ; Application (RO) = #<VLA-OBJECT IAcadApplication 00007ff7f6354e50> ; Arrowhead1Block = "Oblique" ; Arrowhead1Type = 5 ; Arrowhead2Block = "Oblique" ; Arrowhead2Type = 5 ; ArrowheadSize = 0.164042 ; DecimalSeparator = "." ; DimConstrDesc = Une exception s’est produite ; DimConstrExpression = Une exception s’est produite ; DimConstrForm = 0 ; DimConstrName = Une exception s’est produite ; DimConstrReference = 0 ; DimConstrValue = Une exception s’est produite ; DimensionLineColor = 0 ; DimensionLineExtend = 0.246063 ; DimensionLinetype = "DuBloc" ; DimensionLineWeight = -2 ; DimLine1Suppress = 0 ; DimLine2Suppress = 0 ; DimLineInside = 0 ; DimTxtDirection = 0 ; Document (RO) = #<VLA-OBJECT IAcadDocument 000001e9aef27d88> ; EntityTransparency = "DuCalque" ; ExtensionLineColor = 0 ; ExtensionLineExtend = 0.328084 ; ExtensionLineOffset = 0.0625 ; ExtensionLineWeight = -2 ; ExtLine1Linetype = "DuBloc" ; ExtLine1Suppress = 0 ; ExtLine2Linetype = "DuBloc" ; ExtLine2Suppress = 0 ; ExtLineFixedLen = 1.5 ; ExtLineFixedLenSuppress = -1 ; Fit = 3 ; ForceLineInside = -1 ; FractionFormat = 0 ; Handle (RO) = "90E2" ; HasExtensionDictionary (RO) = 0 ; HorizontalTextPosition = 0 ; Hyperlinks (RO) = #<VLA-OBJECT IAcadHyperlinks 000001e9ea97ac28> ; Layer = "6_00 - Cotations__" ; LinearScaleFactor = 100.0 ; Linetype = "ByLayer" ; LinetypeScale = 1.0 ; Lineweight = -1 ; Material = "ByLayer" ; Measurement (RO) = 150.0 ; Normal = (0.0 0.0 1.0) ; ObjectID (RO) = 72 ; ObjectName (RO) = "AcDbRotatedDimension" ; OwnerID (RO) = 70 ; PlotStyleName = "ByLayer" ; PrimaryUnitsPrecision = 0 ; Rotation = 0.0 ; RoundDistance = 0.0 ; ScaleFactor = 0.3048 ; StyleName = "Cote_intérieure_100_AT_3" ; SubUnitsFactor = 100.0 ; SubUnitsSuffix = "" ; SuppressLeadingZeros = 0 ; SuppressTrailingZeros = -1 ; SuppressZeroFeet = -1 ; SuppressZeroInches = -1 ; TextColor = 0 ; TextFill = 0 ; TextFillColor = 0 ; TextGap = 0.0328084 ; TextHeight = 0.0783126 ; TextInside = -1 ; TextInsideAlign = 0 ; TextMovement = 0 ; TextOutsideAlign = 0 ; TextOverride = "<>\\Xallège BA 100Ht" ; TextPosition = (25.0847 10.1896 0.0) ; TextPrefix = "" ; TextRotation = 0.0 ; TextStyle = "Century Gothic_1" ; TextSuffix = "x147Ht" ; ToleranceDisplay = 0 ; ToleranceHeightScale = 1.0 ; ToleranceJustification = 1 ; ToleranceLowerLimit = 0.0 ; TolerancePrecision = 4 ; ToleranceSuppressLeadingZeros = 0 ; ToleranceSuppressTrailingZeros = 0 ; ToleranceSuppressZeroFeet = -1 ; ToleranceSuppressZeroInches = -1 ; ToleranceUpperLimit = 0.0 ; TrueColor = #<VLA-OBJECT IAcadAcCmColor 000001e9ea97a260> ; UnitsFormat = 2 ; VerticalTextPosition = 1 ; Visible = -1 LE CALQUE DE L ENTITE EST : 6_00 - Cotations__ a+ Phil EXEMPLE COTE WIDTH.dwg

bonjour j'ai récupérer des fichiers REVIT ou ARCHICAD sur toutes les cotations, la largeur totale de la regle du texte ( quand on double clique dessus ) de cote est énorme (le "width" du textmult de la cotation est énorme.) sur certaines il y a un meme un masque de texte, ce qui fait que quand les cotes sont sur l'avant plan, ca m occulte une partie des entités dessin. OUI JE N'ai qu'a mettre les cotations en arriere plan, mais ca ne régle pas efficacement le problème pour autant, et pour les suivants. avez vous un lisp ou bout de lisp , ou vous intervenez sur le textmult de la cotation que je puisse changer le "width" du textmult en 0 de toutes les cotations ? merci Phil