(gile)

Tu as raison, au temps pour moi, on ne peut purger Defpoints avec la commande purger mais vla-purgeall le fait, donc la dernière version, telle que ci-dessus, devrait être la bonne dans l'état actuel de nos connaissances ...

Même si tu enlèves tous les objets qui y sont le calque Defpoints ne pourra pas être purgé (comme le calque 0). J'arrive à le supprimer à chaque ouverture du dessin avec vla-delete mais plus s'il est recréé après avoir créer puis effacer une cote. Je vais esssayer de trouver...

Salut, Je n'ai pas réussi à trouver pourquoi le bloc _Archtick n'est pas purgeable ni avec la commande PURGER ni avec la fonction vla-PurgeAll, si le fichier est issu d'une suite verticale ou d'un autre logiciel ceci explique peut-être cela, mais ça ne m'aide pas à comprendre. Toujours est il que j'ai pu contourner le problème en supprimant tous les blocs non référencés avec vla-delete plutôt que vla-PurgeAll. Pour le calque Defpoints, dans le fichier que tu m'as envoyé, les fenêtres de présentation et les polylignes qui ont servi à les faire sont sur ce calque, il n'est donc pas supprimable en l'état. Je poste ici une nouvelle version provisoire de Spurge en attendant de trouver quelque chose de fiable pour le calque Defpoints. ;;; SPURGE version 1.40 ;;; Purge tout, y compris les blocs imbriqués, les blocs vides, ;;; les xrefs et les images non référencées (defun c:spurge (/ AcDoc lay l_lst ss n obj name bloc ent r_lst x_lst p_lst c_lst m ) (vl-load-com) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))) ;; Purge les xrefs et rasters non référencées (c:xref_purge) (c:raster_purge) ;; Dévérouillage de tous les calques (vlax-for c (vla-get-Layers AcDoc) (if (= :vlax-true (vla-get-lock c) ) (progn (vla-put-lock c :vlax-false) (setq l_lst (cons c l_lst)) ) ) ) ;; r_lst : liste des blocs et "sous-blocs" insérés ;; x_lst : liste des xrefs insérées (setq ss (ssget "_X" '((0 . "INSERT")))) (if ss (progn (repeat (setq n (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss (setq n (1- n)))) ) (if (vlax-property-available-p obj 'EffectiveName) (setq name (vla-get-EffectiveName obj)) (setq name (vla-get-Name obj)) ) (if (and (= 0 (vla-get-count (vla-item (vla-get-Blocks AcDoc) name)) ) (= :vlax-false (vla-get-isXref (vla-item (vla-get-Blocks AcDoc) name) ) ) ) (vla-delete obj) ;_ Suppression des blocs vides (if (= :vlax-true (vla-get-isXref (vla-item (vla-get-Blocks AcDoc) name) ) ) (if (not (member name x_lst)) (setq x_lst (cons name x_lst)) ) (if (not (member name r_lst)) (setq r_lst (cons name r_lst)) ) ) ) ) ;; Ajout des "sous-blocs" des blocs insérés à r_lst (setq n 0) (if r_lst (while (setq name (nth n r_lst)) (setq bloc (vla-item (vla-get-blocks acDoc) name)) (repeat (setq m (vla-get-count bloc)) (setq ent (vla-item bloc (setq m (1- m)))) (if (and (= (vla-get-ObjectName ent) "AcDbBlockReference") (not (member (vla-get-name ent) r_lst)) ) (setq r_lst (reverse (cons (vla-get-Name ent) (reverse r_lst))) ) ) ) (setq n (1+ n)) ) ) ) ) ;; c_lst liste des définitions de blocs de la collection (setq c_lst nil) (vlax-for b (vla-get-blocks AcDoc) (setq c_lst (cons (vla-get-name b) c_lst)) ) ;; p_lst : liste des blocs à purger, soit les blocs de la collection ... ;; ... moins les blocs "*Model_Space" "*Paper_Space*" et les blocs insérées (setq p_lst (vl-remove-if '(lambda (x) (or (= (substr x 1 1) "*") (member x r_lst) ) ) c_lst ) ) ;; ... moins les xrefs insérées et les blocs qu'elles contiennent (mapcar '(lambda (x) (setq p_lst (vl-remove-if '(lambda (y) (wcmatch y (strcat x "*")) ) p_lst ) ) ) x_lst ) ;; suppression de tous le blocs de p_lst (mapcar '(lambda (x) (vla-delete (vla-item (vla-get-Blocks AcDoc) x)) ) p_lst ) ;; Purge et audit du dessin (vla-PurgeAll AcDoc) (vla-AuditInfo AcDoc :vlax-true) ;; Restauration de l'état des calques (if l_lst (mapcar '(lambda (x) (vla-put-lock x :vlax-true) ) l_lst ) ) (princ) ) [Edité le 13/9/2006 par (gile)]

Salut Fraid Décidément je crois que je me débrouille mieux pour faire des LISP qui créent ou qui transforment des objets graphiques que pour "nettoyer" un dessin :casstet: Je peux difficilement répondre à la question comme ça, il faudrait d'abord essayer de situer le (ou les) bug(s) dans une des sous routines Raster_purge ou xref_purge ou dans la routine Spurge. Depuis que j'ai découvert des zombies dans certains blocs et qu'ils faisaient planter Edit_Bloc je m'attends à tout. Le plus simple serait que tu m'envoie un fichier ou fragment de fichier (si confidentiel) avec les blocs incriminés. Pour le calque Defpoint, je vais essayer de voir, demain, je devrais avoir un peu de temps, ce soir je suis trop fatigué. gilecantel(at)wandoo.fr

Bonsoir, Voilà : ;;; Pline_bloc -Gilles Chanteau- 13/09/06 ;;; Insère le bloc "pline_block" après sélection d'une polyligne ;;; Attribut 1 : Aire de la polyligne (defun c:pline_block (/ AcDoc Space bloc nom ent aire long ins) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= (getvar "CVPORT") 1) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (cond ((tblsearch "BLOCK" (setq bloc "Pline_block"))) ((findfile (setq bloc "Pline_block.dwg"))) (T (setq bloc nil)) ) (if bloc (progn (while (not (setq ent (car (entsel))))) (if (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE") (progn (setq obj (vlax-ename->vla-object ent) id (vla-get-ObjectID obj) aire (strcat "% (itoa id) ">%).Area \\f \"%lu6%qf1\">%" ) ) (initget 1) (setq ins (trans (getpoint "\nPoint d'insertion: ") 1 0)) (setq ref (vla-InsertBlock Space (vlax-3d-point ins) bloc 1.0 1.0 1.0 0.0 ) ) (vla-put-TextString (car (vlax-invoke ref 'GetAttributes)) aire) (vla-regen AcDoc acActiveViewport) ) (alert "L'objet sélectionné n'est pas une polyligne.") ) ) (alert "Le bloc \"Pline_block\" est introuvable.") ) (princ) ) [Edité le 13/9/2006 par (gile)]

