Hyppolight

Bonjour, Je sais que ce message est très ancien mais ayant trouvé une partie de code de Jimmy Bergmark dans sa commande "LayoutsToDwgs.lsp" pouvant être adaptée pour l'extraction de tous les blocs dans AutoCAD MAP sans avoir le message "Inclure les informations AutoCAD MAP dans l'exportation", je me permet de partager. https://jtbworld.com/autocad-export-layouts-to-drawings-layoutstodwgs-lsp La partie du code d'origine modifiée: (foreach blk lst (setq fn (strcat path (chr 92) blk)) (if (findfile (strcat fn ".dwg")) (command "_.WBLOCK" fn "_Y" blk) (command "_.WBLOCK" fn blk) ) ) Le code modifié : (setq msg "" msg2 "" i 0 j 0) (foreach blk lst (setq fn (strcat path (chr 92) blk)) (if (findfile (strcat fn ".dwg")) (progn (command "_.-WBLOCK" fn "_Y" blk) (if (equal 1 (logand 1 (getvar "cmdactive"))) (progn (setq i (1+ i) msg (strcat msg "\n" fn)) (command "*") ) (setq j (1+ j) msg2 (strcat msg2 "\n" fn)) ) ) (progn (command "_.-WBLOCK" fn blk) (setq i (1+ i) msg (strcat msg "\n" fn)) ) ) (if (equal 1 (logand 1 (getvar "cmdactive"))) (command "_Y") ) ) Code complet : ; ---------------------------------------------------------------------- ; (Wblocks all local block definitions to target path) ; Copyright (C) 2000 DotSoft, All Rights Reserved ; Website: http://www.dotsoft.com ; ---------------------------------------------------------------------- ; DISCLAIMER: DotSoft Disclaims any and all liability for any damages ; arising out of the use or operation, or inability to use the software. ; FURTHERMORE, User agrees to hold DotSoft harmless from such claims. ; DotSoft makes no warranty, either expressed or implied, as to the ; fitness of this product for a particular purpose. All materials are ; to be considered ‘as-is’, and use of this software should be ; considered as AT YOUR OWN RISK. ; ---------------------------------------------------------------------- (defun c:wba () (setq cmdecho (getvar "CMDECHO")) (setq expert (getvar "EXPERT")) (setq cmddia (getvar "CMDDIA")) (setvar "CMDECHO" 0) (setvar "EXPERT" 2) (setvar "CMDDIA" 0) ; (if (not dos_getdir) (setq path (getstring "\nDS> Dossier cible: " T)) (setq path (dos_getdir "Dossier cible" (getvar "DWGPREFIX"))) ) (if (/= path nil) (progn (if (= (substr path (strlen path) 1) "\\") (setq path (substr path 1 (1- (strlen path)))) ) (princ "\nDS> Création de la liste de blocs ... ") (setq lst nil) (setq itm (tblnext "BLOCK" T)) (while (/= itm nil) (setq nam (cdr (assoc 2 itm))) (setq pass T) (if (/= (cdr (assoc 1 itm)) nil) (setq pass nil) (progn (setq ctr 1) (repeat (strlen nam) (setq chk (substr nam ctr 1)) (if (or (= chk "*")(= chk "|")) (setq pass nil) ) (setq ctr (1+ ctr)) ) ) ) (if (= pass T) (setq lst (cons nam lst)) ) (setq itm (tblnext "BLOCK")) ) (setq lst (acad_strlsort lst)) (princ "Fait.") ; ;(foreach blk lst ; (setq fn (strcat path (chr 92) blk)) ; (if (findfile (strcat fn ".dwg")) ; (command "_.WBLOCK" fn "_Y" blk) ; (command "_.WBLOCK" fn blk) ; ) ;) (setq msg "" msg2 "" i 0 j 0) (foreach blk lst (setq fn (strcat path (chr 92) blk)) (if (findfile (strcat fn ".dwg")) (progn (command "_.-WBLOCK" fn "_Y" blk) (if (equal 1 (logand 1 (getvar "cmdactive"))) (progn (setq i (1+ i) msg (strcat msg "\n" fn)) (command "*") ) (setq j (1+ j) msg2 (strcat msg2 "\n" fn)) ) ) (progn (command "_.-WBLOCK" fn blk) (setq i (1+ i) msg (strcat msg "\n" fn)) ) ) (if (equal 1 (logand 1 (getvar "cmdactive"))) ; Include AutoCAD Map information in the export? ; If you don't want to include Map information in the new files change "_Y" to "_N" below (command "_Y") ) ) ) ) ; (setvar "CMDECHO" cmdecho) (setvar "EXPERT" expert) (setvar "CMDDIA" cmddia) (princ) ) A+ Yoan

