sada20

Bonjour, je souhaiterais ajouter 3 pages supplémentaires aux 3 pages de sommaires déja présente dans ce lisp afin d'en obtenir 6 au cas, car j'ai beaucoup de pages parfois. Pourriez vous également m'indiquer comment chacun des étape de ce lisp, je n'y connais rien et souhaiterais apprendre calmement. Si vous avez besoin des blocs n'hésitez pas. (defun c:SOMI (/ _insert _AddNextTab CopytoLayout ThetabOrder data tagOrder _filter NLay TB existData data layName ipt _layouts attb _Attb layName indx 1lay 2lay ts as _AddData) ;;; pBe 2020 ;;; (defun _insert (bn pt spc) (vlax-invoke (vlax-get spc 'Block) 'InsertBlock pt bn 1 1 1 0) ) (defun _AddNextTab (doc lnm / nlay) (if (vl-catch-all-error-p (setq nlay (vl-catch-all-apply (function vla-item) (list (vla-get-Layouts doc) lnm)))) (setq nlay (vla-Add (vla-get-Layouts doc) lnm))) ) (defun CopytoLayout (l1 l2 l3 l4 doc _O nx / NLay ObjLst) (mapcar '(lambda (v fn fns) (or ObjLst (vlax-for obj (vlax-get (vla-item (vla-get-Layouts doc) l1) 'Block) (setq ObjLst (cons Obj ObjLst))) ) (setq NLay (vla-Add (vla-get-Layouts doc) v)) (vla-CopyObjects doc (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbObject (cons 0 (1- (length ObjLst)))) (reverse ObjLst))) (vla-get-Block NLay)) (foreach lay (eval fn) (vla-put-taborder (vla-item (vla-get-Layouts doc) lay) nx ) (setq nx (1+ nx)) ) (_AddData v fns) (setq _O (mapcar 'car (setq ordr (vl-sort (cddr (ThetabOrder (vla-get-Layouts doc))) '(lambda (n m)(< (Cdr n)(cdr m)))) )) nx (cdr (assoc (Car _O) ordr))) ) l2 l3 l4) ) (defun _filter (g / f fdata) (foreach itm tagOrder (if (Setq f (assoc itm g)) (setq fdata (cons f fdata)) ) ) fdata ) (defun _AddData ( _lay _fn / Adata attb) (if (and (setq Adata (ssget "_x" (append SelFil (list (cons 410 _lay))))) (setq attb (_filter (_Attb (setq Adata (ssname Adata 0))))) ) (progn (foreach itm (list (cons "FOL" _lay) '("IND" . "A")) (if (assoc (car itm) attb) (setpropertyvalue Adata (car itm) (cdr itm)))) (setq data (Eval _fn)) ) ) ) (setq ThetabOrder (lambda (l / lst) (vlax-for lay l (setq lst (cons (cons (vla-get-name lay) (vla-get-taborder lay) ) lst ) ) ) ) ) (setq _Attb (lambda (v) (mapcar '(lambda (At) (list (Vla-get-tagstring at) (itoa (Vla-get-objectID at)) ) ) (vlax-invoke (vlax-ename->vla-object v) 'GetAttributes) ) ) ) (setq Nsheet (lambda (n) (vl-string-subst n "a" 1lay))) (setq aDoc (vla-get-activedocument (vlax-get-acad-object)) _layouts (vla-get-layouts aDoc) ipt '(0.0 275.0 0.0) Order (ThetabOrder _Layouts) tagOrder '("FOL" "TITRE1" "TITRE2" "DATE" "IND") m 28 SelFil '((0 . "INSERT") (66 . 1) (2 . "CFA-F_A3_2014")) ) (if (and (vl-every '(lambda (b) (tblsearch "BLOCK" b)) '("SOMMAIRE_HEADER" "SOMMAIRE_DATA")) (setq data nil TB (ssget "X" SelFil)) ) (progn (if (setq existData (ssget "_X" '((2 . "SOMMAIRE_DATA")))) (repeat (sslength existData) (setq e (ssname existData 0)) (entdel e)(ssdel e existData)) ) (repeat (setq i (sslength TB)) (setq layName (cdr (assoc 410 (entget (setq e (ssname TB (setq i (1- i))))) ) ) ) (setq attb (_Attb e)) (setq Data (Cons (list (Cdr (assoc layName Order)) layName attb) DAta ) ) ) (setq data (mapcar '(lambda (d / fdata) (Setq g (Caddr d)) (setq fdata (_filter g)) (list (car d)(cadr d) (reverse fdata)) ) data ) data (vl-sort data '(lambda (a b) (< (car a) (car b)))) _Order (mapcar 'cadr data) indx (caar data) 1lay (cadar data) 2lay (Nsheet "b") 3Lay (Nsheet "c") data (mapcar 'caddr data) ts '(append (list (car _O) v) (cdr _O)) as '(append (list (car data) attb) (cdr data))) (cond ( (and (> (setq llength (length data)) ( * m 2.0) ) (not (member 3Lay (layoutlist)))) (CopytoLayout 1lay (list 2lay 3Lay) (list ts '(append (list (car _O)(cadr _O) v) (cddr _O))) (list as '(append (list (car data) (cadr data) attb) (cddr data))) aDoc _Order indx) ) ( (and (> llength m) (not (member 2lay (layoutlist)))) (CopytoLayout 1lay (list 2lay)(list ts) (list as) aDoc _Order indx) ) ) (foreach itm data (if (<= (cadr ipt) 41.0) (setq ipt '(0.0 275.0 0.0) 1lay 2lay 2lay (vl-string-subst "c" "b" 2lay))) (setq atbv (_insert "SOMMAIRE_DATA" ipt (Vla-item _layouts 1lay))) (foreach atv (Vlax-invoke atbv 'GetAttributes) (if (setq f (assoc (vla-get-tagstring atv) itm)) (vla-put-textstring atv (strcat "%<\\AcObjProp Object(%<\\_ObjId " (cadr f) ">%).TextString \\f \"%tc1\">%")))) (setq ipt (polar ipt (* pi 1.5) 9.0)) ) ) (princ "\n<<< Support block(s) not found | Null Selection >>>") ) (princ) )