Re, Un petit LISP vite fait (pas testé en profondeur) qui, il me sempbe répond à ta demande : Tu sélectionne un arc puis la ligne tangente à l'arc du côté où tu veux modifier l'arc et tu spécifies le nouvel angle. (defun c:arcline_edit (/ arc line sens ang dif) (while (not (and (setq arc (car (entsel "\nSélectionnez un arc: "))) (= "AcDbArc" (vla-get-objectName (setq arc (vlax-ename->vla-object arc))) ) ) ) ) (while (not (and (setq line (car (entsel "\nSélectionnez une ligne tangente à l'arc: ") ) ) (= "AcDbLine" (vla-get-objectName (setq line (vlax-ename->vla-object line)) ) ) ) ) ) (cond ((or (equal (vlax-get arc 'StartPoint) (vlax-get line 'StartPoint) 1e-9 ) (equal (vlax-get arc 'StartPoint) (vlax-get line 'EndPoint) 1e-9 ) ) (setq sens -1) ) ((or (equal (vlax-get arc 'EndPoint) (vlax-get line 'StartPoint) 1e-9 ) (equal (vlax-get arc 'EndPoint) (vlax-get line 'StartPoint) 1e-9 ) ) (setq sens 1) ) (T (prompt "\nL'arc et la ligne ne sont pas jointifs.")) ) (if sens (progn (prompt (strcat "\nAngle actuel de l'arc : " (angtos (setq ang (- (vla-get-EndAngle arc) (vla-get-StartAngle arc)) ) ) ) ) (initget 1) (setq dif (- (getangle "\nSpécifiez le nouvel angle: ") ang)) (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)) ) (if (minusp sens) (vla-put-StartAngle arc (- (vla-get-StartAngle arc) dif)) (vla-put-EndAngle arc (+ (vla-get-EndAngle arc) dif)) ) (vla-rotate line (vla-get-Center arc) (* sens dif) ) (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)) ) ) ) (princ) ) [Edité le 12/9/2006 par (gile)]