Petite précision pour les blocs ou blocs dynamiques attributaires (blocs avec des attributs) et l'utilisation de Superautoscript Pour ne pas à avoir la demande des valeurs d'attributs lors du remplacement du bloc il faut que les variables ATTDIA et ATTREQ soit à 0 On a donc par exemple le script suivant qui remplace un bloc existant, purge le fichier et effectue un zoom étendu: CMDDIA 0 FILEDIA 0 ATTDIA 0 ATTREQ 0 EXPERT 5 -INSERER STBAN=C:\FTTH_TOOLS\BAL\AXS20002_MANCHE\SUPPORT\STBAN 0,0 1 0 EFFACER _L -PURGER TO * N ZOOM ET CMDDIA 1 FILEDIA 1 ATTDIA 1 ATTREQ 1 EXPERT 0 Explication du script : CMDDIA 0 --> Désactive l'affichage des boites de dialogues liées aux commandes : INFO VARIABLE SYSTEME CMDDIA FILEDIA 0 --> Désactive l'affichage des boites de dialogues liées aux fichiers : INFO VARIABLE SYSTEME FILEDIA ATTDIA 0 --> Désactive l'affichage des boites de dialogues liées aux attributs : INFO VARIABLE SYSTEME ATTDIA ATTREQ 0 --> Désactive la demande de renseignements des attributs lors de l'insertion d'un bloc : INFO VARIABLE SYSTEME ATTREQ EXPERT 5 --> Supprime l'invite "Ce nom est déjà utilisé, voulez-vous le redéfinir?" : INFO VARIABLE SYSTEME EXPERT -INSERER STBAN=C:\FTTH_TOOLS\BAL\AXS20002_MANCHE\SUPPORT\STBAN 0,0 1 0 --> Insert le bloc STBAN (en remplaçant les blocs du même nom présent dans le dwg) par le bloc (celui qui a été mis à jour) à l'emplacement C:\FTTH_TOOLS\BAL\AXS20002_MANCHE\SUPPORT\STBAN.dwg (attention ne pas mettre l'extension .dwg dans le script) --> Au point 0,0 avec une échelle 1 et une rotation de 0 EFFACER _L --> Supprime la dernière sélection (le _L est la commande anglaise pour dire Last = dernier) : donc on supprime le bloc insérer au point 0,0 -PURGER TO * N --> Purger, Tout, * = tout les noms sont à purger, N = pas de vérification des noms à purger (pour qu'il n'y ait pas de demande de validation à chaque calque, bloc... à purger) ZOOM ET --> Zoom étendu CMDDIA 1 --> Réactive l'affichage des boites de dialogues liées aux commandes FILEDIA 1 --> Réactive l'affichage des boites de dialogues liées aux fichiers ATTDIA 1 --> Réactive l'affichage des boites de dialogues liées aux attributs ATTREQ 1 --> Réactive la demande de renseignements des attributs lors de l'insertion d'un bloc EXPERT 0 --> Affiche tous les messages normalement. Voilà, j'espère que ca en aidera quelques-uns ;)

Bonjour, Depuis quelques mois j'ai un problème avec l'enregistrement dans la mémoire. J'ai bien entendu fait des recherches sur de nombreux forums (AutoCAD et VB.net plus largement) pour voir si ce problème était déjà arrivé à quelqu'un d'autre Dans n'importe quel projet (alors que cela fonctionnait normalement avant) le temps de sauvegarde est extrêmement lent. Par exemple, j'ai un petit projet avec seulement 4 paramètres de type string dans My.settings Lorsque je cherche à faire la sauvegarde le temps de réponse de la commande my.settings.save est d'environ 5 secondes. Je ne sais pas comment faire car lors du développement, je fais de nombreux tests qui deviennent extrêmement longs. Pour info, une fois la dll générée et ouverte sur un autre post, le temps de sauvegarde est normal. J'ai déjà modifier la valeur de "Voulez-vous participer au Programme d'amélioration de l’expérience utilisateur Visual Studio" de "Oui, Je souhaite participer" vers "Non..." Auriez-vous une idée pour résoudre ou du moins avancé dans la résolution de ce problème? Par avance merci. Hyppo