sur le Lisp de Patrick, il s'insère à sur le folio 000-1 au milieu mais dans l'espace objet cela ne me dérangerait pas ou bien la meme chose ou en haut à gauche pour prendre la page complète ou bien si j'avais la main pour l'insertion.

Tu trouveras le fichier ici https://forums.autodesk.com/t5/autocad-tous-produits-francais/sommaire-automatique/td-p/2568605 https://forums.autodesk.com/t5/autocad-tous-produits-francais/creer-un-sommaire-vias-chaque-cartouche/td-p/1940258 Merci

Bonjour, Pour te résumer, j'ai un folio "PDG-F00"(ma page de garde) puis un folio "F-0A"(sommaire page 1), un folio "F-0B"(sommaire page 2), un folio "F-01" mon plan etc... Je souhaiterai créer un sommaire automatique qui va aller me récupérer ce qui se trouve dans certains attributs du cartouche tels que titre 1 et titre 2, le numéro du folio (F-0X etc...) et l'indice pour les mettre dans le sommaire Ci-dessous un liens du fichier WEtransfer https://we.tl/t-RPqmMuhag3 Patrick_35 avait fait un Lisp SOM.lsp mais des que je modifie les noms des folios cela me mets un message d'erreur soit pas de plans soit erreur:type d'argument incorrect….) Merci

je sèche (rires forts), je pige rien ou alors faut m'expliquer je ne demande que ça

merci tout de meme