Très bonne idée ! Merci Patrick.

Salut, Ça ne fait peut-être pas tout, mais ça pourrait aider : tu touveras ici un LISP qui permet de transformer les cercles et ellipses en arc (ou vice-versa) et de modifier les arcs (de cercle ou d'ellipse). On peut, pour les arcs spécifier les angles de départ et de fin à l'aide du pointeur ou au clavier.

En LISP on ajoute un anti slash "\" devant certains caractères à l'intérieur d'une chaine (anti-slash et guillemets) : "%%).Area [surligneur]\[/surligneur]\f [surligneur]\[/surligneur]"%lu2[surligneur]\[/surligneur]">%" Il doit certainement y avoir un équivalent en VBA.

Salut, Tu peux, créer un nouveau profil utilisateur sous le quel tu fais tes modifs et recharger le profil > qui n'a pas été modifié. S'il a aussi été modifier tu peux le "Réinitialiser". Sinon il y a aussi un fichier AutoCAD.cui non modifié dans : C:\Program Files\AutoCAD 2006\UserDataCache\Support [Edité le 8/9/2006 par (gile)]

Salut, (prompt "\nSélectionner des polylignes ! ") (if (setq ss (ssget '((0 . "LWPOLYLINE") (-4 . "&") (70 . 1)))) (command "_-hatch" "_solid" ss "") ) ((0 . "LWPOLYLINE") (-4 . "&") (70 . 1)) est un filtre de sélection pour ne sélectionner que des polylignes fermées. PS : il est préférable de mettre aussi les options de commande en "international" : _s ou _solid plutôt que s. J'ai rajouté un test (if ...)) pour ne lancer le (command ...) que si le jeu de sélection existe. [Edité le 8/9/2006 par (gile)]

Salut, Si tu crées ton bloc avec la commande BLOC, il fait partie de la collection de bloc de ce dessin et tu pourras l'insérer dans ce dessin autant de fois que tu veux avec la commande INSERER. Si tu veux insérer ce bloc dans un autre dessin, tu pourras le récupérer par le Design Center, mais ce n'est pas le plus commode. Si tu penses te servir souvent de ce bloc, tu peux créer un fichier gabarit (.dwt) à partir d'un dessin dans la collection duquel ce bloc est présent (avec éventuellemnt d'autres dont tu te sers souvent). Les blocs sont enregistrés dans le gabarit de même que les présentations, les styles des texte, de cote, de ligne, etc... Chaque nouveau dessin démarré avec ce gabarit aura le bloc dans sa collection. Il est aussi possible d'ajouter ce bloc dans une palette d'outils existante ou que tu crées, d'où tu n'auras qu'à le faire glisser pour le déposer dans le dessin. Tu peux aussi enregistrer ton bloc comme un fichier .dwg avec la commande WBLOC. Dans ce cas, si tu l'enregistres dans un dossier du chemin de recherche des fichiers de support existant (Menu Outils >> Options ... Onglet Fichiers) ou dans un dossier dont tu indiques le chemin dans les chemins de recherche, tu pourras insérer ton bloc dans un nouveau dessin en entrant directement son nom dans la boite de dialogue de la commande INSERER, si le dossier n'est pas dans les chemins de recherche il faudra le récupérer en faisant "Parcourir" depuis la même boite dialogue. À toi de voir la méthode qui te convient le mieux.

Re, Effectivement, j'utilise une valeur négative pour PDSIZE (taille par raport à l'écran) ce qui me permet, après un regen, de ne pas avoir des points immenses ou invisibles lors des changements de zoom. Il me semble qu'on peut laisser un facteur d'échelle de 1.0 pour les X,Y et Z à l'insertion du bloc : (entmake '((0 . "INSERT") ...(41 . 1.0) (42 . 1.0) (43 . 1.0) ...)) et jouer uniquement sur la hauteur de texte de l'attribut : (entmake '((0 . "ATTRIB") ... (cons 40 (* 0.1 partial_dist)) ...)). C'est comme ça que j'ai fait dans la modif proposée pour Diviser/Mesurer 3D (en vlisp).