Cool, tant mieux, désolé, je n'avais pas trop de temps à consacrer à ce problème (vacances à la fin de la semaine et encore pas mal de choses à faire Y'a pas de quoi... Pour moi.. de visu ce sont les lignes (command "._break" obj2break "_non" (trans brkpt 0 1) "_non" (trans p2 0 1)) de la partie (defun break_obj qu'il faut modifier pour pouvoir utiliser toutes les commandes du code fourni: ;;; Function c:BreakAll - Break all objects selected ;;; Function c:BreakwObjects - Break many objects with a single object ;;; Function c:BreakObject - Break a single object with many objects ;;; Function c:BreakWith - Break selected objects with other selected objects ;;; Function c:BreakTouching - Break objects touching the single Break object ;;; Function c:BreakSelected - Break selected objects with any objects that touch it Bon courage pour la suite ;)

Salut, D'après une lecture rapide, il faut tester si la commande "break_with" conserve les données d'objets, sinon il faut la modifier vu qu'elle est appeler dans toutes les autres sous-programmes... Bon courage et bonne journée!! ;)

Bonjour, Ci-dessous un lisp non testé trouvé sur le NET breakall ;;;=======================[ BreakObjects.lsp ]============================== ;;; Author: Copyright© 2006,2007 Charles Alan Butler ;;; Contact @ www.TheSwamp.org ;;; Version: 1.3 April 9,2007 ;;; Globalization by XANADU - www.xanadu.cz ;;; Purpose: Break All selected objects ;;; permitted objects are lines, lwplines, plines, splines, ;;; ellipse, circles & arcs ;;; ;;; Function c:BreakAll - Break all objects selected ;;; Function c:BreakwObjects - Break many objects with a single object ;;; Function c:BreakObject - Break a single object with many objects ;;; Function c:BreakWith - Break selected objects with other selected objects ;;; Function c:BreakTouching - Break objects touching the single Break object ;;; Function c:BreakSelected - Break selected objects with any objects that touch it ;;; ;;; Sub_Routines: ;;; break_with ;;; ssget->vla-list ;;; list->3pair ;;; onlockedlayer ;;; get_interpts Return a list of intersect points ;;; break_obj Break entity at break points in list ;;; Requirements: objects must have the same z-value ;;; Restrictions: Does not Break objects on locked layers ;;; Returns: none ;;;===================================================================== ;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED ; ;;; WARRANTY. ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR ; ;;; PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED. ; ;;; ; ;;; You are hereby granted permission to use, copy and modify this ; ;;; software without charge, provided you do so exclusively for ; ;;; your own use or for use by others in your organization in the ; ;;; performance of their normal duties, and provided further that ; ;;; the above copyright notice appears in all copies and both that ; ;;; copyright notice and the limited warranty and restricted rights ; ;;; notice below appear in all supporting documentation. ; ;;;===================================================================== ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ;; M A I N S U B R O U T I N E ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ (defun break_with (ss2brk ss2brkwith self / cmd intpts lst masterlist ss ssobjs onlockedlayer ssget->vla-list list->3pair get_interpts break_obj ) ;; ss2brk selection set to break ;; ss2brkwith selection set to use as break points ;; self when true will allow an object to break itself ;; note that plined will break at each vertex (vl-load-com) ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ;; S U B F U N C T I O N S ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ (defun onlockedlayer (ename / entlst) (setq entlst (tblsearch "LAYER" (cdr (assoc 8 (entget ename))))) (= 4 (logand 4 (cdr (assoc 70 entlst)))) ) (defun ssget->vla-list (ss / i ename lst) (setq i -1) (while (setq ename (ssname ss (setq i (1+ i)))) (setq lst (cons (vlax-ename->vla-object ename) lst)) ) lst ) (defun list->3pair (old / new) (while (setq new (cons (list (car old) (cadr old) (caddr old)) new) old (cdddr old)) ) (reverse new) ) ;;============================================================== ;; return a list of intersect points ;;============================================================== (defun get_interpts (obj1 obj2 / iplist) (if (not (vl-catch-all-error-p (setq iplist (vl-catch-all-apply 'vlax-safearray->list (list (vlax-variant-value (vla-intersectwith obj1 obj2 acextendnone) )))))) iplist ) ) ;;============================================================== ;; Break entity at break points in list ;;============================================================== (defun break_obj (ent brkptlst / brkobjlst en enttype maxparam closedobj minparam obj obj2break p1param p2 p2param ) (setq obj2break ent brkobjlst (list ent) enttype (cdr (assoc 0 (entget ent))) ) (foreach brkpt brkptlst ;; get last entity created via break in case multiple breaks (if brkobjlst (progn ;; if pt not on object x, switch objects (if (not (numberp (vl-catch-all-apply 'vlax-curve-getdistatpoint (list obj2break brkpt))) ) (foreach obj brkobjlst ; find the one that pt is on (if (numberp (vl-catch-all-apply 'vlax-curve-getdistatpoint (list obj brkpt))) (setq obj2break obj) ; switch objects ) ) ) ) ) ;; Handle any objects that can not be used with the Break Command ;; using one point, gap of 0.000001 is used (cond ((and (= "SPLINE" enttype) ; only closed splines (vlax-curve-isclosed obj2break)) (setq p1param (vlax-curve-getparamatpoint obj2break brkpt) p2 (vlax-curve-getpointatparam obj2break (+ p1param 0.000001)) ) (command "._break" obj2break "_non" (trans brkpt 0 1) "_non" (trans p2 0 1)) ) ((= "CIRCLE" enttype) ; break the circle (setq p1param (vlax-curve-getparamatpoint obj2break brkpt) p2 (vlax-curve-getpointatparam obj2break (+ p1param 0.000001)) ) (command "._break" obj2break "_non" (trans brkpt 0 1) "_non" (trans p2 0 1)) (setq enttype "ARC") ) ((and (= "ELLIPSE" enttype) ; only closed ellipse (vlax-curve-isclosed obj2break)) ;; Break the ellipse, code borrowed from Joe Burke 6/6/2005 (setq p1param (vlax-curve-getparamatpoint obj2break brkpt) p2param (+ p1param 0.000001) minparam (min p1param p2param) maxparam (max p1param p2param) obj (vlax-ename->vla-object obj2break) ) (vlax-put obj 'startparameter maxparam) (vlax-put obj 'endparameter (+ minparam (* pi 2))) ) ;;================================== (t ; Objects that can be broken (setq closedobj (vlax-curve-isclosed obj2break)) (command "._break" obj2break "_non" (trans brkpt 0 1) "_non" (trans brkpt 0 1)) (if (not closedobj) ; new object was created (setq brkobjlst (cons (entlast) brkobjlst)) ) ) ) ) ) ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ;; S T A R T H E R E ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ (if (and ss2brk ss2brkwith) (progn ;; CREATE a list of entity & it's break points (foreach obj (ssget->vla-list ss2brk) ; check each object in ss2brk (if (not (onlockedlayer (vlax-vla-object->ename obj))) (progn (setq lst nil) ;; check for break pts with other objects in ss2brkwith (foreach intobj (ssget->vla-list ss2brkwith) (if (and (or self (not (equal obj intobj))) (setq intpts (get_interpts obj intobj)) ) (setq lst (append (list->3pair intpts) lst)) ; entity w/ break points ) ) (if lst (setq masterlist (cons (cons (vlax-vla-object->ename obj) lst) masterlist)) ) ) ) ) ;; masterlist = ((ent brkpts)(ent brkpts)...) (if masterlist (foreach obj2brk masterlist (break_obj (car obj2brk) (cdr obj2brk)) ) ) ) ) ;;============================================================== ) (prompt "\nBreak Routines Loaded, Enter BreakAll, BreakEnt, or BreakWith to run.") (princ) ;;========================================== ;; Break all objects selected ;;========================================== (defun c:breakall (/ cmd ss) (command "._undo" "_begin") (setq cmd (getvar "CMDECHO")) (setvar "CMDECHO" 0) ;; get objects to break (prompt "\nSelect All objects to break & press enter: ") (if (setq ss (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")))) (Break_with ss ss nil) ; ss2break ss2breakwith (flag nil = not to break with self) ) (setvar "CMDECHO" cmd) (command "._undo" "_end") (princ) ) ;;========================================== ;; Break a single object with many objects ;;========================================== (defun c:BreakObject (/ cmd ss1 ss2) (command "._undo" "_begin") (setq cmd (getvar "CMDECHO")) (setvar "CMDECHO" 0) ;; get objects to break (prompt "\nSelect single object to break: ") (if (and (setq ss1 (ssget "+.:E:S" '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")))) (not (redraw (ssname ss1 0) 3)) (not (prompt "\n*** Select object(s) to break with & press enter: ***")) (setq ss2 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")))) (not (redraw (ssname ss1 0) 4))) (Break_with ss1 ss2 nil) ; ss2break ss2breakwith (flag nil = not to break with self) ) (setvar "CMDECHO" cmd) (command "._undo" "_end") (princ) ) ;;========================================== ;; Break many objects with a single object ;;========================================== (defun c:breakwobjects (/ cmd ss1 ss2) (defun ssredraw (ss mode / i num) (setq i -1) (while (setq ename (ssname ss (setq i (1+ i)))) (redraw (ssname ss i) mode) ) ) (command "._undo" "_begin") (setq cmd (getvar "CMDECHO")) (setvar "CMDECHO" 0) ;; get objects to break (prompt "\nSelect object(s) to break & press enter: ") (if (and (setq ss1 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")))) (not (ssredraw ss1 3)) (not (prompt "\n*** Select single object to break with: ***")) (setq ss2 (ssget "+.:E:S" '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")))) (not (ssredraw ss1 4)) ) (break_with ss1 ss2 nil) ; ss2break ss2breakwith (flag nil = not to break with self) ) (setvar "CMDECHO" cmd) (command "._undo" "_end") (princ) ) ;;========================================== ;; Break many objects with many object ;;========================================== (defun c:BreakWith (/ cmd ss1 ss2) (defun ssredraw (ss mode / i num) (setq i -1) (while (setq ename (ssname ss (setq i (1+ i)))) (redraw (ssname ss i) mode) ) ) (command "._undo" "_begin") (setq cmd (getvar "CMDECHO")) (setvar "CMDECHO" 0) ;; get objects to break (prompt "\nSelect object(s) to break & press enter: ") (if (and (setq ss1 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")))) (not (ssredraw ss1 3)) (not (prompt "\n*** Select object(s) to break with & press enter: ***")) (setq ss2 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")))) (not (ssredraw ss1 4)) ) (break_with ss1 ss2 nil) ; ss2break ss2breakwith (flag nil = not to break with self) ) (setvar "CMDECHO" cmd) (command "._undo" "_end") (princ) ) ;;============================================= ;; Break many objects with a selected objects ;; Selected Objects create ss to be broken ;;============================================= (defun c:BreakTouching (/ cmd ss1 ss2) ;; get all objects touching entities in the sscross ;; limited obj types to "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE" (defun gettouching (sscros / ss lst lstb lstc objl) (and (setq lstb (vl-remove-if 'listp (mapcar 'cadr (ssnamex sscros))) objl (mapcar 'vlax-ename->vla-object lstb) ) (setq ss (ssget "_A" (list (cons 0 "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE") (cons 410 (getvar "ctab")))) ) (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) (setq lst (mapcar 'vlax-ename->vla-object lst)) (mapcar '(lambda (x) (mapcar '(lambda (y) (if (not (vl-catch-all-error-p (vl-catch-all-apply '(lambda () (vlax-safearray->list (vlax-variant-value (vla-intersectwith y x acextendnone) )))))) (setq lstc (cons (vlax-vla-object->ename x) lstc)) ) ) objl) ) lst) ) lstc ) (command "._undo" "_begin") (setq cmd (getvar "CMDECHO")) (setvar "CMDECHO" 0) (setq ss1 (ssadd)) ;; get objects to break (if (and (not (prompt "\nSelect object(s) to break with & press enter: ")) (setq ss2 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")))) (mapcar '(lambda (x) (ssadd x ss1)) (gettouching ss2)) ) (break_with ss1 ss2 nil) ; ss2break ss2breakwith (flag nil = not to break with self) ) (setvar "CMDECHO" cmd) (command "._undo" "_end") (princ) ) ;;========================================================== ;; Break selected objects with any objects that touch it ;;========================================================== (defun c:BreakSelected (/ cmd ss1 ss2) ;; get all objects touching entities in the sscross ;; limited obj types to "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE" (defun gettouching (sscros / ss lst lstb lstc objl) (and (setq lstb (vl-remove-if 'listp (mapcar 'cadr (ssnamex sscros))) objl (mapcar 'vlax-ename->vla-object lstb) ) (setq ss (ssget "_A" (list (cons 0 "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE") (cons 410 (getvar "ctab")))) ) (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) (setq lst (mapcar 'vlax-ename->vla-object lst)) (mapcar '(lambda (x) (mapcar '(lambda (y) (if (not (vl-catch-all-error-p (vl-catch-all-apply '(lambda () (vlax-safearray->list (vlax-variant-value (vla-intersectwith y x acextendnone) )))))) (setq lstc (cons (vlax-vla-object->ename x) lstc)) ) ) objl) ) lst) ) lstc ) (command "._undo" "_begin") (setq cmd (getvar "CMDECHO")) (setvar "CMDECHO" 0) (setq ss1 (ssadd)) ;; get objects to break (if (and (not (prompt "\nSelect object(s) to break with & press enter: ")) (setq ss2 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")))) (mapcar '(lambda (x) (ssadd x ss1)) (gettouching ss2)) ) (break_with ss2 ss1 nil) ; ss2break ss2breakwith (flag nil = not to break with self) ) (setvar "CMDECHO" cmd) (command "._undo" "_end") (princ) ) ;;/'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\. ;; E n d O f F i l e I f y o u A r e H e r e ;;/'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\.

Je t'ai répondu en MP... Bonne fin de journée.

Salut AzRoDoRzA Peux-tu déposee ton fichier en pièce jointe pour voir ce qui ne va. Merci

Bonjour, 4 ans après, nouvelle phase de test... je viens de mettre à jour le lisp et la mise à jour a l'air de bien fonctionner.. ;) Ci-dessous le lisp pour traiter toutes les entités d'un fichiers (defun c:BREAK_LW_WITH_OD ( / js i ent dxf_obj dxf_43 dxf_38 dxf_39 dxf_10 dxf_40 dxf_41 dxf_42 dxf_39 dxf_210 n lst_data nwent tbldef ) (initget "Toutes Sélection _All Select") (if (eq (getkword "\nLWPolylignes à couper à chaque sommets? [Toutes/Sélection] <Sélection>: ") "All") (setq js (ssget "_X" (list (cons 0 "LWPOLYLINE") (cons 67 (if (eq (getvar "CVPORT") 2) 0 1)) (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB"))) ) ) i -1 ) (setq js (ssget (list (cons 0 "LWPOLYLINE") (cons 67 (if (eq (getvar "CVPORT") 2) 0 1)) (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB"))) ) ) i -1 ) ) (cond (js (repeat (sslength js) (setq dxf_obj (entget (setq ent (ssname js (setq i (1+ i)))))) (if (cdr (assoc 43 dxf_obj)) (setq dxf_43 (cdr (assoc 43 dxf_obj))) (setq dxf_43 0.0) ) (if (cdr (assoc 38 dxf_obj)) (setq dxf_38 (cdr (assoc 38 dxf_obj))) (setq dxf_38 0.0) ) (if (cdr (assoc 39 dxf_obj)) (setq dxf_39 (cdr (assoc 39 dxf_obj))) (setq dxf_39 0.0) ) (setq dxf_10 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_obj)) dxf_40 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 40)) dxf_obj)) dxf_41 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 41)) dxf_obj)) dxf_42 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 42)) dxf_obj)) dxf_210 (cdr (assoc 210 dxf_obj)) ) (if (not (zerop (boole 1 (cdr (assoc 70 dxf_obj)) 1))) (setq dxf_10 (append dxf_10 (list (car dxf_10))) dxf_40 (append dxf_40 (list (car dxf_40))) dxf_41 (append dxf_41 (list (car dxf_41))) dxf_42 (append dxf_42 (list (car dxf_42))) n (cdr (assoc 90 dxf_obj)) ) (setq n (1- (cdr (assoc 90 dxf_obj)))) ) (repeat n (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (assoc 67 dxf_obj) (assoc 410 dxf_obj) (assoc 8 dxf_obj) (if (assoc 62 dxf_obj) (assoc 62 dxf_obj) (cons 62 256)) (if (assoc 6 dxf_obj) (assoc 6 dxf_obj) (cons 6 "BYLAYER")) (if (assoc 370 dxf_obj) (assoc 370 dxf_obj) (cons 370 -1)) (cons 100 "AcDbPolyline") (cons 90 2) (cons 70 (boole 1 (cdr (assoc 70 dxf_obj)) 128)) (cons 38 dxf_38) (cons 39 dxf_39) (cons 10 (car dxf_10)) (cons 40 (car dxf_40)) (cons 41 (car dxf_41)) (cons 42 (car dxf_42)) (cons 10 (cadr dxf_10)) (cons 40 (cadr dxf_40)) (cons 41 (cadr dxf_41)) (cons 42 (cadr dxf_42)) (assoc 210 dxf_obj) ) ) (setq dxf_10 (cdr dxf_10) dxf_40 (cdr dxf_40) dxf_41 (cdr dxf_41) dxf_42 (cdr dxf_42) lst_data nil nwent (entlast)) (foreach n (ade_odgettables ent) (setq tbldef (ade_odtabledefn n)) (setq lst_data (cons (mapcar '(lambda (fld) (cons n (cons fld (ade_odgetfield ent n fld 0)))) (mapcar 'cdar (cdr (nth 2 tbldef)))) lst_data)) ) (cond (lst_data (mapcar '(lambda (x) (ade_odaddrecord nwent (caar x)) (foreach el x (ade_odsetfield nwent (car el) (cadr el) 0 (cddr el)))) lst_data) ) ) ) (entdel ent) ) (print (sslength js)) (princ " LWpolyligne(s) coupée(s) à ses sommets avec ses Object Datas.") ) ) (prin1) )

Salut Come, La commande "Insertion"-->"Calque sous-jacent PDF..." sert à insérer un PDF en référence externe et non pas à "digitaliser" les entités présentes sur ce PDF comme le fait la commande IMPORTPDF. Merci cependant pour votre réponse. Cdlt Hyppo'

Salut Denis, Oui, sur la version 2019 je n'ai pas de problème également. C'est uniquement la version 2017 qui pose problème. Nous avons pu passer certains postes en V2019 mais nous sommes beaucoup dans "mon" bureau d'études et je n'ai malheureusement pas assez de temps pour migrer toutes les licences 2017 en 2019. D'autre part je fais du développement AutoCAD et les programmes 2017 ne sont pas toujours compatibles avec la version 2019 et réciproquement (version de Framework différente, commandes lisp différentes (par exemple SCU GE en 2017 --> SCU "" en 2019)... Merci cependant pour votre réponse. Cdlt Hyppo'

Fichier ENEDIS Vous trouverez le fichier ci-dessus...

Bonjour, J'ai paramétré il y a quelques semaines des nouveaux postes (Windows 10 X64 - AutoCAD Map 2017) et je rencontre un problème avec la commande IMPORTPDF sur ces postes. En effet, je cherche à importer un PDF (réseau électrique ENEDIS : exemple page 7 du document ci-joint) dans mon plan. Depuis mon PC (même configuration, mais configuré depuis 1 an, donc je ne sais pas ce que j'ai fait entre temps) je n'ai pas de problème d'importation : toutes les données s'importent bien. Depuis les autres PC, en exécutant la même commande sur le même fichier, seul le texte (calque PDF_Texte) se charge. J'ai été voir sur les différents forums et seul celui-ci (https://forums.autodesk.com/t5/autocad-forum/pdf-import-only-importing-text/td-p/6608936) traite ce sujet, et conseille d'effectuer des mises à jour. J'ai donc effectué l'ensemble de ces mises à jours, mais la commande ne fonctionne toujours pas correctement. Auriez-vous déjà rencontré ce problème? et avez-vous une solution? Par avance merci. Hyppolight

Bonjour, Ce sujet date de longtemps mais sinon il y a une méthode assez simple. Pour le traitement de masse je conseille le gratuiciel "SuperAutoScript" (SAS) SuperAutoScript NOTA : Il a des boutons pour choisir les fichiers ou un dossier mais il est également possible de faire un filtre (exemple taper "*PLAN.dwg" dans les dans dossier Windows pour filtrer tous les fichiers finissant par PLAN.dwg et faire un glisser déposer de tous les fichiers filtrés dans la liste. Ensuite dans la partie "2. Choisissez le script" copier le texte ci-dessous sachant dans ce script je cherche à remplacer un bloc LEGENDE présent dans mes fichiers par celui présent à l'adresse C:\FTTH_TOOLS\GC\GRA15006_ISERE_V3\SUPPORT\BLOCS\BLOC_PRO\LEGENDE (ATTENTION : il ne faut pas mettre l'extension .dwg) CMDDIA 0 FILEDIA 0 EXPERT 5 -INSERER LEGENDE=C:\FTTH_TOOLS\GC\GRA15006_ISERE_V3\SUPPORT\BLOCS\BLOC_PRO\LEGENDE 0,0 1 0 EFFACER _L CMDDIA 1 FILEDIA 1 EXPERT 0 ... Puis lancer le programme... Voilà

Rebonjour, J'ai adapté ton code à mon exemple et ça marche parfaitement bien. Juste un petite remarque: j'ai modifié le point d'origine (Point3D.origin) dans la propriété TwistAnle par itbr.Origin pour que mon point d'origine soit coincident avec le point de base de mon scu... Encore merci... et à bientôt ;) :P Ci-dessous mon code mis à jour (en VB.NET pour ceux qui voudront) <DllImport("accore.dll", CallingConvention:=CallingConvention.Cdecl, _ EntryPoint:="?acedSetCurrentVPort@@YA?AW4ErrorStatus@Acad@@PEBVAcDbViewport@@@Z")> _ Public Shared Function acedSetCurrentVPort(ByVal AcDbVport As IntPtr) As IntPtr End Function 'Mise en forme de la fenêtre : gestion SCU / echelle Public Sub MISE_EN_FORME_FENETRE_FUN(TRONCON As String, SEGMENT As String, ALT As String, NomLayout As String, GRD As clGRD) Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument Dim db As Database = doc.Database Dim ed As Editor = doc.Editor Dim layId As ObjectId Dim lo As Layout Dim loName As String Dim tilemode As Short = CShort(AcadAp.GetSystemVariable("TILEMODE")) Dim cvPort As Short = CShort(AcadAp.GetSystemVariable("CVPORT")) Using doclok As DocumentLock = doc.LockDocument() Using tr As Transaction = doc.Database.TransactionManager.StartTransaction Try Dim laydic As DBDictionary = DirectCast(tr.GetObject(db.LayoutDictionaryId, OpenMode.ForRead, False), DBDictionary) For Each dentry As DictionaryEntry In laydic layId = DirectCast(dentry.Value, ObjectId) lo = DirectCast(tr.GetObject(layId, OpenMode.ForRead), Layout) loName = lo.LayoutName If loName = NomLayout Then Dim Coll As ObjectIdCollection = CollectVieports(lo, doc) 'Une seule fenête par présentation à ce moment là Dim VP_ID As ObjectId = Coll(0) Dim r As BlockTableRecord = TryCast(tr.GetObject(lo.BlockTableRecordId, OpenMode.ForRead), BlockTableRecord) For Each obj As ObjectId In r Dim dbobj As DBObject = tr.GetObject(obj, OpenMode.ForRead) Dim vp As DatabaseServices.Viewport = TryCast(dbobj, DatabaseServices.Viewport) If vp IsNot Nothing Then If vp.ObjectId = VP_ID Then vp.UpgradeOpen() vp.On = True vp.Visible = True ' Set the new viewport current via an imported ObjectARX function acedSetCurrentVPort(vp.UnmanagedObject) ' Activate model space in the viewport ed.SwitchToModelSpace() 'Définition du SCU associé à la planche Dim SCU_NAME As String = "SCU_T" & TRONCON & "_S" & SEGMENT & "_A" & ALT Dim utb As UcsTable = CType(tr.GetObject(db.UcsTableId, OpenMode.ForRead), UcsTable) Dim zAxis As Vector3d If utb.Has(SCU_NAME) Then Dim itbr As UcsTableRecord = CType(tr.GetObject(utb.Item(SCU_NAME), OpenMode.ForRead), UcsTableRecord) Dim ucsMat As Matrix3d = Matrix3d.AlignCoordinateSystem( _ Point3d.Origin, Vector3d.XAxis, Vector3d.YAxis, Vector3d.ZAxis, _ itbr.Origin, itbr.XAxis, itbr.YAxis, itbr.XAxis.CrossProduct(itbr.YAxis)) ed.CurrentUserCoordinateSystem = ucsMat ed.SwitchToPaperSpace() zAxis = itbr.XAxis.CrossProduct(itbr.YAxis) vp.ViewDirection = zAxis vp.TwistAngle = -itbr.XAxis.AngleOnPlane(New Plane(itbr.Origin, zAxis)) End If Exit For End If End If Next Exit For Else End If Next Catch ex As System.Exception MsgBox(ex.ToString) ed.WriteMessage(vbLf & ex.Message & vbLf & ex.StackTrace) End Try tr.Commit() tr.Dispose() ed.Regen() End Using 'tr End Using 'DocumentLock End Sub 'Listing des fenêtres dans une présentation définie Function CollectVieports(ByRef lo As Layout, ByRef doc As Document) As ObjectIdCollection Dim db As Database = doc.Database Dim Btr As BlockTableRecord Dim vp As DatabaseServices.Viewport Dim oidcol As ObjectIdCollection = New ObjectIdCollection() Dim notpvp As Boolean 'don't include the general layout vp Using trans As Transaction = db.TransactionManager.StartTransaction() Btr = DirectCast(trans.GetObject(lo.BlockTableRecordId, OpenMode.ForRead), BlockTableRecord) For Each oid As ObjectId In Btr vp = TryCast(trans.GetObject(oid, OpenMode.ForRead), DatabaseServices.Viewport) If Not vp Is Nothing Then If notpvp Then oidcol.Add(oid) notpvp = True End If Next End Using Return oidcol End Function