Merci, c'est déjà ça, mais je recherche une solution pour plusieurs fichiers différents. Car là ta solution m'oblige à refaire la même chose sur tous et ça prends du temps. Même si je n'ai pas les croix de révisions d'indice, cela ne me dérange pas. tant que j'ai le numéro de chaque page, avec le titre et l'indice cela me va, mais avec une pagination et formalisme identique à tous mes fichiers.

bonjour, je souhaiterai créer un sommaire automatique en fonction de ce type de cartouche ci-joint. https://www.dropbox....t/test.dwg?dl=0 J'ai essayé le lisp de Patrick 35 (paix à son âme) mais des que je remplace les nom des attributs que ce soit sur mon bloc ou bien dans le lisp j'ai un message d'erreur. Une âme charitable pourrait elle m'aider à réaliser un lisp fonctionnelle? Merci d'avance.

bonjour, je souhaiterai créer un sommaire automatique en fonction de ce type de cartouche ci-joint. https://www.dropbox.com/s/oi1ghkiexlimyvt/test.dwg?dl=0 J'ai essayé le lisp de Patrick 35 mais des que je remplace les nom des attributs que ce soit sur mon bloc ou bien dans le lisp j'ai un message d'erreur. Une âme charitable pourrait elle m'aider à réaliser un lisp fonctionnelle? Merci d'avance.