Suite à une suggestion de Bonuscad ici, en remplaçant la routine DivMesInsert donnée dans le premier message de ce sujet, par celle ci-dessous, on peut insérer le bloc "BLK_MEASURE_CURVE" avec attribut incrémenté. Il faut toutefois que ce bloc existe dans la collection du dessin (ou gabarit) ou comme fichier .dwg (wbloc) pour pouvoir le récupérer avec la fonction getblock. Pour créer ce bloc il suffit de lancer la routine make_blk_measure qui se trouve au début du lien donné ci dessus. ;;; DivMesInsert Insère le bloc (ou le point) suivant les options choisies (defun DivMesInsert (/ norm deriv2 ang mat ydir ref) (if (/= scu "Scu") (cond ((member (vla-get-ObjectName obj) '("AcDbArc" "AcDbCircle" "AcDbEllipse" "AcDbPolyline" "AcDb2dPolyline" ) ) (setq norm (vlax-safearray->list (vlax-variant-value (vla-get-Normal obj)) ) ) ) ((not (member (vla-get-ObjectName obj) '("AcDbLine" "AcDb3dPolyline") ) ) (setq deriv2 (vlax-curve-getSecondDeriv obj ins_par ) ) (setq ang (ang ) ) (if ( (setq norm (norm_3pts '(0 0 0) deriv1 deriv2)) (setq norm (norm_3pts '(0 0 0) deriv2 deriv1)) ) ) ) ) (if nom (progn (if (= scu "Scu") (progn (if (= algn "Non") (setq ang (angle '(0 0 0) (trans (getvar "UCSXDIR") 0 ucszdir) ) ) (setq ang (angle '(0 0 0) (trans deriv1 0 ucszdir)) ) ) (setq mat (mapcar '(lambda (v) (trans v 0 ucszdir)) (list (list (cos ang) (- (sin ang)) 0) (list (sin ang) (cos ang) 0) '(0 0 1) ) ) ) ) (if (= algn "Non") (setq ydir (norm_3pts '(0 0 0) norm (getvar "ucsxdir")) mat (trp (cons (norm_3Pts '(0 0 0) ydir norm) (cons ydir (cons norm mat) ) ) ) ) (setq mat (trp (list (mapcar '(lambda (x) (/ x (distance '(0 0 0) deriv1)) ) deriv1 ) (norm_3pts '(0 0 0) norm deriv1) norm ) ) ) ) ) (setq ref (vla-InsertBlock (getspace) (vlax-3d-point '(0 0 0)) nom 1 1 1 0 ) ) (if (= nom "BLK_MEASURE_CURVE") (progn (vla-put-TextString (car (vlax-invoke ref 'getAttributes)) (if rest (rtos (- long (vlax-curve-getDistAtPoint obj ins_pt))) (rtos (vlax-curve-getDistAtPoint obj ins_pt)) ) ) (vla-ScaleEntity (car (vlax-invoke ref 'getAttributes)) (vlax-3d-point '(0 0 0)) (* 0.1 dist) ) ) ) (vla-TransformBy ref (vlax-tmatrix (append (mapcar '(lambda (v1 v2) (append v1 (list v2)) ) mat ins_pt ) (list '(0 0 0 1)) ) ) ) ) (vla-addPoint (getspace) (vlax-3d-point ins_pt)) ) ) [Edité le 7/9/2006 par (gile)]

Salut, En attendant une version 2006, 2007 ou plus qui ont cette commande, tu vas trouver ici un LISP qui date un peu mais fonctionne et un autre là, plus récent. Le second fonctionne aussi dans l'espace papier, aucun des deux ne crée de cotes associatives, il s'agit en fait d'une cote angulaire dont le texte est modifié.

Encore un joli coup pour ta rentrée ;) Ça, c'est une bonne idée, mais pour le point, peut-être eut il mieux valu laisser l'échelle à 1.0 pour ceux qui ne paramètrent pas PDMODE à 0. avec PDMODE à 34 et (cons 41 (* 0.1 partial_dist)) (cons 42 (* 0.1 partial_dist)) (cons 43 (* 0.1 partial_dist)) http://xs106.xs.to/xs106/06364/measure1.PNG.xs.jpg en remettant les échelles à 1.0 (cons 41 1.0) (cons 42 1.0) (cons 43 1.0) http://xs106.xs.to/xs106/06364/measure2.PNG.xs.jpg

Salut, Tu peux mettre tes chiffres en couleur 255,255,255

Salut, Tu trouveras ici un LISP qui met tous le textes multilignes sélectionnés dans le style de texte courant. Si tu veux changer tous les textes et mtextes du dessin, remplace la ligne : (while (not (setq ss (ssget '((0 . "MTEXT")))))) par : (setq ss (ssget "_X" '((0 . "*TEXT")))) Si les polices ont été forcées, c'est un peu plus compliqué. Tu trouveras plus bas, dans le même sujet un LISP qui supprime toutes les propriétés forcées des mtextes sélectionnés.

Salut, Voir ce sujet.

Salut, Même réponse que dans le forum Autodesk, deux petits LISP à coller sur la ligne de commande ou dans un bouton. En sélectionnant une ligne : ((lambda (/ l) (while (not (setq l (ssget "_:S:E" '((0 . "LINE")))))) (setq l (entget (ssname l 0))) (alert (strcat "Angle = " (angtos (angle (trans (cdr (assoc 10 l)) 0 1) (trans (cdr (assoc 11 l)) 0 1) ) ) ) ) (princ) ) ) En spécifiant le point de départ et de fin : (alert (strcat "Angle = "(angtos (getangle))))

Salut, Dans le bloc-note, tu fais Fichier >> Enregistrer sous ... et tu tapes le nom que tu veux donner au fichier avec l'extension .scr

Oui Patrick_35, je me suis mal exprimé, je voulais juste préciser qu'il ne s'agirait là que des sources permettant de compiler l'arx pour "lire" les boites dialogues ODCL sur 2007, et non pas, ce que j'attends avec impatience, la version 2007 d'ODCL qui permettrait de créer des boites dialogue avec 2007.

Salut, Tu peux sauvegarder l'état des variables à un moment donné dans un fichier .svf ou .scr à l'aide de la commande SYSVDLG des express tools. Tu pourras ensuite restaurer cet état avec la même commande (fichier .svf) ou avec la commande SCRIPT (fichier .scr).

Je ne suis pas sûr d'avoir compris, mais il me semble qu'il s'agit du fichier arx nécessaire pour faire fonctionner dans AutoCAD 2007 les boites de dialogue faites avec ODCL dans une version antérieure, mais pas de la mise à jour d'ODCL pour réaliser des boites de dialogue avec AutoCAD 2007.

C'est le cas, les champs "aire" et "longueur" sont associés à la polyligne.