Bonjour, La commande ne fonctionne pas pour moi. je charge bien le lisp 'changeAttribut" (defun c:ChangeAttribut (/ nom tag val sel i bloc) (if (and (setq nom (getstring "\nNom du bloc: ")) (setq tag (getstring "\nEtiquette de l'attribut: ")) (setq val (getstring T "\nValeur de l'attribut: ")) (setq sel (ssget "_X" (list (cons 0 "INSERT") (cons 2 nom)))) ) (repeat (setq i (sslength sel)) (setq bloc (ssname sel (setq i (1- i)))) (setpropertyvalue bloc (strcase tag) val) ) ) (princ) ) Puis lance la commande Changeattribut selectionne le nom du bloc "CARTOUCHE" renseigne l'étiquette "IND" Et inscrit la nouvelle valeur "R0" cela ne fonctionne pas et avance ça j'utilisais (defun c:ch_attribut(/ ordre blocd etiquetted nouvelle ancienne filtre selection ptr nbrmod entite pripriete actuelle k a) (write-line "\nTéléchargé depuis le site Internet http://www.decker-cs.com") (write-line "Auteur : Christian Decker") ; (write-line "Changer la valeur d'un attribut.") ; (while ;Attend la sélection d'une méthode. (and (/= ordre "CHA") (/= ordre "SUB") (/= ordre "DWG") (/= ordre "PRE") (/= ordre "SUF") ) (setq ordre(strcase(getstring "Méthode (CHAnger / SUBstituer / DWGname / PREfixe / SUFfixe) : "))) (if (> (strlen ordre) 3) ;La chaîne contient au moins quatre caractères. (setq ordre(substr ordre 1 3)) ;Préserve uniquement les trois premiers caractères de la chaîne. ) ) (if (or (= ordre "CHA") (= ordre "PRE") (= ordre "DWG") (= ordre "SUF") (= ordre "SUB") ) (progn (if (= ordre "CHA") ;Saisie des données avec l'option Changer. (progn (setq blocd(strcase(getstring "Nom du bloc contenant l'attribut à modifier : "))) (setq etiquetted(strcase(getstring "Etiquette de l'attribut à modifier : " 1))) (setq nouvelle(getstring "Nouvelle valeur : " 1)) ) ) (if (= ordre "SUB") ;Saisie des données avec l'option Substituer. (progn (setq blocd(strcase(getstring "Nom du bloc contenant l'attribut à modifier : "))) (setq etiquetted(strcase(getstring "Etiquette de l'attribut à modifier : " 1))) (setq ancienne "") (while (= ancienne "") ;Attend une occurrence de texte non nulle. (setq ancienne(getstring "Ancienne chaîne de caractères : " 1)) (if (= ancienne "") ;La chaîne est vide. (write-line "L'ancienne chaîne de caractères doit être non nulle.") ) ) (setq nouvelle(getstring "Nouvelle chaîne de caractères : " 1)) ) ) (if (= ordre "DWG") ;Saisie des données avec l'option Dwgname. (progn (setq blocd(strcase(getstring "Nom du bloc contenant l'attribut à modifier : "))) (setq etiquetted(strcase(getstring "Etiquette de l'attribut à modifier : " 1))) ) ) (if (= ordre "PRE") ;Saisie des données avec l'option Préfixe. (progn (setq blocd(strcase(getstring "Nom du bloc contenant l'attribut à modifier : "))) (setq etiquetted(strcase(getstring "Etiquette de l'attribut à modifier : " 1))) (setq nouvelle(getstring "Préfixe : " 1)) ) ) (if (= ordre "SUF") ;Saisie des données avec l'option Suffixe. (progn (setq blocd(strcase(getstring "Nom du bloc contenant l'attribut à modifier : "))) (setq etiquetted(strcase(getstring "Etiquette de l'attribut à modifier : " 1))) (setq nouvelle(getstring "Suffixe : " 1)) ) ) (if (/= (tblsearch "BLOCK" blocd) nil) ;La définition du bloc recherché existe dans le dessin. (progn (setq filtre(list (cons '0 "INSERT") (cons '2 blocd))) (setq selection(ssget "X" filtre)) ;Crée un jeu de sélection. (if (/= selection nil) ;Au moins un bloc trouvé dans le dessin. (progn (setq ptr 0) (setq nbrmod 0) (while (< ptr (sslength selection)) ;Pour chaque bloc dans le jeu de sélection... (setq entite(entnext(ssname selection ptr))) ;Extraction du bloc. (while (and (/= entite nil) (/= (cdr(assoc '0 (entget entite))) "SEQEND")) ;Pour chaque attribut du bloc... (setq propriete(entget entite)) ;Extraction des propriétés de l'attribut. (if (= (cdr(assoc '2 propriete)) etiquetted) ;L'attribut doit être modifié. (progn (if (= ordre "CHA") ;Option Changer. (progn (setq propriete(subst(cons '1 nouvelle) (assoc '1 propriete) propriete)) (entmod propriete) (entupd entite) (setq nbrmod(+ nbrmod 1)) ) ) (if (= ordre "SUB") ;Option Substituer. (progn (setq actuelle(cdr(assoc '1 propriete))) ;Extrait la valeur de l'attribut. (setq k 1) ;Positionne le pointeur sur le 1er caractère de la valeur de l'attribut. (setq a 0) ;Sera égal à 1 si l'attribut est modifié. (while (and (<= k (strlen actuelle)) (>= (- (strlen actuelle) (- k 1)) (strlen ancienne))) ; ;Tant que k est inférieure ou égale à la longueur de la chaîne actuelle, et tant que ;(la longueur de la chaîne actuelle - (la position du pointeur - 1)) est égale ou ;supérieure à la longueur de l'occurrence du texte à rechercher. ; (if (= (substr actuelle k (strlen ancienne)) ancienne) (progn ; ;Le pointeur est sur le 1er caractère de l'occurrence du texte recherché. ; ;Remplace l'occurrence de texte par la nouvelle valeur : ;1) Récupère les caractères situés en amont du pointeur. ;2) Ajoute la nouvelle valeur. ;3) Récupère les caractères situés en aval de l'occurrence de texte. ; (setq actuelle (strcat (substr actuelle 1 (- k 1)) nouvelle (substr actuelle (+ k (strlen ancienne)) (- (strlen actuelle) (+ (- k 1) (strlen ancienne)))) ) ) ;Ajuste la position du pointeur sur le dernier caractère de la nouvelle valeur insérée. (setq k(+ (- k 1) (strlen nouvelle))) (setq a 1) ;La valeur de l'attribut est modifiée. ) ) (setq k(+ k 1)) ;Incrémente l'index du pointeur. ) (if (= a 1) (progn (setq propriete(subst(cons '1 actuelle) (assoc '1 propriete) propriete)) (entmod propriete) (entupd entite) (setq nbrmod(+ nbrmod 1)) ) ) ) ) (if (= ordre "DWG") ;Option Dwgname. (progn (setq propriete(subst(cons '1 (getvar "DWGNAME")) (assoc '1 propriete) propriete)) (entmod propriete) (entupd entite) (setq nbrmod(+ nbrmod 1)) ) ) (if (= ordre "PRE") ;Option Préfixe. (progn (setq propriete(subst(cons '1 (strcat nouvelle (cdr(assoc '1 propriete)))) (assoc '1 propriete) propriete)) (entmod propriete) (entupd entite) (setq nbrmod(+ nbrmod 1)) ) ) (if (= ordre "SUF") ;Option Suffixe. (progn (setq propriete(subst(cons '1 (strcat (cdr(assoc '1 propriete)) nouvelle)) (assoc '1 propriete) propriete)) (entmod propriete) (entupd entite) (setq nbrmod(+ nbrmod 1)) ) ) ) ) (setq entite(entnext entite)) ;Sélectionne l'attribut suivant du bloc. ) (setq ptr(+ ptr 1)) ;Incrémente l'index du jeu de sélection des blocs. ) (write-line (strcat "Nombre de blocs trouvés : " (itoa (sslength selection)))) (write-line (strcat "Nombre d'attributs modifiés : " (itoa nbrmod))) (princ) ) ) ) ) ) ) ) mais depuis ce matin cela ne fonctionne plus du tout à la fin j'ai "nil" qui s'affiche je ne comprends plus. Pourriez vous m'aider s'il vous plait.

Bonjour, afin de pouvoir utiliser SuperAutoScript pour lancer la modification de plusieurs attributs (INDICE, DATE, AUTEUR et VERIFICATEUR) d'un meme bloc (CARTOUCHE), je souhaiterai pouvoir créer un script. car j'ai plusieurs documents autocad à modifier. Certains contiennent plusieurs onglets. Est ce qu'il se possible qu'une ame charitable puisse m'aider à réaliser celui-ci, tout en m'expliquant? Merci d'avance

Bonjour je recherche des blocs de détecteurs de fumée, de flamme, clapet coupe feu, sirene etc... pour réalisation de plan d'implantaion et araignées de cablage. Merci Voici mon mail au cas ou: SADA20@yahoo.fr [Edité le 2/2/2010 par sada20]

Oui ca marche mais est ce qu'il y a une commande qui compilerait extrim + ssoc + supprimer

Toujours pas d'autre solution?

Non trop dur, autant faire EXTRIM selectionner mon rectangle et cliquer à l'exterieur pour qu'il ajuste tous les objets et poliligne et ligne à mon rectangle et effacer tout ce qui est autour. Merci quand meme

Bonjour, en faite ce n'est pas vraiment ce que je recherche, je vais mieux m'exprimer, voila j'ai plusieurs polylignes et objets sur un plan et je souhaiterai selectionner une zone d'un plan à l'aide d'une polyligne cloturée ou rectangle et supprimer tous ce qui se trouve à l'exterieur de cette zone délimitée par par mon rectangle ou polyligne. Extrim me supprime juste ce qui touche ma polyligne ou mon rectangle mais ne supprime pas tout tout ce qui se trouve autour, en faite il m'ajuste en quelquesortes. Mais c'est deja bien Voili voilou.

Merci bien c'est deja ca, comme tu dis, mais si toi ou une autre personne à une autre solution je suis preneur. Bonne journée

Bonjour, je souhaiterais connaitre la commande ou s'il existe un lisp pour supprimer tous les objets ou lignes en dehors d'une polyligne, attention ce n'est pas une xref. Merci.